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 <gregoa@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;
+