Seems this was something like a year ago ... any news on patching this in?
I'm going to admit to writing my own parser revisions before I even
noticed this thread on RT. I've attached it because it'd be very easy
for someone to drop in place as a work around, not because it'd be a
good fix for the actual package.
--
If riding in an airplane is flying, then riding in a boat is swimming.
116 jumps, 48.6 minutes of freefall, 92.9 freefall miles.
package Dict;
use common::sense;
use File::Slurp qw(slurp);
use base 'Net::Radius::Dictionary';
use File::Basename;
sub myslurp {
my $fname = shift;
my @lines = slurp($fname);
my $line = 0;
return map {[$fname, ++$line, $_]} @lines;
}
sub readfile {
my ( $self, $filename ) = @_;
my $def_vendor; # used in vendor attribute blocks
my @lines = myslurp($filename);
my ($_fname, $_line);
my $read = sub {
my $lfs = shift @lines;
my $line;
($_fname, $_line, $line) = @$lfs;
return $line;
};
while ( defined( my $l = $read->() ) ) {
next if $l =~ /^\#/;
next unless my @l = split /\s+/, $l;
if ( lc($l[0]) eq "vendor" ) {
if ( defined $l[1] and defined $l[2] and $l[2] =~ /^[xo0-9]+$/ ) {
if ( substr( $l[2], 0, 1 ) eq "0" ) { #allow hex or octal
my $num = lc( $l[2] );
$num =~ s/^0b//;
$l[2] = oct($num);
}
$self->{vendors}->{ $l[1] } = $l[2];
} else {
warn "Garbled VENDOR line $l in $_fname $_line";
}
} elsif ( lc($l[0]) eq "begin-vendor" ) {
$def_vendor = $l[1];
} elsif ( lc($l[0]) eq "end-vendor" ) {
undef $def_vendor;
} elsif ( lc($l[0]) eq "attribute" ) {
if( $def_vendor and @l == 4 ) {
push @l, $def_vendor;
}
if ( @l == 4 ) {
$self->{attr}->{ $l[1] } = [ @l[ 2, 3 ] ];
$self->{rattr}->{ $l[2] } = [ @l[ 1, 3 ] ];
} elsif ( @l == 5 ) { # VENDORATTR
if ( $l[2] =~ m/^0[xb]?[a-fA-F0-9]$/ ) {
$l[2] = eval $l[2];
}
if ( exists $self->{vendors}->{ $l[4] } ) {
$self->{vsattr}->{ $self->{vendors}->{ $l[4] } }->{ $l[1] } = [ @l[ 2, 3 ] ];
$self->{rvsattr}->{ $self->{vendors}->{ $l[4] } }->{ $l[2] } = [ @l[ 1, 3 ] ];
} elsif ( $l[4] =~ m/^\d+$/ ) {
$self->{vsattr}->{ $l[4] }->{ $l[1] } = [ @l[ 2, 3 ] ];
$self->{rvsattr}->{ $l[4] }->{ $l[2] } = [ @l[ 1, 3 ] ];
} else {
if( $l[4] =~ m/(?:has_tag|encrypt)/ ) {
# just ignore these unless we learn what to do with them some day
} else {
warn "Warning: Unknown vendor $l[4] in $_fname $_line";
}
}
}
} elsif ( lc($l[0]) eq "value" ) {
if ( exists $self->{attr}->{ $l[1] } ) {
$self->{val}->{ $self->{attr}->{ $l[1] }->[0] }->{ $l[2] } = $l[3];
$self->{rval}->{ $self->{attr}->{ $l[1] }->[0] }->{ $l[3] } = $l[2];
} else {
for my $v ( keys %{ $self->{vsattr} } ) {
if ( defined $self->{vsattr}->{$v}->{ $l[1] } ) {
$self->{vsaval}->{$v}->{ $self->{vsattr}->{$v}->{ $l[1] }->[0] }->{ $l[2] } = $l[3];
$self->{rvsaval}->{$v}->{ $self->{vsattr}->{$v}->{ $l[1] }->[0] }->{ $l[3] } = $l[2];
}
}
}
} elsif ( lc($l[0]) eq "vendorattr" ) {
if ( substr( $l[3], 0, 1 ) eq "0" ) { #allow hex or octal
my $num = lc( $l[3] );
$num =~ s/^0b//;
$l[3] = oct($num);
}
if ( exists $self->{vendors}->{ $l[1] } ) {
$self->{vsattr}->{ $self->{vendors}->{ $l[1] } }->{ $l[2] } = [ @l[ 3, 4 ] ];
$self->{rvsattr}->{ $self->{vendors}->{ $l[1] } }->{ $l[3] } = [ @l[ 2, 4 ] ];
} elsif ( $l[1] =~ m/^\d+$/ ) {
$self->{vsattr}->{ $l[1] }->{ $l[2] } = [ @l[ 3, 4 ] ];
$self->{rvsattr}->{ $l[1] }->{ $l[3] } = [ @l[ 2, 4 ] ];
} else {
warn "Warning: Unknown vendor $l[1] in $_fname $_line";
}
} elsif ( lc($l[0]) eq "vendorvalue" ) {
if ( substr( $l[4], 0, 1 ) eq "0" ) { #allow hex or octal
my $num = lc( $l[4] );
$num =~ s/^0b//;
$l[4] = oct($num);
}
if ( exists $self->{vendors}->{ $l[1] } ) {
$self->{vsaval}->{ $self->{vendors}->{ $l[1] } }
->{ $self->{vsattr}->{ $self->{vendors}->{ $l[1] } }->{ $l[2] }->[0] }->{ $l[3] } = $l[4];
$self->{rvsaval}->{ $self->{vendors}->{ $l[1] } }
->{ $self->{vsattr}->{ $self->{vendors}->{ $l[1] } }->{ $l[2] }->[0] }->{ $l[4] } = $l[3];
} elsif ( $l[1] =~ m/^\d+$/ ) {
$self->{vsaval}->{ $l[1] }->{ $self->{vsattr}->{ $l[1] }->{ $l[2] }->[0] }->{ $l[3] } = $l[4];
$self->{rvsaval}->{ $l[1] }->{ $self->{vsattr}->{ $l[1] }->{ $l[2] }->[0] }->{ $l[4] } = $l[3];
} else {
warn "Warning: $filename contains vendor value for unknown vendor attribute - ignored [@l] in $_fname $_line";
}
} elsif ( lc( $l[0] ) eq 'packet' ) {
my ( $name, $value ) = @l[ 1, 2 ];
$self->{packet}{$name} = $value;
$self->{rpacket}{$value} = $name;
} elsif ( $l[0] eq '$INCLUDE' ) {
my $dir = dirname($filename);
splice @lines, 0, 0, myslurp("$dir/$l[1]");
} else {
warn "Warning: Weird dictionary line: [@l] in $_fname $_line";
}
}
}
1;
