embedaddon/dhcp/tests/DHCPv6/dhcp_client.pm - view

File: [ELWIX - Embedded LightWeight unIX -] / embedaddon / dhcp / tests / DHCPv6 / dhcp_client.pm
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs - revision graph
Tue Oct 9 09:06:55 2012 UTC (11 years, 9 months ago) by misho
Branches: dhcp, MAIN
CVS tags: v4_1_R7p0, v4_1_R7, v4_1_R4, HEAD

dhcp 4.1 r7

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: