1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
#!/usr/bin/perl
# Test the attribute slot management
# $Id: attrslot.t 77 2007-01-30 15:15:48Z lem $
no utf8;
use IO::File;
use Test::More tests => 61;
use Net::Radius::Packet;
use Net::Radius::Dictionary;
# Init the dictionary for our test run...
BEGIN {
my $fh = new IO::File "dict.$$", ">";
print $fh <<EOF;
ATTRIBUTE User-Name 1 string
ATTRIBUTE NAS-IP-Address 4 ipaddr
ATTRIBUTE NAS-Port 5 integer
ATTRIBUTE Reply-Message 18 string
EOF
close $fh;
};
END { unlink 'dict.' . $$; }
my $d = new Net::Radius::Dictionary "dict.$$";
isa_ok($d, 'Net::Radius::Dictionary');
# Build a request and test it is ok
my $p = new Net::Radius::Packet $d;
isa_ok($p, 'Net::Radius::Packet');
$p->set_identifier(42);
$p->set_authenticator("\x66" x 16);
$p->set_code("Access-Reject");
is($p->attr_slots, 0, "Correct number of attribute slots in empty packet");
is($p->attr_slot_name(0), undef, "Undefined slot 0 name (e)");
is($p->attr_slot_val(0), undef, "Undefined slot 0 value (e)");
$p->set_attr("Reply-Message" => 'line-1');
$p->set_attr("Reply-Message" => 'line-2');
my $q = new Net::Radius::Packet $d, $p->pack;
isa_ok($q, 'Net::Radius::Packet');
is($p->attr_slots, 2, "Correct number of attribute slots");
is($p->attr_slot_name(0), 'Reply-Message', "Correct name for slot 0");
is($p->attr_slot_val(0), 'line-1', "Correct value for slot 0");
is($p->attr_slot_name(1), 'Reply-Message', "Correct name for slot 1");
is($p->attr_slot_val(1), 'line-2', "Correct value for slot 1");
is($p->attr_slot_name(2), undef, "Undefined slot 2 name");
is($p->attr_slot_val(2), undef, "Undefined slot 2 value");
$q = new Net::Radius::Packet $d, $p->pack;
isa_ok($q, 'Net::Radius::Packet');
is($q->attr_slot_name(0), 'Reply-Message', "Correct name for slot 0 (q)");
is($q->attr_slot_val(0), 'line-1', "Correct value for slot 0 (q)");
is($q->attr_slot_name(1), 'Reply-Message', "Correct name for slot 1 (q)");
is($q->attr_slot_val(1), 'line-2', "Correct value for slot 1 (q)");
is($q->attr_slot_name(2), undef, "Undefined slot 2 name (q)");
is($q->attr_slot_val(2), undef, "Undefined slot 2 value (q)");
# Add a third attribute to the packet and verify what happens
$p->set_attr("NAS-Port" => "42");
is($p->attr_slots, 3, "Correct number of attribute slots");
is($p->attr_slot_name(2), 'NAS-Port', "Correct name for slot 2");
is($p->attr_slot_val(2), '42', "Correct value for slot 2");
is($p->attr_slot_name(3), undef, "Undefined slot 3 name");
is($p->attr_slot_val(3), undef, "Undefined slot 3 value");
# Remove attr slot 1 and check what happened
$p->unset_attr_slot(1);
is($p->attr_slots, 2, "Correct number of attribute slots");
is($p->attr_slot_name(0), 'Reply-Message', "Correct name for slot 0 (q)");
is($p->attr_slot_val(0), 'line-1', "Correct value for slot 0 (q)");
is($p->attr_slot_name(1), 'NAS-Port', "Correct name for slot 1");
is($p->attr_slot_val(1), '42', "Correct value for slot 1");
is($p->attr_slot_name(2), undef, "Undefined slot 2 name");
is($p->attr_slot_val(2), undef, "Undefined slot 2 value");
# Remove an already unexistant slot
$p->unset_attr_slot(2);
is($p->attr_slots, 2, "Correct number of attribute slots");
is($p->attr_slot_name(0), 'Reply-Message', "Correct name for slot 0 (q)");
is($p->attr_slot_val(0), 'line-1', "Correct value for slot 0 (q)");
is($p->attr_slot_name(1), 'NAS-Port', "Correct name for slot 1");
is($p->attr_slot_val(1), '42', "Correct value for slot 1");
is($p->attr_slot_name(2), undef, "Undefined slot 2 name");
is($p->attr_slot_val(2), undef, "Undefined slot 2 value");
# Remove slot 1
$p->unset_attr_slot(1);
is($p->attr_slots, 1, "Correct number of attribute slots");
is($p->attr_slot_name(0), 'Reply-Message', "Correct name for slot 0 (q)");
is($p->attr_slot_val(0), 'line-1', "Correct value for slot 0 (q)");
is($p->attr_slot_name(1), undef, "Undefined slot 1 name");
is($p->attr_slot_val(1), undef, "Undefined slot 1 value");
# Remove last slot
$p->unset_attr_slot(0);
is($p->attr_slots, 0, "Correct number of attribute slots");
is($p->attr_slot_name(0), undef, "Undefined slot 0 name");
is($p->attr_slot_val(0), undef, "Undefined slot 0 value");
# Remove last slot (again)
$p->unset_attr_slot(0);
is($p->attr_slots, 0, "Correct number of attribute slots");
is($p->attr_slot_name(0), undef, "Undefined slot 0 name");
is($p->attr_slot_val(0), undef, "Undefined slot 0 value");
# Remove first slot
$q->set_attr("NAS-Port" => "42");
is($q->attr_slots, 3, "Correct number of attribute slots");
is($q->attr_slot_name(2), 'NAS-Port', "Correct name for slot 2");
is($q->attr_slot_val(2), '42', "Correct value for slot 2");
is($q->attr_slot_name(3), undef, "Undefined slot 3 name");
is($q->attr_slot_val(3), undef, "Undefined slot 3 value");
$q->unset_attr_slot(0);
is($q->attr_slot_name(0), 'Reply-Message', "Correct name for slot 0 (q)");
is($q->attr_slot_val(0), 'line-2', "Correct value for slot 0 (q)");
is($q->attr_slot_name(1), 'NAS-Port', "Correct name for slot 1 (q)");
is($q->attr_slot_val(1), '42', "Correct value for slot 1 (q)");
is($q->attr_slot_name(2), undef, "Undefined slot 2 name (q)");
is($q->attr_slot_val(2), undef, "Undefined slot 2 value (q)");
|
