"Inital commit to Gerrit"
[profile/ivi/dhcp.git] / tests / DHCPv6 / dhcp_client.pm
1 #! /usr/bin/perl -w
2
3 # Copyright (c) 2007,2009 by Internet Systems Consortium, Inc. ("ISC")
4 #
5 # Permission to use, copy, modify, and distribute this software for any
6 # purpose with or without fee is hereby granted, provided that the above
7 # copyright notice and this permission notice appear in all copies.
8 #
9 # THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES
10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 # MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR
12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
15 # OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16 #
17 #   Internet Systems Consortium, Inc.
18 #   950 Charter Street
19 #   Redwood City, CA 94063
20 #   <info@isc.org>
21 #   https://www.isc.org/
22
23 package dhcp_client;
24
25 require Exporter;
26
27 @ISA = qw(Exporter);
28
29 # message types
30 $MSG_SOLICIT = 1;
31 $MSG_ADVERTISE = 2;
32 $MSG_REQUEST = 3;
33 $MSG_CONFIRM = 4;
34 $MSG_RENEW = 5;
35 $MSG_REBIND = 6;
36 $MSG_REPLY = 7;
37 $MSG_RELEASE = 8;
38 $MSG_DECLINE = 9;
39 $MSG_RECONFIGURE = 10;
40 $MSG_INFORMATION_REQUEST = 11;
41 $MSG_RELAY_FORW = 12;
42 $MSG_RELAY_REPL = 13;
43
44 # option numbers
45 $OPT_CLIENTID = 1;
46 $OPT_SERVERID = 2;
47 $OPT_IA_NA = 3;
48 $OPT_IA_TA = 4;
49 $OPT_IAADDR = 5;
50 $OPT_ORO = 6;
51 $OPT_PREFERENCE = 7;
52 $OPT_ELAPSED_TIME = 8;
53 $OPT_RELAY_MSG = 9;
54 $OPT_AUTH = 11;
55 $OPT_UNICAST = 12;
56 $OPT_STATUS_CODE = 13;
57 $OPT_RAPID_COMMIT = 14;
58 $OPT_USER_CLASS = 15;
59 $OPT_VENDOR_CLASS = 16;
60 $OPT_VENDOR_OPTS = 17;
61 $OPT_INTERFACE_ID = 18;
62 $OPT_RECONF_MSG = 19;
63 $OPT_RECONF_ACCEPT = 20;
64
65 # timeouts
66 $SOL_MAX_DELAY = 1;
67 $SOL_TIMEOUT = 1;
68 $SOL_MAX_RT = 120;
69 $REQ_TIMEOUT = 1;
70 $REQ_MAX_RT = 30;
71 $REQ_MAX_RC = 10;
72 $CNF_MAX_DELAY = 1;
73 $CNF_MAX_RT = 4;
74 $CNF_MAX_RD = 10;
75 $REN_TIMEOUT = 10;
76 $REN_MAX_RT = 600;
77 $REB_TIMEOUT = 10;
78 $REB_MAX_RT = 600;
79 $INF_MAX_DELAY = 1;
80 $INF_TIMEOUT = 1;
81 $INF_MAX_RT = 120;
82 $REL_TIMEOUT = 1;
83 $REL_MAX_RC = 5;
84 $DEC_TIMEOUT = 1;
85 $DEC_MAX_RC = 5;
86 $REC_TIMEOUT = 2;
87 $REC_MAX_RC = 8;
88 $HOP_COUNT_LIMIT = 32;
89
90 @EXPORT = qw( $MSG_SOLICIT $MSG_ADVERTISE $MSG_REQUEST $MSG_CONFIRM
91               $MSG_RENEW $MSG_REBIND $MSG_REPLY $MSG_RELEASE $MSG_DECLINE
92               $MSG_RECONFIGURE $MSG_INFORMATION_REQUEST $MSG_RELAY_FORW
93               $MSG_RELAY_REPL 
94               $OPT_CLIENTID $OPT_SERVERID $OPT_IA_NA $OPT_IA_TA $OPT_IAADDR
95               $OPT_ORO $OPT_PREFERENCE $OPT_ELAPSED_TIME $OPT_RELAY_MSG
96               $OPT_AUTH $OPT_UNICAST $OPT_STATUS_CODE $OPT_RAPID_COMMIT
97               $OPT_USER_CLASS $OPT_VENDOR_CLASS $OPT_VENDOR_OPTS 
98               $OPT_INTERFACE_ID $OPT_RECONF_MSG $OPT_RECONF_ACCEPT 
99               $SOL_MAX_DELAY $SOL_TIMEOUT $SOL_MAX_RT $REQ_TIMEOUT
100               $REQ_MAX_RT $REQ_MAX_RC $CNF_MAX_DELAY $CNF_MAX_RT
101               $CNF_MAX_RD $REN_TIMEOUT $REN_MAX_RT $REB_TIMEOUT $REB_MAX_RT
102               $INF_MAX_DELAY $INF_TIMEOUT $INF_MAX_RT $REL_TIMEOUT
103               $REL_MAX_RC $DEC_TIMEOUT $DEC_MAX_RC $REC_TIMEOUT $REC_MAX_RC
104               $HOP_COUNT_LIMIT );
105
106 my %msg_type_num = (
107         MSG_SOLICIT => 1,
108         MSG_ADVERTISE => 2,
109         MSG_REQUEST => 3,
110         MSG_CONFIRM => 4,
111         MSG_RENEW => 5,
112         MSG_REBIND => 6,
113         MSG_REPLY => 7,
114         MSG_RELEASE => 8,
115         MSG_DECLINE => 9,
116         MSG_RECONFIGURE => 10,
117         MSG_INFORMATION_REQUEST => 11,
118         MSG_RELAY_FORW => 12,
119         MSG_RELAY_REPL => 13,
120 );
121 my %msg_num_type = reverse(%msg_type_num);
122
123 my %opt_type_num = (
124         OPT_CLIENTID => 1,
125         OPT_SERVERID => 2,
126         OPT_IA_NA => 3,
127         OPT_IA_TA => 4,
128         OPT_IAADDR => 5,
129         OPT_ORO => 6,
130         OPT_PREFERENCE => 7,
131         OPT_ELAPSED_TIME => 8,
132         OPT_RELAY_MSG => 9,
133         OPT_AUTH => 11,
134         OPT_UNICAST => 12,
135         OPT_STATUS_CODE => 13,
136         OPT_RAPID_COMMIT => 14,
137         OPT_USER_CLASS => 15,
138         OPT_VENDOR_CLASS => 16,
139         OPT_VENDOR_OPTS => 17,
140         OPT_INTERFACE_ID => 18,
141         OPT_RECONF_MSG => 19,
142         OPT_RECONF_ACCEPT => 20,
143 );
144 my %opt_num_type = reverse(%opt_type_num);
145
146 my %status_code_num = (
147         Success => 0,
148         UnspecFail => 1,
149         NoAddrsAvail => 2,
150         NoBinding => 3,
151         NotOnLink => 4,
152         UseMulticast => 5,
153 );
154 my %status_num_code = reverse(%status_code_num);
155
156 my %docsis_type_num = (
157         CL_OPTION_ORO => 1,
158         CL_OPTION_TFTP_SERVERS => 32,
159         CL_OPTION_CONFIG_FILE_NAME => 33,
160         CL_OPTION_SYSLOG_SERVERS => 34,
161         CL_OPTION_TLV5 => 35,
162         CL_OPTION_DEVICE_ID => 36,
163         CL_OPTION_CCC => 37,
164         CL_OPTION_DOCSIS_VERS => 38,
165 );
166 my %docsis_num_type = reverse(%docsis_type_num);
167         
168 use strict;
169 use English;
170 use POSIX;
171
172 # XXX: very Solaris-specific
173 sub iface {
174         my @ifaces;
175         foreach my $fname (glob("/etc/hostname.*")) {
176                 $fname =~ s[^/etc/hostname.][];
177                 push(@ifaces, $fname);
178         }
179         return wantarray() ? @ifaces : $ifaces[0];
180 }
181
182 # XXX: very Solaris-specific
183 sub mac_addr {
184         my @ip_addrs;
185         foreach my $iface (iface()) {
186                 if (`ifconfig $iface 2>/dev/null` =~ /\sinet (\S+)\s/) {
187                         push(@ip_addrs, $1);
188                 }
189         }
190         my @mac_addrs;
191         foreach my $line (split(/\n/, `arp -an 2>/dev/null`)) { 
192                 my @parts = split(/\s+/, $line);
193                 my $ip = $parts[1];
194                 my $mac = $parts[-1];
195                 if (grep { $ip eq $_ }  @ip_addrs) {
196                         $mac =~ s/://g;
197                         push(@mac_addrs, $mac);
198                 }
199         }
200         return wantarray() ? @mac_addrs : $mac_addrs[0];
201 }
202
203 sub mac_addr_binary {
204         my @mac_addr = split(//, mac_addr());
205         my $mac_addr = join("", map { chr(hex($_)) } @mac_addr);
206         return $mac_addr;
207 }
208
209 # DHCPv6 times start 2000-01-01 00:00:00
210 my $dhcp_time_base = 946684800;
211 #{
212 #       local $ENV{TZ} = "UTC";
213 #       POSIX::tzset();
214 #       $dhcp_time_base = POSIX::mktime(0, 0, 0, 1, 0, 100);
215 #}
216
217 sub dhcpv6_time {
218         return time() - $dhcp_time_base;
219 }
220
221 sub duid {
222         my ($type) = @_;
223
224         $type = 1 unless (defined $type);
225
226         if (($type == 1) || ($type == 3)) {
227                 my $mac_addr = mac_addr_binary();
228                 if ($type == 1) { 
229                         my $time = pack("N", dhcpv6_time());
230                         return "\x00\x01\x00\x01${time}${mac_addr}";
231                 } else {
232                         return "\x00\x03\x00\x01${mac_addr}";
233                 }
234         } else {
235                 die "Unknown DUID type $type requested";
236         }
237 }
238
239 package dhcp_client::msg;
240
241 use Socket;
242 use Socket6;
243
244 sub new {
245         my ($pkg, $msg_type, $trans_id) = @_;
246
247         my $this = {};
248         bless $this;
249
250         $this->{msg_type} = $msg_type+0;
251         if (defined $trans_id) {
252                 $this->{trans_id} = $trans_id;
253         } else {
254                 $this->{trans_id} = chr(rand(256)) . 
255                         chr(rand(256)) . chr(rand(256));
256         }
257         $this->{options} = [ ];
258
259         return $this;
260 }
261
262
263 sub add_option {
264         my ($this, $num, $data) = @_;
265
266         push(@{$this->{options}}, [ $num, $data ]);
267 }
268
269 sub get_option {
270         my ($this, $num) = @_;
271         my @options;
272         foreach my $option (@{$this->{options}}) {
273                 if ($option->[0] == $num) {
274                         push(@options, $option->[1]);
275                 }
276         }
277         return wantarray() ? @options : $options[0];
278 }
279
280 sub packed_options {
281         my ($this) = @_;
282
283         my $options = "";
284         foreach my $option (@{$this->{options}}) {
285                 $options .= pack("nn", $option->[0], length($option->[1]));
286                 $options .= $option->[1];
287         }
288         return $options;
289 }
290
291 sub packet {
292         my ($this) = @_;
293
294         my $packet = "";
295         $packet .= chr($this->{msg_type});
296         $packet .= $this->{trans_id};
297         $packet .= $this->packed_options();
298         return $packet;
299 }
300
301 sub unpack_options {
302         my ($options) = @_;
303
304         my @parsed_options;
305         my $p = 0;
306         while ($p < length($options)) {
307                 my ($id, $len) = unpack("nn", substr($options, $p, 4));
308                 push(@parsed_options, [ $id,  substr($options, $p + 4, $len) ]);
309                 $p += 4 + $len;
310         }
311         return @parsed_options;
312 }
313
314 sub print_docsis_option {
315         my ($num, $data, $indent) = @_;
316
317         print "${indent}DOCSIS Option $num";
318         if ($docsis_num_type{$num}) {
319                 print " ($docsis_num_type{$num})";
320         }
321         print ", length ", length($data), "\n";
322
323         return unless ($docsis_num_type{$num});
324
325         if ($docsis_num_type{$num} eq "CL_OPTION_ORO") {
326                 my $num_oro = length($data) / 2;
327                 for (my $i=0; $i<$num_oro; $i++) {
328                         my $oro_num = unpack("n", substr($data, $i*2, 2));
329                         print "${indent}  $oro_num";
330                         if ($docsis_num_type{$oro_num}) {
331                                 print " ($docsis_num_type{$oro_num})";
332                         }
333                         print "\n";
334                 }
335         } elsif ($docsis_num_type{$num} eq "CL_OPTION_TFTP_SERVERS") {
336                 my $num_servers = length($data) / 16;
337                 for (my $i=0; $i<$num_servers; $i++) {
338                         my $srv = inet_ntop(AF_INET6, substr($data, $i*16, 16));
339                         print "$indent  TFTP server ", ($i+1), ": "; 
340                         print uc($srv), "\n";
341                 }
342         } elsif ($docsis_num_type{$num} eq "CL_OPTION_CONFIG_FILE_NAME") {
343                 print "$indent  Config file name: \"$data\"\n"
344         } elsif ($docsis_num_type{$num} eq "CL_OPTION_SYSLOG_SERVERS") {
345                 my $num_servers = length($data) / 16;
346                 for (my $i=0; $i<$num_servers; $i++) {
347                         my $srv = inet_ntop(AF_INET6, substr($data, $i*16, 16));
348                         print "$indent  syslog server ", ($i+1), ": "; 
349                         print uc($srv), "\n";
350                 }
351         }
352 }
353
354 sub print_option {
355         my ($num, $data, $indent) = @_;
356
357         print "${indent}Option $num";
358         if ($opt_num_type{$num}) {
359                 print " ($opt_num_type{$num})";
360         }
361         print ", length ", length($data), "\n";
362         if ($num == $dhcp_client::OPT_ORO) {
363                 my $num_oro = length($data) / 2;
364                 for (my $i=0; $i<$num_oro; $i++) {
365                         my $oro_num = unpack("n", substr($data, $i*2, 2));
366                         print "${indent}  $oro_num";
367                         if ($opt_num_type{$oro_num}) {
368                                 print " ($opt_num_type{$oro_num})";
369                         }
370                         print "\n";
371                 }
372         } elsif (($num == $dhcp_client::OPT_CLIENTID) || 
373                  ($num == $dhcp_client::OPT_SERVERID)) {
374                 print $indent, "  ";
375                 if (length($data) > 0) {
376                         printf '%02X', ord(substr($data, 0, 1));
377                         for (my $i=1; $i<length($data); $i++) {
378                                 printf ':%02X', ord(substr($data, $i, 1));
379                         }
380                 }
381                 print "\n";
382         } elsif ($num == $dhcp_client::OPT_IA_NA) {
383                 printf "${indent}  IAID: 0x\%08X\n", 
384                         unpack("N", substr($data, 0, 4));
385                 printf "${indent}  T1: \%d\n", unpack("N", substr($data, 4, 4));
386                 printf "${indent}  T2: \%d\n", unpack("N", substr($data, 8, 4));
387                 if (length($data) > 12) {
388                         printf "${indent}  IA_NA encapsulated options:\n";
389                         foreach my $option (unpack_options(substr($data, 12))) {
390                                 print_option(@{$option}, $indent . "    ");
391                         }
392                 }
393         } elsif ($num == $dhcp_client::OPT_IAADDR) {
394                 printf "${indent}  IPv6 address: \%s\n", 
395                         uc(inet_ntop(AF_INET6, substr($data, 0, 16)));
396                 printf "${indent}  Preferred lifetime: \%d\n",
397                         unpack("N", substr($data, 16, 4));
398                 printf "${indent}  Valid lifetime: \%d\n",
399                         unpack("N", substr($data, 20, 4));
400                 if (length($data) > 24) {
401                         printf "${indent}  IAADDR encapsulated options:\n";
402                         foreach my $option (unpack_options(substr($data, 24))) {
403                                 print_option(@{$option}, $indent . "    ");
404                         }
405                 }
406         } elsif ($num == $dhcp_client::OPT_VENDOR_OPTS) {
407                 my $enterprise_number = unpack("N", substr($data, 0, 4));
408                 print "${indent}  Enterprise number: $enterprise_number\n";
409
410                 # DOCSIS
411                 if ($enterprise_number == 4491) {
412                         foreach my $option (unpack_options(substr($data, 4))) {
413                                 print_docsis_option(@{$option}, $indent . "  ");
414                         }
415                 }
416         } elsif ($num == $dhcp_client::OPT_STATUS_CODE) {
417                 my $code = ord(substr($data, 0, 1));
418                 my $msg = substr($data, 1);
419                 print "${indent}  Code: $code";
420                 if ($status_num_code{$code}) {
421                         print " ($status_num_code{$code})";
422                 }
423                 print "\n";
424                 print "${indent}  Message: \"$msg\"\n";
425         } 
426 }
427
428 # XXX: we aren't careful about packet boundaries and values... 
429 #       DO NOT RUN ON PRODUCTION SYSTEMS!!!
430 sub decode {
431         my ($packet, $print) = @_;
432
433         my $msg_type = ord(substr($packet, 0, 1));
434         my $trans_id = substr($packet, 1, 3);
435         my $msg = dhcp_client::msg->new($msg_type, $trans_id);
436
437         if ($print) {
438                 print "DHCPv6 packet\n";
439                 print "  Message type:   $msg_num_type{$msg_type}\n";
440                 printf "  Transaction id: 0x\%02X\%02X\%02X\n",
441                         ord(substr($trans_id, 0, 1)),
442                         ord(substr($trans_id, 1, 1)),
443                         ord(substr($trans_id, 2, 1));
444                 print "  Options:\n";
445         }
446
447         foreach my $option (unpack_options(substr($packet, 4))) {
448                 print_option(@{$option}, "    ") if ($print);
449                 $msg->add_option(@{$option});
450         }
451
452         return $msg;
453 }
454