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