Description: Fixed check_pwd() method when dictionaries are not loaded and attribute ID is used instead of Name. . Backported from upstream release 0.31 Origin: https://metacpan.org/source/PORTAONE/Authen-Radius-0.31 Bug: https://rt.cpan.org/Ticket/Display.html?id=129869 Forwarded: https://rt.cpan.org/Ticket/Display.html?id=129869 Bug-Debian: https://bugs.debian.org/930671 Author: PORTAONE@cpan.org Reviewed-by: gregor herrmann Last-Update: 2019-06-21 --- a/Radius.pm +++ b/Radius.pm @@ -184,6 +184,9 @@ sub send_packet { my ($self, $type, $retransmit) = @_; + + $self->{attributes} //= ''; + my $data; my $length = 20 + length($self->{attributes}); @@ -554,7 +557,7 @@ sub get_attributes { my $self = shift; my ( $vendor, $vendor_id, $name, $id, $length, $value, $type, $rawvalue, $tag, @a ); - my ($attrs) = $self->{attributes}; + my $attrs = $self->{attributes} // ''; $self->set_error; @@ -598,12 +601,13 @@ my ($attr) = @_; if (defined $attr->{'Vendor'}) { return ($dict_vendor_name{ $attr->{'Vendor'} }{'id'} // int($attr->{'Vendor'})); - } else { + } elsif (exists $dict_name{$attr->{'Name'}} ) { # look up vendor by attribute name my $vendor_name = $dict_name{$attr->{'Name'}}{'vendor'} or return NO_VENDOR; my $vendor_id = $dict_vendor_name{$vendor_name}{'id'} or return NO_VENDOR; return $vendor_id; } + return NO_VENDOR; } sub _encode_enum { @@ -847,7 +851,7 @@ sub add_attributes { my ($self, @attr) = @_; - my ($a, $vendor, $id, $type, $value); + my ($a, $vendor, $id, $type, $value, $need_tag); my @a = (); $self->set_error; @@ -862,7 +866,11 @@ $attr_name = $1; } - die 'unknown attr name '.$attr_name if (! exists $dict_name{$attr_name}); + if (! exists $dict_name{$attr_name}) { + # no dictionaries loaded, $attr_name must be attribute ID + push @a, $attr; + next; + } $id = $dict_name{$attr_name}{id} // int($attr_name); $vendor = vendorID($attr); @@ -892,10 +900,21 @@ } for $a (@a) { - $id = $dict_name{ $a->{Name} }{id} // int($a->{Name}); - $type = $a->{Type} // $dict_name{ $a->{Name} }{type}; - $vendor = vendorID($a); - my $need_tag = (defined $a->{Tag}) || $dict_name{ $a->{Name} }{has_tag}; + if (exists $dict_name{ $a->{Name} }) { + my $def = $dict_name{ $a->{Name} }; + $id = $def->{id}; + # allow to override Type (why?) + $type = $a->{Type} // $def->{type}; + $need_tag = $a->{Tag} // $def->{has_tag}; + } + else { + # ID must be a value for Name + $id = int($a->{Name}); + $type = $a->{Type}; + $need_tag = $a->{Tag}; + } + + # we do not support 0 value for Tag if ($need_tag) { $a->{Tag} //= 0; if ($a->{Tag} < 1 || $a->{Tag} > 31) { @@ -904,12 +923,15 @@ } } + $vendor = vendorID($a); if ($vendor eq WIMAX_VENDOR) { - # WiMAX uses non-standard VSAs - include the continuation byte + #TODO WiMAX uses non-standard VSAs - include the continuation byte } unless (defined($value = $self->_encode_value($vendor, $id, $type, $a->{Name}, $a->{Value}, $a->{Tag}))) { - print STDERR "Unable to encode attribute $a->{Name} ($id, $type, $vendor) with value '$a->{Value}'\n" if $debug; + printf STDERR "Unable to encode attribute %s (%s, %s, %s) with value '%s'\n", + $a->{Name}, $id // '?', $type // '?', $vendor, $a->{Value} + if $debug; next; } @@ -1337,7 +1359,9 @@ 'C', 'C', 'C' or 'C'. The C may be Vendor's name from the dictionary or their integer id. For tagged attributes (RFC2868) tag can be specified in C using 'Name:Tag' format, or by -using C pair. TAG value is expected to be an integer. +using C pair. TAG value is expected to be an integer, within [1:31] range +(zero value isn't supported). + =item get_attributes --- /dev/null +++ b/t/acct_reply.t @@ -0,0 +1,14 @@ +use strict; +use warnings; +use Test::More tests => 3; + +BEGIN { use_ok('Authen::Radius', qw(ACCOUNTING_RESPONSE)) }; + +my $r = Authen::Radius->new(Host => '127.0.0.1', Secret => 'secret', Debug => 0); +ok($r, 'object created'); + +# without any attributes +my $reply = $r->send_packet(ACCOUNTING_RESPONSE); +ok($reply); +# diag $r->get_error; +# diag $r->error_comment; --- /dev/null +++ b/t/check_pwd.t @@ -0,0 +1,11 @@ +use strict; +use warnings; +use Test::More tests => 3; + +BEGIN { use_ok('Authen::Radius') }; + +my $r = Authen::Radius->new(Host => '127.0.0.1', Secret => 'secret'); +ok($r, 'object created'); + +my $check = $r->check_pwd('test', 'test'); +ok(! $check, 'no RADIUS available - check failed'); --- /dev/null +++ b/t/local_dictionary.t @@ -0,0 +1,30 @@ +use strict; +use warnings; +use Test::More tests => 8; +use File::Spec (); +use Test::NoWarnings; + +BEGIN { use_ok('Authen::Radius') }; + +my $auth = Authen::Radius->new(Host => '127.0.0.1', Secret => 'secret', Debug => 0); +ok($auth, 'object created'); + +my $raddb_path = 'raddb'; + +SKIP: { + skip 'no local dictionary found', 5 if (! -d $raddb_path); + + ok($auth->load_dictionary($raddb_path . '/dictionary'), 'local dictionary loaded'); + $auth->add_attributes({ Name => 'Cisco-IP-Direct', Value => 10 }); + my @attr = $auth->get_attributes(); + is(@attr, 1, '1 attribute added'); + is($attr[0]->{Name}, 'Cisco-IP-Direct', 'name check'); + + $auth->clear_attributes; + + $auth->add_attributes({ Name => 'WiMAX-MSK', Value => 0x10 }); + @attr = $auth->get_attributes(); + is(@attr, 1, '1 attribute added'); + is($attr[0]->{Name}, 'WiMAX-MSK', 'name check'); +}; + --- /dev/null +++ b/t/no_dictionary.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More tests => 4; + +BEGIN { use_ok('Authen::Radius') }; + +my $r = Authen::Radius->new(Host => '127.0.0.1', Secret => 'secret', Debug => 0); +ok($r, 'object created'); + +# Name as ID but missing Type +$r->add_attributes( + { Name => 1, Value => 'test' }, + { Name => 2, Value => 'test' }, +); + +is( scalar($r->get_attributes), 0, 'no attributes encoded'); +ok( $r->send_packet(ACCESS_REQUEST), 'sent without attributes'); +# diag $r->get_error; +# diag $r->error_comment; +