1 1.1 christos #! /usr/bin/perl -w 2 1.1 christos 3 1.1.1.2 christos # Copyright (C) 2007-2022 Internet Systems Consortium, Inc. ("ISC") 4 1.1 christos # 5 1.1 christos # Permission to use, copy, modify, and distribute this software for any 6 1.1 christos # purpose with or without fee is hereby granted, provided that the above 7 1.1 christos # copyright notice and this permission notice appear in all copies. 8 1.1 christos # 9 1.1 christos # THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES 10 1.1 christos # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 1.1 christos # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR 12 1.1 christos # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 1.1 christos # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 1.1 christos # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT 15 1.1 christos # OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 1.1 christos # 17 1.1 christos # Internet Systems Consortium, Inc. 18 1.1.1.2 christos # PO Box 360 19 1.1.1.2 christos # Newmarket, NH 03857 USA 20 1.1 christos # <info (at] isc.org> 21 1.1 christos # https://www.isc.org/ 22 1.1 christos 23 1.1 christos use strict; 24 1.1 christos use English; 25 1.1 christos use Time::HiRes qw( sleep ); 26 1.1 christos use Socket; 27 1.1 christos use Socket6; 28 1.1 christos use IO::Select; 29 1.1 christos 30 1.1 christos use dhcp_client; 31 1.1 christos 32 1.1 christos # XXX: for debugging 33 1.1 christos use Data::Dumper; 34 1.1 christos 35 1.1 christos # not-yet-standard options 36 1.1 christos my $OPT_TIME_SERVERS = 40; 37 1.1 christos my $OPT_TIME_OFFSET = 41; 38 1.1 christos 39 1.1 christos # DOCSIS sub-options 40 1.1 christos my $DOCSIS_OPT_ORO = 1; 41 1.1 christos # 2 to 31 are reserved 42 1.1 christos my $DOCSIS_OPT_TFTP_SERVERS = 32; 43 1.1 christos my $DOCSIS_OPT_CONFIG_FILE_NAME = 33; 44 1.1 christos my $DOCSIS_OPT_SYSLOG_SERVERS = 34; 45 1.1 christos my $DOCSIS_OPT_TLV5 = 35; 46 1.1 christos my $DOCSIS_OPT_DEVICE_ID = 36; 47 1.1 christos my $DOCSIS_OPT_CCC = 37; 48 1.1 christos my $DOCSIS_OPT_VERS = 38; 49 1.1 christos 50 1.1 christos # well-known addresses 51 1.1 christos my $All_DHCP_Relay_Agents_and_Servers = "ff02::1:2"; 52 1.1 christos my $All_DHCP_Servers = "ff05::1:3"; 53 1.1 christos 54 1.1 christos # ports 55 1.1 christos my $client_port = 546; 56 1.1 christos my $server_port = 547; 57 1.1 christos 58 1.1 christos # create a new Solicit message 59 1.1 christos my $msg = dhcp_client::msg->new($MSG_INFORMATION_REQUEST); 60 1.1 christos 61 1.1 christos # add the Client Identifier (required by DOCSIS and RFC 3315) 62 1.1 christos $msg->add_option($OPT_CLIENTID, dhcp_client::duid()); 63 1.1 christos 64 1.1 christos # add Elapsed Time, set to 0 on first packet (required by RFC 3315) 65 1.1 christos $msg->add_option($OPT_ELAPSED_TIME, "\x00\x00"); 66 1.1 christos 67 1.1 christos # add IA_TA for each interface (should be IA_NA, by DOCSIS and RFC 3315) 68 1.1 christos # XXX: should this be a single interface only? 69 1.1 christos my $iaid = 0; 70 1.1 christos foreach my $iface (dhcp_client::iface()) { 71 1.1 christos my $option_data = pack("NNN", ++$iaid, 0, 0); 72 1.1 christos $msg->add_option($OPT_IA_TA, $option_data); 73 1.1 christos } 74 1.1 christos 75 1.1 christos # add Reconfigure Accept (required by DOCSIS) 76 1.1 christos $msg->add_option($OPT_RECONF_ACCEPT, ""); 77 1.1 christos 78 1.1 christos # add Options Request (required by DOCSIS, recommended by RFC 3315) 79 1.1 christos my @oro = ( $OPT_TIME_SERVERS, $OPT_TIME_OFFSET ); 80 1.1 christos $msg->add_option($OPT_ORO, pack("n*", @oro)); 81 1.1 christos 82 1.1 christos 83 1.1 christos # add Vendor Class option (required by DOCSIS) 84 1.1 christos $msg->add_option($OPT_VENDOR_CLASS, pack("N", 4491) . "docsis3.0"); 85 1.1 christos 86 1.1 christos # add Vendor-specific Information Option option (required by DOCSIS) 87 1.1 christos my $vsio = pack("N", 4491); 88 1.1 christos 89 1.1 christos # ORO (required by DOCSIS) 90 1.1 christos my @docsis_oro = ( $DOCSIS_OPT_TFTP_SERVERS ); 91 1.1 christos $vsio .= pack("nnC*", $DOCSIS_OPT_ORO, 0+@docsis_oro, @docsis_oro); 92 1.1 christos 93 1.1 christos # TLV5 data: CMTS DOCSIS version number 3.0 (required by DOCSIS) 94 1.1.1.2 christos my $tlv5_data = "\x01\x02\x03\x0"; 95 1.1 christos $vsio .= pack("nn", $DOCSIS_OPT_TLV5, length($tlv5_data)) . $tlv5_data; 96 1.1 christos 97 1.1 christos # DOCSIS Device (required by DOCSIS) 98 1.1 christos my $docsis_device_id = dhcp_client::mac_addr_binary(); 99 1.1 christos $vsio .= pack("nn", $DOCSIS_OPT_DEVICE_ID, length($docsis_device_id)); 100 1.1 christos $vsio .= $docsis_device_id; 101 1.1 christos 102 1.1 christos $msg->add_option($OPT_VENDOR_OPTS, $vsio); 103 1.1 christos 104 1.1 christos # add Rapid Commit option (required by DOCSIS) 105 1.1 christos $msg->add_option($OPT_RAPID_COMMIT, ""); 106 1.1 christos 107 1.1 christos # timeout parameters, from DOCSIS 108 1.1 christos my $IRT = $SOL_TIMEOUT; 109 1.1 christos my $MRT = $SOL_MAX_RT; 110 1.1 christos my $MRC = 1; # DOCSIS says 4, RFC 3315 says it SHOULD be 0 111 1.1 christos my $MRD = 0; 112 1.1 christos 113 1.1 christos # sleep a random amount of time between 0 and 1 second, required by RFC 3315 114 1.1 christos # XXX: this seems pretty stupid 115 1.1 christos sleep(rand($SOL_MAX_DELAY)); 116 1.1 christos 117 1.1 christos my $RT; 118 1.1 christos my $count = 0; 119 1.1 christos my $mrd_end_time; 120 1.1 christos if ($MRD != 0) { 121 1.1 christos $mrd_end_time = time() + $MRD; 122 1.1 christos } 123 1.1 christos my $reply_msg; 124 1.1 christos do { 125 1.1 christos # create our socket, and send our Solicit 126 1.1 christos socket(SOCK, PF_INET6, SOCK_DGRAM, getprotobyname('udp')) || die; 127 1.1 christos my $addr = inet_pton(AF_INET6, $All_DHCP_Servers); 128 1.1 christos my $packet = $msg->packet(); 129 1.1.1.2 christos my $send_ret = send(SOCK, $packet, 0, 130 1.1 christos pack_sockaddr_in6($server_port, $addr)); 131 1.1 christos if (not defined($send_ret)) { 132 1.1.1.2 christos printf STDERR 133 1.1 christos "Error \%d sending DHCPv6 Solicit message;\n\%s\n", 134 1.1 christos 0+$ERRNO, $ERRNO; 135 1.1 christos exit(1); 136 1.1 christos } elsif ($send_ret != length($packet)) { 137 1.1 christos print STDERR "Unable to send entire DHCPv6 Solicit message.\n"; 138 1.1 christos exit(1); 139 1.1 christos } 140 1.1 christos $count++; 141 1.1 christos 142 1.1 christos my $RAND = rand(0.2) - 0.1; 143 1.1 christos if (defined $RT) { 144 1.1 christos $RT = 2*$RT + $RAND*$RT; 145 1.1 christos if (($RT > $MRT) && ($MRT != 0)) { 146 1.1 christos $RT = $MRT + $RAND*$RT; 147 1.1 christos } 148 1.1 christos } else { 149 1.1 christos $RT = $IRT + $RAND*$IRT; 150 1.1 christos } 151 1.1 christos 152 1.1 christos my $rt_end_time = time() + $RT; 153 1.1.1.2 christos if (defined($mrd_end_time) && ($mrd_end_time > $rt_end_time)) { 154 1.1 christos $rt_end_time = $mrd_end_time; 155 1.1 christos } 156 1.1 christos 157 1.1 christos for (;;) { 158 1.1 christos my $timeout = $rt_end_time - time(); 159 1.1 christos if ($timeout < 0) { 160 1.1 christos # print STDERR "Timeout waiting for DHCPv6 Advertise ", 161 1.1 christos # "or Reply message.\n"; 162 1.1 christos last; 163 1.1 christos } 164 1.1 christos 165 1.1 christos my @ready = IO::Select->new(\*SOCK)->can_read($timeout); 166 1.1 christos 167 1.1 christos if (@ready) { 168 1.1 christos my $reply; 169 1.1 christos my $recv_ret; 170 1.1.1.2 christos 171 1.1 christos $recv_ret = recv(SOCK, $reply, 1500, 0); 172 1.1 christos if (not defined $recv_ret) { 173 1.1.1.2 christos printf STDERR 174 1.1.1.2 christos "Error \%d receiving DHCPv6 " . 175 1.1 christos "message;\n\%s\n", 176 1.1 christos 0+$ERRNO, $ERRNO; 177 1.1 christos exit(1); 178 1.1 christos } 179 1.1 christos 180 1.1 christos $reply_msg = dhcp_client::msg::decode($reply); 181 1.1 christos if (($reply_msg->{msg_type} == $MSG_ADVERTISE) || 182 1.1 christos ($reply_msg->{msg_type} == $MSG_REPLY)) { 183 1.1 christos last; 184 1.1 christos } 185 1.1 christos } 186 1.1 christos } 187 1.1 christos 188 1.1.1.2 christos } until ($reply_msg || 189 1.1 christos (($MRC != 0) && ($count > $MRC)) || 190 1.1 christos (defined($mrd_end_time) && ($mrd_end_time > time()))); 191 1.1 christos 192 1.1 christos unless ($reply_msg) { 193 1.1 christos if (($MRC != 0) && ($count >= $MRC)) { 194 1.1.1.2 christos print STDERR 195 1.1 christos "No reply after maximum retransmission count.\n"; 196 1.1 christos } else { 197 1.1.1.2 christos print STDERR 198 1.1 christos "No reply after maximum retransmission duration.\n"; 199 1.1 christos } 200 1.1 christos } 201 1.1 christos 202 1.1 christos if ($reply_msg && ($reply_msg->{msg_type} == $MSG_REPLY)) { 203 1.1 christos print "Got DHCPv6 Reply message.\n"; 204 1.1 christos exit(0); 205 1.1 christos } 206 1.1 christos 207 1.1 christos #$Data::Dumper::Useqq = 1; 208 1.1 christos #print Dumper($msg), "\n"; 209 1.1 christos #print Dumper($msg->packet()), "\n"; 210 1.1 christos # 211 1.1 christos #print "packet length: ", length($msg->packet()), "\n"; 212