On Thu, 20 Jun 2019 16:55:18 +0300, Niko Tyni wrote: > Control: forwarded -1 https://rt.cpan.org/Ticket/Display.html?id=129869
> I've reported this upstream with the attached proposed patch. > Will wait a bit before applying the patch for Debian in case upstream > has comments. Upstream has now closed the CPAN RT ticket and released a 0.31 version which fixes the issue (differently). I've "backported" the fix (i.e. took most of the 0.31 diff and added it as a quilt patch) and pushed it to git. For convenience I'm also attaching the patch here. Feri, could you try this patch as well so that we can be sure that it works before we proceed with an upload and unblock request? Cheers, gregor -- .''`. https://info.comodo.priv.at -- Debian Developer https://www.debian.org : :' : OpenPGP fingerprint D1E1 316E 93A7 60A8 104D 85FA BB3A 6801 8649 AA06 `. `' Member VIBE!AT & SPI Inc. -- Supporter Free Software Foundation Europe `- NP: Joan Baez: Suzanne
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: porta...@cpan.org Reviewed-by: gregor herrmann <gre...@debian.org> 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<ipv6addr>', 'C<ipv6prefix>', 'C<ifid>' or 'C<avpair>'. The C<VENDOR> may be Vendor's name from the dictionary or their integer id. For tagged attributes (RFC2868) tag can be specified in C<Name> using 'Name:Tag' format, or by -using C<Tag> pair. TAG value is expected to be an integer. +using C<Tag> 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; +
signature.asc
Description: Digital Signature
