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 23package dhcp_client; 24 25require 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 106my %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); 121my %msg_num_type = reverse(%msg_type_num); 122 123my %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); 144my %opt_num_type = reverse(%opt_type_num); 145 146my %status_code_num = ( 147 Success => 0, 148 UnspecFail => 1, 149 NoAddrsAvail => 2, 150 NoBinding => 3, 151 NotOnLink => 4, 152 UseMulticast => 5, 153); 154my %status_num_code = reverse(%status_code_num); 155 156my %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); 166my %docsis_num_type = reverse(%docsis_type_num); 167 168use strict; 169use English; 170use POSIX; 171 172# XXX: very Solaris-specific 173sub 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 183sub 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 203sub 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 210my $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 217sub dhcpv6_time { 218 return time() - $dhcp_time_base; 219} 220 221sub 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 239package dhcp_client::msg; 240 241use Socket; 242use Socket6; 243 244sub 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 263sub add_option { 264 my ($this, $num, $data) = @_; 265 266 push(@{$this->{options}}, [ $num, $data ]); 267} 268 269sub 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 280sub 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 291sub 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 301sub 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 314sub 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 354sub 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!!! 430sub 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 455