Annotation of embedaddon/dhcp/tests/DHCPv6/dhcp_client.pm, revision 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