1 #! /usr/bin/perl -w 2 3 # Copyright (C) 2007-2022 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 # PO Box 360 19 # Newmarket, NH 03857 USA 20 # <info (at] 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
Indexes created Sat Feb 28 05:31:39 UTC 2026