tests/DHCPv6/dhcp_client.pm

   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@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 }