Return to dhcp_client.pm CVS log | Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / dhcp / tests / DHCPv6 |
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: