view release on metacpan or  search on metacpan

lib/Data/Radius/Decode.pm  view on Meta::CPAN

    my @list = ();
    while ($pos < $len) {
        my ($attr_id, $attr_len) = unpack('C C', substr($value, $pos, 2));
        my $attr_val = substr($value, $pos + 2, $attr_len - 2);

        my $attr = $dict->tlv_attribute_name($parent, $attr_id);
        if (! $attr) {
            push @list, {Name => $attr_id, Value => $attr_val, Unknown => 1};
        }
        else {
            my $decoded = decode($attr, $attr_val, $dict);
            if (is_enum_type($attr->{type})) {
                $decoded = $dict->constant($attr->{name}, $decoded) // $decoded;
            }

            push @list, {Name => $attr->{name}, Value => $decoded, Type => $attr->{type}};
        }

        $pos += $attr_len;
    }

    return \@list;
}

sub decode_ipv4prefix {
    my $value = shift;

lib/Data/Radius/Decode.pm  view on Meta::CPAN

    my ( $prefix_len, $ip ) = unpack('Ca*', $value);
    my $ip_str = inet_ntop(AF_INET6, $ip);

    return "$ip_str/$prefix_len";
}

sub decode {
    my ($attr, $value, $dict) = @_;

    my $decoder = $attr->{type} . ($attr->{has_tag} ? '_tag' : '');
    my ($decoded, $tag) = $decode_map{ $decoder }->($value, $attr, $dict);
    return wantarray ? ($decoded, $tag) : $decoded;
}

1;

lib/Data/Radius/Packet.pm  view on Meta::CPAN

            push @attr, {
                Name => $attr_id,
                Value => $attr_val,
                Type => undef,
                Vendor => $vendor,
                Tag => undef,
            };
            next;
        }

        (my $decoded, $tag) = decode($attr, $attr_val, $self->dict);
        if (is_enum_type($attr->{type})) {
            # try to convert value to constants
            $decoded = $dict->constant($attr->{name}, $decoded) // $decoded;
        }

        # password is expected only in auth request
        if ($type == ACCESS_REQUEST && $attr->{id} == ATTR_PASSWORD && ! $attr->{vendor}) {
            $decoded = decrypt_pwd($decoded, $self->secret, $auth);
        }

        push @attr, {
            Name => $attr->{name},
            Value => $decoded,
            Type => $attr->{type},
            Vendor => $vendor,
            Tag => $tag,
        };
    }

    if($msg_auth) {
        # we already replaced msg auth value to \x0...
        my $auth_used;
        if ($self->is_reply($type)) {