Annotation of embedaddon/dhcp/tests/DHCPv6/dhcp_client.pm, revision 1.1.1.1
1.1 misho 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dhcp_client.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / dhcp / tests / DHCPv6