view release on metacpan or  search on metacpan

Radius.pm  view on Meta::CPAN

sub gen_authenticator {
    my ($self) = @_;
    my ($ct);

    $self->set_error;
    sub rint { int rand(2 ** 32 - 1) };
    $self->{'authenticator'} =
        pack "L4", rint(), rint(), rint(), rint();
}

sub encrypt_pwd {
    my ($self, $pwd) = @_;
    my ($i, $ct, @pwdp, @encrypted);

    $self->set_error;
    $ct = Digest::MD5->new();

    my $non_16 = length($pwd) % 16;
    $pwd .= "\0" x (16 - $non_16) if $non_16;
    @pwdp = unpack('a16' x (length($pwd) / 16), $pwd);
    for $i (0..$#pwdp) {
        my $authent = $i == 0 ? $self->{'authenticator'} : $encrypted[$i - 1];
        $ct->add($self->{'secret'},  $authent);
        $encrypted[$i] = $pwdp[$i] ^ $ct->digest();
    }
    return join('',@encrypted);
}
use vars qw(%included_files);

sub load_dictionary {
    shift;
    my $file = shift;
    # options, format => {freeradius|gnuradius|default}
    my %opt = @_;
    my $freeradius_dict = (($opt{format} // '') eq 'freeradius') ? 1 : 0;
    my $gnuradius_dict = (($opt{format} // '') eq 'gnuradius') ? 1 : 0;

    my ($cmd, $name, $id, $type, $vendor, $tlv, $extra, $has_tag);
    my $dict_def_vendor = NO_VENDOR;

    $file ||= DEFAULT_DICTIONARY;

    # prevent infinite loop in the include files
    return undef if exists($included_files{$file});
    $included_files{$file} = 1;
    my $fh = FileHandle->new($file) or die "Can't open dictionary '$file' ($!)\n";
    printf STDERR "Loading dictionary %s using %s format\n", $file, ($freeradius_dict ? 'FreeRADIUS' : 'default')  if $debug;

    while (my $line = <$fh>) {
        chomp $line;
        next if ($line =~ /^\s*$/ || $line =~ /^#/);

        if ($freeradius_dict) {
            # ATTRIBUTE name number type [options]
            ($cmd, $name, $id, $type, $extra) = split(/\s+/, $line);
            $vendor = undef;
        }
        elsif ($gnuradius_dict) {
            # ATTRIBUTE name number type [vendor] [flags]
            ($cmd, $name, $id, $type, $vendor, undef) = split(/\s+/, $line);
            # flags looks like '[LR-R-R]=P'
            $vendor = NO_VENDOR if ($vendor && ($vendor eq '-' || $vendor =~ /^\[/));
        }
        else {
            # our default format (Livingston radius)
            ($cmd, $name, $id, $type, $vendor) = split(/\s+/, $line);
        }

        $cmd = lc($cmd);
        if ($cmd eq 'attribute') {
            # Vendor was previously defined via BEGIN-VENDOR
            $vendor ||= $dict_def_vendor // NO_VENDOR;

            $has_tag = 0;
            if ($extra && $extra !~ /^#/) {
                my(@p) = split(/,/, $extra);
                $has_tag = grep /has_tag/, @p;
            }

            $dict_name{ $name } = {
                    id      => $id,
                    type    => $type,
                    vendor  => $vendor,
                    has_tag => $has_tag,
                };

            if (defined($tlv)) {
                # inside of a TLV definition
                $dict_id{$vendor}{$id}{'tlv'} = $tlv;
                $dict_name{$name}{'tlv'} = $tlv;
                # IDs of TLVs are only unique within the master attribute, not in the dictionary
                # so we have to use a composite key
                $dict_id{$vendor}{$tlv.'/'.$id}{'name'} = $name;
                $dict_id{$vendor}{$tlv.'/'.$id}{'type'} = $type;
            } else {
                $dict_id{$vendor}{$id} = {
                        name    => $name,
                        type    => $type,
                        has_tag => $has_tag,
                    };
            }
        } elsif ($cmd eq 'value') {
            next unless exists($dict_name{$name});
            $dict_val{$name}->{$type}->{'name'} = $id;
            $dict_val{$name}->{$id}->{'id'} = $type;
        } elsif ($cmd eq 'vendor') {
            $dict_vendor_name{$name}{'id'} = $id;
            $dict_vendor_id{$id}{'name'} = $name;
        } elsif ($cmd eq 'begin-vendor') {
            $dict_def_vendor = $name;
            if (! $freeradius_dict) {
                # force format
                $freeradius_dict = 1;
                print STDERR "Detected BEGIN-VENDOR, switch to FreeRADIUS dictionary format\n" if $debug;
            }
        } elsif ($cmd eq 'end-vendor') {
            $dict_def_vendor = NO_VENDOR;
        } elsif ($cmd eq 'begin-tlv') {
            # FreeRADIUS dictionary syntax for defining WiMAX TLV
            if (exists($dict_name{$name}) and $dict_name{$name}{'type'} eq 'tlv') {
                # This name was previously defined as an attribute with TLV type