view release on metacpan or  search on metacpan

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

}

sub decode_ipaddr   { inet_ntop(AF_INET, $_[0]) }
sub decode_ipv6addr { inet_ntop(AF_INET6, $_[0]) }

sub decode_ipv6addr_pp {
    my $value = shift;

    my $binary = unpack( 'B*', $value );
    return undef if (! $binary);
    my $ip_val = Net::IP::ip_bintoip( $binary, 6 );
    return undef if (! $ip_val);
    return Net::IP::ip_compress_address( $ip_val, 6 );
}

sub decode_octets   { '0x'.unpack("H*", $_[0]) }

sub decode_combo_ip {
    my $ip = shift;

    if (length($ip) == 4) {
        return $decode_map{ipaddr}->($ip);
    }
    return $decode_map{ipv6addr}->($ip);
}

sub decode_avpair {
    my ($value, $attr, $dict) = @_;
    if ( ($attr->{vendor} // '') eq VENDOR_CISCO) {
        # Cisco hack
        if ( $attr->{id} == ATTR_CISCO_AVPAIR ) {
            # Cisco-AVPair = "h323-foo-bar=baz"
            # leave it as-is
        }
        else {
            # h323-foo-bar = "h323-foo-bar = baz"
            # cut attribute name
            $value =~ s/^\Q$attr->{name}\E\s*=//;
        }
    }

    return $value;
}

sub decode_tlv {
    my ($value, $parent, $dict) = @_;

    my $pos = 0;
    my $len = length($value);

    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;
    # Format: <prefix-length><ipv4-address>
    # prefix-length is 1 byte, ipv4-address is 4 bytes
    return undef if length($value) != 5;

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

    return "$ip_str/$prefix_len";
}

sub decode_ipv6prefix {
    my $value = shift;
    # Format: <prefix-length><ipv6-address>
    # prefix-length is 1 byte, ipv6-address is 16 bytes
    return undef if length($value) != 17;

    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;