~ubuntu-branches/ubuntu/oneiric/isc-dhcp/oneiric-security

« back to all changes in this revision

Viewing changes to tests/DHCPv6/dhcp_client.pm

  • Committer: Bazaar Package Importer
  • Author(s): Andrew Pollock
  • Date: 2009-09-02 22:34:25 UTC
  • Revision ID: james.westby@ubuntu.com-20090902223425-nypo7bkftxffq41m
Tags: upstream-4.1.0
ImportĀ upstreamĀ versionĀ 4.1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#! /usr/bin/perl -w
 
2
 
 
3
# Copyright (c) 2007 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
#   http://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