File Coverage

blib/lib/Net/DHCP/Packet.pm
Criterion Covered Total %
statement 168 301 55.8
branch 61 132 46.2
condition 11 35 31.4
subroutine 36 67 53.7
pod 22 22 100.0
total 298 557 53.5


line stmt bran cond sub pod time code
1             #!/bin/false
2             # Net::DHCP::Packet.pm
3             # Author : D. Hamstead
4             # Original Author: F. van Dun, S. Hadinger
5 11     11   291708 use strict;
  11         28  
  11         283  
6 11     11   56 use warnings;
  11         21  
  11         305  
7 11     11   127 use 5.8.0;
  11         40  
8              
9             package Net::DHCP::Packet;
10             $Net::DHCP::Packet::VERSION = '0.7_005';
11 11     11   57 use Carp;
  11         22  
  11         808  
12 11     11   6675 use Net::DHCP::Constants qw(:DEFAULT :dhcp_hashes :dhcp_other %DHO_FORMATS);
  11         22  
  11         12734  
13 11     11   6463 use Net::DHCP::Packet::Attributes qw(:all);
  11         27  
  11         2589  
14 11     11   56 use Net::DHCP::Packet::IPv4Utils qw(:all);
  11         16  
  11         1268  
15 11     11   54 use List::Util qw(first);
  11         19  
  11         26711  
16              
17             #=======================================================================
18              
19             {
20              
21             my %newargs = (
22              
23             Comment => \&comment,
24             Op => \&op,
25             Htype => \&htype,
26             Hlen => \&hlen,
27             Hops => \&hops,
28             Xid => \&xid,
29             Secs => \&secs,
30             Flags => \&flags,
31             Ciaddr => \&ciaddr,
32             Yiaddr => \&yiaddr,
33             Siaddr => \&siaddr,
34             Giaddr => \&giaddr,
35             Chaddr => \&chaddr,
36             Sname => \&sname,
37             File => \&file,
38             Padding => \&padding,
39             isDhcp => \&isDhcp,
40              
41             );
42              
43             sub new {
44              
45 22     22 1 6268 my $p = shift;
46 22   33     108 my $class = ref($p) || $p;
47              
48 22         297 my $self = {
49             options => {}, # DHCP options
50             options_order => [], # order in which the options were added
51              
52             # defaults
53             comment => undef,
54             op => BOOTREQUEST(),
55             htype => 1, # 10mb ethernet
56             hlen => 6, # Use 6 bytes MAC
57             hops => 0,
58             xid => 0x12345678,
59             secs => 0,
60             flags => 0,
61             ciaddr => "\0\0\0\0",
62             yiaddr => "\0\0\0\0",
63             siaddr => "\0\0\0\0",
64             giaddr => "\0\0\0\0",
65             chaddr => q||,
66             sname => q||,
67             file => q||,
68             padding => q||,
69             isDhcp => 1,
70              
71             };
72              
73 22         67 bless $self, $class;
74 22 100       74 if ( scalar @_ == 1 ) { # we build the packet from a binary string
75 7         20 $self->marshall(shift);
76             }
77             else {
78              
79 15         53 my %args = @_;
80 15         28 my @ordered_args = @_;
81              
82 15         67 for my $k (sort keys %args) { # keep the processing order consistent
83              
84 22 100       65 next if $k =~ m/^\d+$/; # ignore numbered args
85              
86 14 50       36 if ($newargs{$k}) {
87 14         53 $newargs{$k}->($self, $args{$k});
88             next
89 14         29 }
90              
91 0         0 carp sprintf 'Ingoring unknown new() argument: %s', $k;
92              
93             }
94              
95             # TBM add DHCP option parsing
96 15         62 while ( defined( my $key = shift @ordered_args ) ) {
97              
98 22         29 my $value = shift @ordered_args;
99 22 100       93 if ($key =~ m/^\d+$/) {
100 8         20 $self->addOptionValue( $key, $value );
101             }
102             }
103             }
104              
105 19         65 return $self
106              
107             }
108              
109             }
110              
111             sub addOptionRaw {
112 43     43 1 76 my ( $self, $key, $value_bin, $sort ) = @_;
113 43         105 $self->{options}->{$key} = $value_bin;
114 43         50 push @{ $self->{options_order} }, $key;
  43         103  
115              
116 43 100       127 return 1 if $sort;
117              
118             #FIXME @{ $self->{options_order} } = sort optionsorder @{ $self->{options_order} };
119              
120 27         379 return 1
121             }
122              
123             sub addOptionValue {
124 33     33 1 1979 my $self = shift;
125 33         58 my $code = shift; # option code
126 33         38 my $value = shift;
127              
128             # my $value_bin; # option value in binary format
129              
130             carp("addOptionValue: unknown format for code ($code)")
131 33 50       99 unless exists $DHO_FORMATS{$code};
132              
133 33         58 my $format = $DHO_FORMATS{$code};
134              
135 33 50       81 if ( $format eq 'suboption' ) {
136 0         0 carp 'Use addSubOptionValue to add sub options';
137 0         0 return;
138             }
139              
140             # decompose input value into an array
141 33         39 my @values;
142 33 100 66     138 if ( defined $value && $value ne q|| ) {
143 22         86 @values =
144             split( /[\s\/,;]+/, $value ); # array of values, split by space
145             }
146              
147             # verify number of parameters
148 33 100 66     220 if ( $format eq 'string' || $format eq 'csr' ) {
    100          
    100          
149 3         8 @values = ($value); # don't change format
150             }
151             elsif ( $format =~ m/s$/ ) { # ends with an 's', meaning any number of parameters
152             ;
153             }
154             elsif ( $format =~ m/2$/ ) { # ends with a '2', meaning couples of parameters
155 6 100       124 croak(
156             "addOptionValue: only pairs of values expected for option '$code'")
157             if ( ( @values % 2 ) != 0 );
158             }
159             else { # only one parameter
160 16 100       668 croak("addOptionValue: exactly one value expected for option '$code'")
161             if ( @values != 1 );
162             }
163              
164             my %options = (
165              
166 3     3   14 inet => sub { return packinet(shift) },
167 5     5   22 inets => sub { return packinets_array(@_) },
168 5     5   16 inets2 => sub { return packinets_array(@_) },
169 2     2   15 int => sub { return pack( 'N', shift ) },
170 1     1   7 short => sub { return pack( 'n', shift ) },
171             # 255 & trims the input to single octet
172 4     4   30 byte => sub { return pack( 'C', 255 & shift ) },
173             bytes => sub {
174 3     3   8 return pack( 'C*', map { 255 & $_ } @_ );
  10         27  
175             },
176 3     3   8 string => sub { return shift },
177 0     0   0 clientid => sub { return packclientid(shift) },
178 0     0   0 sipserv => sub { return packsipserv(shift) },
179 0     0   0 csr => sub { return packcsr(shift) },
180 0     0   0 suboptions => sub { return packsuboptions(@_) },
181              
182 26         474 );
183              
184             # } elsif ($format eq 'ids') {
185             # $value_bin = $values[0];
186             # # TBM bad format
187              
188             # decode the option if we know how, otherwise use the original value
189             $self->addOptionRaw( $code, $options{$format}
190 26 50       133 ? $options{$format}->(@values)
191             : $value );
192              
193             } # end AddOptionValue
194              
195             sub addSubOptionRaw {
196 0     0 1 0 my ( $self, $key, $subkey, $value_bin ) = @_;
197 0         0 $self->{options}->{$key}->{$subkey} = $value_bin;
198              
199 0         0 push @{ $self->{sub_options_order}{$subkey} }, ($key);
  0         0  
200             }
201              
202             sub addSubOptionValue {
203              
204 0     0 1 0 my $self = shift;
205 0         0 my $code = shift; # option code
206 0         0 my $subcode = shift; # sub option code
207 0         0 my $value = shift;
208 0         0 my $value_bin; # option value in binary format
209              
210             # FIXME
211             carp("addSubOptionValue: unknown format for code ($code)")
212 0 0       0 unless exists $DHO_FORMATS{$code};
213              
214             carp("addSubOptionValue: not a suboption parameter for code ($code)")
215 0 0       0 unless ( $DHO_FORMATS{$code} eq 'suboptions' );
216              
217             carp(
218             "addSubOptionValue: unknown format for subcode ($subcode) on code ($code)"
219             )
220 0 0       0 unless ( $DHO_FORMATS{$code} eq 'suboptions' );
221              
222             carp("addSubOptionValue: no suboptions defined for code ($code)?")
223 0 0       0 unless exists $SUBOPTION_CODES{$code};
224              
225             carp(
226             "addSubOptionValue: suboption ($subcode) not defined for code ($code)?")
227 0 0       0 unless exists $SUBOPTION_CODES{$code}->{$subcode};
228              
229 0         0 my $format = $SUBOPTION_CODES{$code}->{$subcode};
230              
231             # decompose input value into an array
232 0         0 my @values;
233 0 0 0     0 if ( defined $value && $value ne q|| ) {
234 0         0 @values =
235             split( /[\s\/,;]+/, $value ); # array of values, split by space
236             }
237              
238             # verify number of parameters
239 0 0       0 if ( $format eq 'string' ) {
    0          
    0          
240 0         0 @values = ($value); # don't change format
241             }
242             elsif ( $format =~ m/s$/ )
243             { # ends with an 's', meaning any number of parameters
244             ;
245             }
246             elsif ( $format =~ m/2$/ )
247             { # ends with a '2', meaning couples of parameters
248 0 0       0 croak(
249             "addSubOptionValue: only pairs of values expected for option '$code'"
250             ) if ( ( @values % 2 ) != 0 );
251             }
252             else { # only one parameter
253 0 0       0 croak(
254             "addSubOptionValue: exactly one value expected for option '$code'")
255             if ( @values != 1 );
256             }
257              
258             my %options = (
259 0     0   0 inet => sub { return packinet(shift) },
260 0     0   0 inets => sub { return packinets_array(@_) },
261 0     0   0 inets2 => sub { return packinets_array(@_) },
262 0     0   0 int => sub { return pack( 'N', shift ) },
263 0     0   0 short => sub { return pack( 'n', shift ) },
264 0     0   0 byte => sub { return pack( 'C', 255 & shift ) }
265             , # 255 & trims the input to single octet
266             bytes => sub {
267 0     0   0 return pack( 'C*', map { 255 & $_ } @_ );
  0         0  
268             },
269 0     0   0 string => sub { return shift },
270 0         0 );
271              
272             # } elsif ($format eq 'ids') {
273             # $value_bin = $values[0];
274             # # TBM bad format
275              
276             # decode the option if we know how, otherwise use the original value
277             $self->addOptionRaw( $code, $options{$format}
278 0 0       0 ? $options{$format}->(@values)
279             : $value );
280              
281             }
282              
283             sub getOptionRaw {
284 49     49 1 88 my ( $self, $key ) = @_;
285             return $self->{options}->{$key}
286 49 100       210 if exists( $self->{options}->{$key} );
287             return
288 12         40 }
289              
290             sub getOptionValue {
291 31     31 1 92 my $self = shift;
292 31         52 my $code = shift;
293              
294             carp("getOptionValue: unknown format for code ($code)")
295 31 50       84 unless exists( $DHO_FORMATS{$code} );
296              
297 31         50 my $format = $DHO_FORMATS{$code};
298 31         35 my $subcodes;
299              
300 31 50       72 if ($format eq 'suboptions') {
301 0   0     0 $subcodes = $REV_SUBOPTION_CODES{$code} || {}
302             }
303              
304 31         73 my $value_bin = $self->getOptionRaw($code);
305              
306 31 100       86 return unless defined $value_bin;
307              
308 24         29 my @values;
309              
310             # hash out these options for speed and sanity
311             my %options = (
312 4     4   16 inet => sub { return unpackinets_array(shift) },
313 3     3   11 inets => sub { return unpackinets_array(shift) },
314 2     2   7 inets2 => sub { return unpackinets_array(shift) },
315 2     2   7 int => sub { return unpack( 'N', shift ) },
316 1     1   4 short => sub { return unpack( 'n', shift ) },
317 0     0   0 shorts => sub { return unpack( 'n*', shift ) },
318 6     6   17 byte => sub { return unpack( 'C', shift ) },
319 3     3   11 bytes => sub { return unpack( 'C*', shift ) },
320 3     3   8 string => sub { return shift },
321 0     0   0 clientid => sub { return unpackclientid(shift) },
322 0     0   0 sipserv => sub { return unpacksipserv(shift) },
323 0     0   0 csr => sub { return unpackcsr(shift) },
324 0     0   0 suboptions => sub { return unpacksuboptions(shift) },
325              
326 24         438 );
327              
328             # } elsif ($format eq 'ids') {
329             # $values[0] = $value_bin;
330             # # TBM, bad format
331              
332             # decode the options if we know the format
333 24 50       133 if ($options{$format}) {
334             $value_bin = join(q|, |,
335 34 50 0     119 map { ref $_ ? sprintf '%s => %s', $subcodes->{$_->[0]} || $_->[0], # FIXME needs to guess if hex or ascii, quote if whitespace padding
336             unpack('a*',$_->[1]) : $_ }
337 24         56 ( $options{$format}->($value_bin) ))
338             }
339              
340             # if we cant work out the format
341 24         393 return $value_bin
342              
343             } # getOptionValue
344              
345             sub getSubOptionRaw {
346 0     0 1 0 my ( $self, $key, $subkey ) = @_;
347             return $self->{options}->{$key}->{$subkey}
348 0 0       0 if exists( $self->{options}->{$key}->{$subkey} );
349 0         0 return;
350             }
351              
352       0 1   sub getSubOptionValue {
353              
354             # FIXME
355             #~ my $self = shift;
356             #~ my $code = shift;
357             #~
358             #~ carp("getOptionValue: unknown format for code ($code)")
359             #~ unless exists( $DHO_FORMATS{$code} );
360             #~
361             #~ my $format = $DHO_FORMATS{$code};
362             #~
363             #~ my $value_bin = $self->getOptionRaw($code);
364             #~
365             #~ return unless defined $value_bin;
366             #~
367             #~ my @values;
368             #~
369             #~ # hash out these options for speed and sanity
370             #~ my %options = (
371             #~ inet => sub { return unpackinets_array(shift) },
372             #~ inets => sub { return unpackinets_array(shift) },
373             #~ inets2 => sub { return unpackinets_array(shift) },
374             #~ int => sub { return unpack( 'N', shift ) },
375             #~ short => sub { return unpack( 'n', shift ) },
376             #~ shorts => sub { return unpack( 'n*', shift ) },
377             #~ byte => sub { return unpack( 'C', shift ) },
378             #~ bytes => sub { return unpack( 'C*', shift ) },
379             #~ string => sub { return shift },
380             #~
381             #~ );
382             #~
383             #~ # } elsif ($format eq 'relays') {
384             #~ # @values = $self->decodeRelayAgent($value_bin);
385             #~ # # TBM, bad format
386             #~ # } elsif ($format eq 'ids') {
387             #~ # $values[0] = $value_bin;
388             #~ # # TBM, bad format
389             #~
390             #~ # decode the options if we know the format
391             #~ return join( q| |, $options{$format}->($value_bin) )
392             #~ if $options{$format};
393             #~
394             #~ # if we cant work out the format
395             #~ return $value_bin
396              
397             } # getSubOptionValue
398              
399             sub removeOption {
400 5     5 1 11 my ( $self, $key ) = @_;
401 5 100       20 if ( exists( $self->{options}->{$key} ) ) {
402             my $i =
403 5     5   11 first { $self->{options_order}->[$_] == $key }
404 3         37 0 .. $#{ $self->{options_order} };
  3         23  
405              
406             # for ( $i = 0 ; $i < @{ $self->{options_order} } ; $i++ ) {
407             # last if ( $self->{options_order}->[$i] == $key );
408             # }
409 3 50       10 if ( $i < @{ $self->{options_order} } ) {
  3         9  
410 3         3 splice @{ $self->{options_order} }, $i, 1;
  3         8  
411             }
412 3         11 delete( $self->{options}->{$key} );
413             }
414             }
415              
416       0 1   sub removeSubOption {
417              
418             # FIXME
419             #~ my ( $self, $key ) = @_;
420             #~ if ( exists( $self->{options}->{$key} ) ) {
421             #~ my $i = first { $self->{options_order}->[$_] == $key } 0..$#{ $self->{options_order} };
422             #~ # for ( $i = 0 ; $i < @{ $self->{options_order} } ; $i++ ) {
423             #~ # last if ( $self->{options_order}->[$i] == $key );
424             #~ # }
425             #~ if ( $i < @{ $self->{options_order} } ) {
426             #~ splice @{ $self->{options_order} }, $i, 1;
427             #~ }
428             #~ delete( $self->{options}->{$key} );
429             #~ }
430              
431             }
432              
433             #=======================================================================
434             my $BOOTP_FORMAT = 'C C C C N n n a4 a4 a4 a4 a16 Z64 Z128 a*';
435              
436             #my $DHCP_MIN_LENGTH = length(pack($BOOTP_FORMAT));
437             #=======================================================================
438             sub serialize {
439 11     11   69 use bytes;
  11         20  
  11         46  
440 8     8 1 1198 my ($self) = shift;
441 8         16 my $options = shift; # reference to an options hash for special options
442 8         13 my $bytes = undef;
443              
444             $bytes = pack( $BOOTP_FORMAT,
445             $self->{op}, $self->{htype}, $self->{hlen}, $self->{hops},
446             $self->{xid}, $self->{secs}, $self->{flags}, $self->{ciaddr},
447             $self->{yiaddr}, $self->{siaddr}, $self->{giaddr}, $self->{chaddr},
448 8         93 $self->{sname}, $self->{file} );
449              
450 8 50       24 if ( $self->{isDhcp} ) { # add MAGIC_COOKIE and options
451 8         17 $bytes .= MAGIC_COOKIE();
452 8         13 for my $key ( @{ $self->{options_order} } ) {
  8         25  
453 8 50       19 if ( ref($self->{options}->{$key}) eq 'ARRAY' ) {
454 0         0 for my $value ( @{$self->{options}->{$key}} ) {
  0         0  
455 0         0 $bytes .= pack( 'C', $key );
456 0         0 $bytes .= pack( 'C/a*', $value );
457             }
458             } else {
459 8         13 $bytes .= pack( 'C', $key );
460 8         21 $bytes .= pack( 'C/a*', $self->{options}->{$key} );
461             }
462             }
463 8         17 $bytes .= pack( 'C', 255 );
464             }
465              
466 8         14 $bytes .= $self->{padding}; # add optional padding
467              
468             # add padding if packet is less than minimum size
469 8         17 my $min_padding = BOOTP_MIN_LEN() - length($bytes);
470 8 100       21 if ( $min_padding > 0 ) {
471 2         8 $bytes .= "\0" x $min_padding;
472             }
473              
474             # test if packet is not bigger than absolute maximum MTU
475 8 100       23 if ( length($bytes) > DHCP_MAX_MTU() ) {
476 1         102 croak( 'serialize: packet too big ('
477             . length($bytes)
478             . ' greater than max MAX_MTU ('
479             . DHCP_MAX_MTU() );
480             }
481              
482             # test if packet length is not bigger than DHO_DHCP_MAX_MESSAGE_SIZE
483 7 50 66     29 if ( $options
484             && exists( $options->{ DHO_DHCP_MAX_MESSAGE_SIZE() } ) )
485             {
486              
487             # maximum packet size is specified
488 4         6 my $max_message_size = $options->{ DHO_DHCP_MAX_MESSAGE_SIZE() };
489 4 100 100     24 if ( ( $max_message_size >= BOOTP_MIN_LEN() )
490             && ( $max_message_size < DHCP_MAX_MTU() ) )
491             {
492              
493             # relevant message size
494 2 100       6 if ( length($bytes) > $max_message_size ) {
495 1         86 croak( 'serialize: message is bigger than allowed ('
496             . length($bytes)
497             . '), max specified :'
498             . $max_message_size );
499             }
500             }
501             }
502              
503 6         26 return $bytes
504              
505             } # end sub serialize
506              
507             #=======================================================================
508             sub marshall {
509              
510 11     11   4680 use bytes;
  11         32  
  11         40  
511 7     7 1 12 my ( $self, $buf ) = @_;
512 7         12 my $opt_buf;
513              
514 7 100       18 if ( length($buf) < BOOTP_ABSOLUTE_MIN_LEN() ) {
515 1         192 croak( sprintf
516             'marshall: packet too small (%d), absolute minimum size is %d',
517             length($buf),
518             BOOTP_ABSOLUTE_MIN_LEN() );
519             }
520 6 50       18 if ( length($buf) < BOOTP_MIN_LEN() ) {
521 0         0 carp( sprintf
522             'marshall: packet too small (%d), minimum size is %d',
523             length($buf),
524             BOOTP_MIN_LEN() );
525             }
526 6 100       15 if ( length($buf) > DHCP_MAX_MTU() ) {
527 1         202 croak( sprintf
528             'marshall: packet too big (%d), max MTU size is %s',
529             length($buf),
530             DHCP_MAX_MTU() );
531             }
532              
533             # if we are re-using this object, then we need to clear out these arrays
534             delete $self->{options}
535 5 50       20 if $self->{options};
536             delete $self->{options_order}
537 5 50       16 if $self->{options_order};
538              
539             (
540             $self->{op}, $self->{htype}, $self->{hlen}, $self->{hops},
541             $self->{xid}, $self->{secs}, $self->{flags}, $self->{ciaddr},
542             $self->{yiaddr}, $self->{siaddr}, $self->{giaddr}, $self->{chaddr},
543 5         61 $self->{sname}, $self->{file}, $opt_buf
544             ) = unpack( $BOOTP_FORMAT, $buf );
545              
546 5         15 $self->{isDhcp} = 0; # default to BOOTP
547 5 50 33     32 if ( ( length( $opt_buf ) > 4 )
548             && ( substr( $opt_buf, 0, 4 ) eq MAGIC_COOKIE() ) )
549             {
550              
551             # it is definitely DHCP
552 5         8 $self->{isDhcp} = 1;
553              
554 5         8 my $pos = 4; # Skip magic cookie
555 5         7 my $total = length($opt_buf);
556 5         6 my $type;
557              
558 5         18 while ( $pos < $total ) {
559              
560 80         124 $type = ord( substr( $opt_buf, $pos++, 1 ) );
561 80 100       226 next if ( $type eq DHO_PAD() ); # Skip padding bytes
562 20 100       53 last if ( $type eq DHO_END() ); # Type 'FF' signals end of options.
563 16         26 my $len = ord( substr( $opt_buf, $pos++, 1 ) ); # FIXME sanity check length
564 16         24 my $option = substr( $opt_buf, $pos, $len );
565 16         17 $pos += $len;
566 16         33 $self->addOptionRaw( $type, $option, 1 );
567              
568             }
569              
570             # verify that we ended with an "END" code
571 5 100       14 if ( $type != DHO_END() ) {
572 1         184 croak('marshall: unexpected end of options');
573             }
574              
575             # put remaining bytes in the padding attribute
576 4 50       10 if ( $pos < $total ) {
577 4         16 $self->{padding} = substr( $opt_buf, $pos, $total - $pos );
578             }
579             else {
580 0         0 $self->{padding} = q||;
581             }
582              
583             }
584             else {
585              
586             # in bootp, everything is padding
587 0         0 $self->{padding} = $opt_buf;
588              
589             }
590              
591 4         9 return $self
592              
593             } # end sub marshall
594              
595             #=======================================================================
596             sub toString {
597 0     0 1   my $self = shift;
598 0           my $s;
599              
600 0 0         $s .= sprintf( "comment = %s\n", $self->comment() )
601             if defined( $self->comment() );
602             $s .= sprintf(
603             "op = %s\n",
604             (
605             exists( $REV_BOOTP_CODES{ $self->op() } )
606 0   0       && $REV_BOOTP_CODES{ $self->op() }
607             )
608             || $self->op()
609             );
610             $s .= sprintf(
611             "htype = %s\n",
612             (
613             exists( $REV_HTYPE_CODES{ $self->htype() } )
614 0   0       && $REV_HTYPE_CODES{ $self->htype() }
615             )
616             || $self->htype()
617             );
618 0           $s .= sprintf( "hlen = %s\n", $self->hlen() );
619 0           $s .= sprintf( "hops = %s\n", $self->hops() );
620 0           $s .= sprintf( "xid = %x\n", $self->xid() );
621 0           $s .= sprintf( "secs = %i\n", $self->secs() );
622 0           $s .= sprintf( "flags = %x\n", $self->flags() );
623 0           $s .= sprintf( "ciaddr = %s\n", $self->ciaddr() );
624 0           $s .= sprintf( "yiaddr = %s\n", $self->yiaddr() );
625 0           $s .= sprintf( "siaddr = %s\n", $self->siaddr() );
626 0           $s .= sprintf( "giaddr = %s\n", $self->giaddr() );
627 0           $s .= sprintf( "chaddr = %s\n",
628             substr( $self->chaddr(), 0, 2 * $self->hlen() ) );
629 0           $s .= sprintf( "sname = %s\n", $self->sname() );
630 0           $s .= sprintf( "file = %s\n", $self->file() );
631 0           $s .= "Options : \n";
632              
633 0           for my $key ( @{ $self->{options_order} } ) {
  0            
634 0           my $value; # value of option to be printed
635              
636 0 0         if ( $key == DHO_DHCP_MESSAGE_TYPE() ) {
637 0           $value = $self->getOptionValue($key);
638             $value =
639             ( exists( $REV_DHCP_MESSAGE{$value} )
640 0   0       && $REV_DHCP_MESSAGE{$value} )
641             || $self->getOptionValue($key);
642             }
643             else {
644              
645 0 0         if ( exists( $DHO_FORMATS{$key} ) ) {
646 0           $value = join( q| |, $self->getOptionValue($key) );
647             }
648             else {
649 0           $value = $self->getOptionRaw($key);
650 0           print "went here for $key\n";
651             }
652              
653             # convert to printable text
654 0           $value =~
655 0           s/([[:^print:]])/ sprintf q[\x%02X], ord $1 /eg;
656             }
657             $s .= sprintf( " %s(%d) = %s\n",
658 0 0         exists $REV_DHO_CODES{$key} ? $REV_DHO_CODES{$key} : '',
659             $key, $value );
660             }
661             $s .= sprintf(
662             "padding [%s] = %s\n",
663             length( $self->{padding} ),
664             unpack( 'H*', $self->{padding} )
665 0           );
666              
667 0           return $s
668              
669             } # end toString
670              
671             #=======================================================================
672             # internal utility functions
673              
674             sub packsuboptions {
675 0 0   0 1   my @relay_opt = @_
676             or return;
677              
678 0           my $buf = '';
679 0           for my $opt (@relay_opt) {
680 0           my $value = pack( 'C/a*', $opt->[1]);
681 0           $buf .= pack( 'C', $opt->[0])
682             . pack( 'C', length($value))
683             . $value;
684             }
685              
686 0           return pack( 'C', length($buf) ) . $buf
687             }
688              
689             sub unpacksuboptions { # prints a human readable suboptions
690              
691 11     11   11908 use bytes;
  11         24  
  11         42  
692 0 0   0 1   my $opt_buf = shift or return;
693              
694 0           my @relay_opt;
695 0           my $pos = 0;
696 0           my $total = length($opt_buf);
697              
698 0           while ( $pos < $total ) {
699 0           my $type = ord( substr( $opt_buf, $pos++, 1 ) );
700 0           my $len = ord( substr( $opt_buf, $pos++, 1 ) ); # FIXME check this more
701 0           my $option = substr( $opt_buf, $pos, $len );
702 0           $pos += $len;
703 0           push @relay_opt, [ $type, $option ];
704             }
705              
706             return @relay_opt
707              
708 0           }
709              
710             sub packclientid {
711             return shift
712             # croak('pack clientid field still WIP');
713 0     0 1   }
714              
715             sub unpackclientid {
716              
717 0 0   0 1   my $clientid = shift
718             or return;
719              
720 0           my $type = unpack('C',substr( $clientid, 0, 1 ));
721              
722 0 0         if ($type == 0) { # text
723 0           return substr( $clientid, 1, length($clientid) )
724             }
725 0 0         if ($type == 1) { # ethernet
726 0           return unpack('H*',substr( $clientid, 1, length($clientid) ))
727             }
728              
729 0           return $clientid
730              
731             }
732              
733             sub packsipserv {
734             return shift
735             # croak('pack sipserv field still WIP');
736 0     0 1   }
737              
738             sub unpacksipserv {
739              
740 0 0   0 1   my $sipserv = shift
741             or return;
742              
743 0           my $type = unpack('C',substr( $sipserv, 0, 1 ));
744              
745             # if ($type == 0) { # text
746             # return substr( $sipserv, 1, length($clientid) )
747             # }
748 0 0         if ($type == 1) { # ipv4
749 0           return unpackinet(substr( $sipserv, 1, length($sipserv) ))
750             }
751              
752 0           return $sipserv
753              
754             }
755              
756             sub packcsr {
757             # catch empty value
758 0     0 1   my $results = [ '' ];
759              
760 0           for my $pair ( @{$_[0]} ) {
  0            
761 0 0         push @$results, ''
762             if (length($results->[-1]) > 255 - 8);
763              
764 0           my ($ip, $mask) = split /\//, $pair->[0];
765 0 0         $mask = '32'
766             unless (defined($mask));
767              
768 0           my $addr = packinet($ip);
769 0           $addr = substr $addr, 0, int(($mask - 1)/8 + 1);
770              
771 0           $results->[-1] .= pack('C', $mask) . $addr;
772 0           $results->[-1] .= packinet($pair->[1]);
773             }
774              
775 0           return $results;
776             }
777              
778             sub unpackcsr {
779 0 0   0 1   my $csr = shift
780             or return;
781              
782 0           croak('unpack csr field still WIP');
783              
784             }
785              
786             #=======================================================================
787              
788             1;
789              
790             =pod
791              
792             =head1 NAME
793              
794             Net::DHCP::Packet - Object methods to create a DHCP packet.
795              
796             =head1 VERSION
797              
798             version 0.7_005
799              
800             =head1 SYNOPSIS
801              
802             use Net::DHCP::Packet;
803              
804             my $p = Net::DHCP::Packet->new(
805              
806             'Chaddr' => '000BCDEF',
807             'Xid' => 0x9F0FD,
808             'Ciaddr' => '0.0.0.0',
809             'Siaddr' => '0.0.0.0',
810             'Hops' => 0
811              
812             );
813              
814             =head1 DESCRIPTION
815              
816             Represents a DHCP packet as specified in RFC 1533, RFC 2132.
817              
818             =head1 CONSTRUCTOR
819              
820             This module only provides basic constructor. For "easy" constructors, you can use
821             the L module.
822              
823             =over 4
824              
825             =item new( )
826              
827             =item new( BUFFER )
828              
829             =item new( ARG => VALUE, ARG => VALUE... )
830              
831             Creates an C object, which can be used to send or receive
832             DHCP network packets. BOOTP is not supported.
833              
834             Without argument, a default empty packet is created.
835              
836             $packet = Net::DHCP::Packet();
837              
838             A C argument is interpreted as a binary buffer like one provided
839             by the socket C function. if the packet is malformed, a fatal error
840             is issued.
841              
842             use IO::Socket::INET;
843             use Net::DHCP::Packet;
844              
845             $sock = IO::Socket::INET->new(LocalPort => 67, Proto => "udp", Broadcast => 1)
846             or die "socket: $@";
847              
848             while ($sock->recv($newmsg, 1024)) {
849             $packet = Net::DHCP::Packet->new($newmsg);
850             print $packet->toString();
851             }
852              
853             To create a fresh new packet C takes arguments as a key-value pairs :
854              
855             ARGUMENT FIELD OCTETS DESCRIPTION
856             -------- ----- ------ -----------
857              
858             Op op 1 Message op code / message type.
859             1 = BOOTREQUEST, 2 = BOOTREPLY
860             Htype htype 1 Hardware address type, see ARP section in "Assigned
861             Numbers" RFC; e.g., '1' = 10mb ethernet.
862             Hlen hlen 1 Hardware address length (e.g. '6' for 10mb
863             ethernet).
864             Hops hops 1 Client sets to zero, optionally used by relay agents
865             when booting via a relay agent.
866             Xid xid 4 Transaction ID, a random number chosen by the
867             client, used by the client and server to associate
868             messages and responses between a client and a
869             server.
870             Secs secs 2 Filled in by client, seconds elapsed since client
871             began address acquisition or renewal process.
872             Flags flags 2 Flags (see figure 2).
873             Ciaddr ciaddr 4 Client IP address; only filled in if client is in
874             BOUND, RENEW or REBINDING state and can respond
875             to ARP requests.
876             Yiaddr yiaddr 4 'your' (client) IP address.
877             Siaddr siaddr 4 IP address of next server to use in bootstrap;
878             returned in DHCPOFFER, DHCPACK by server.
879             Giaddr giaddr 4 Relay agent IP address, used in booting via a
880             relay agent.
881             Chaddr chaddr 16 Client hardware address.
882             Sname sname 64 Optional server host name, null terminated string.
883             File file 128 Boot file name, null terminated string; "generic"
884             name or null in DHCPDISCOVER, fully qualified
885             directory-path name in DHCPOFFER.
886             IsDhcp isDhcp 4 Controls whether the packet is BOOTP or DHCP.
887             DHCP conatains the "magic cookie" of 4 bytes.
888             0x63 0x82 0x53 0x63.
889             DHO_*code Optional parameters field. See the options
890             documents for a list of defined options.
891             See Net::DHCP::Constants.
892             Padding padding * Optional padding at the end of the packet
893              
894             See below methods for values and syntax description.
895              
896             Note: DHCP options are created in the same order as key-value pairs.
897              
898             =back
899              
900             =head1 METHODS
901              
902             =head2 ATTRIBUTE METHODS
903              
904             See L
905              
906              
907             =head2 DHCP OPTIONS METHODS
908              
909             This section describes how to read or set DHCP options. Methods are given
910             in two flavours : (i) text format with automatic type conversion,
911             (ii) raw binary format.
912              
913             Standard way of accessing options is through automatic type conversion,
914             described in the L section. Only a subset of types
915             is supported, mainly those defined in rfc 2132.
916              
917             Raw binary functions are provided for pure performance optimization,
918             and for unsupported types manipulation.
919              
920             =over 4
921              
922             =item addOptionValue ( CODE, VALUE )
923              
924             Adds a DHCP option field. Common code values are listed in
925             C C*.
926              
927             Values are automatically converted according to their data types,
928             depending on their format as defined by RFC 2132.
929             Please see L for supported options and corresponding
930             formats.
931              
932             If you need access to the raw binary values, please use C.
933              
934             $pac = Net::DHCP::Packet->new();
935             $pac->addOption(DHO_DHCP_MESSAGE_TYPE(), DHCPINFORM());
936             $pac->addOption(DHO_NAME_SERVERS(), "10.0.0.1", "10.0.0.2"));
937              
938             =item addSubOptionValue ( CODE, SUBCODE, VALUE )
939              
940             Adds a DHCP sub-option field. Common code values are listed in
941             C C*.
942              
943             Values are automatically converted according to their data types,
944             depending on their format as defined by RFC 2132.
945             Please see L for supported options and corresponding
946             formats.
947              
948             If you need access to the raw binary values, please use C.
949              
950             $pac = Net::DHCP::Packet->new();
951             # FIXME update examples
952             $pac->addSubOption(DHO_DHCP_MESSAGE_TYPE(), DHCPINFORM());
953             $pac->addSubOption(DHO_NAME_SERVERS(), "10.0.0.1", "10.0.0.2"));
954              
955              
956             =item getOptionValue ( CODE )
957              
958             Returns the value of a DHCP option.
959              
960             Automatic type conversion is done according to their data types,
961             as defined in RFC 2132.
962             Please see L for supported options and corresponding
963             formats.
964              
965             If you need access to the raw binary values, please use C.
966              
967             Return value is either a string or an array, depending on the context.
968              
969             $ip = $pac->getOptionValue(DHO_SUBNET_MASK());
970             $ips = $pac->getOptionValue(DHO_NAME_SERVERS());
971              
972             =item addOptionRaw ( CODE, VALUE, BOOLEAN )
973              
974             Adds a DHCP OPTION provided in packed binary format.
975             Please see corresponding RFC for manual type conversion.
976              
977             BOOLEAN indicates if options should be inserted in the order provided.
978             Default is to sort options to work around known quirky clients.
979             See L
980              
981             =item addSubOptionRaw ( CODE, SUBCODE, VALUE )
982              
983             Adds a DHCP SUB-OPTION provided in packed binary format.
984             Please see corresponding RFC for manual type conversion.
985              
986             =item getOptionRaw ( CODE )
987              
988             Gets a DHCP OPTION provided in packed binary format.
989             Please see corresponding RFC for manual type conversion.
990              
991             =item getSubOptionRaw ( CODE, SUBCODE )
992              
993             Gets a DHCP SUB-OPTION provided in packed binary format.
994             Please see corresponding RFC for manual type conversion.
995              
996             =item getSubOptionValue ()
997              
998             This is an empty stub for now
999              
1000             =item removeSubOption ()
1001              
1002             This is an empty stub for now
1003              
1004             =item I
1005              
1006             Remove option from option list.
1007              
1008             =item I
1009              
1010             returns the packed Client-identifier (pass-through currently)
1011              
1012             =item I
1013              
1014             returns the unpacked clientid.
1015              
1016             Decodes:
1017             type 0 as a string
1018             type 1 as a mac address (hex string)
1019             everything is passed through
1020              
1021             =item I
1022              
1023             returns the packed sip server field (pass-through currently)
1024              
1025             =item I
1026              
1027             returns the unpacked sip server.
1028              
1029             Decodes:
1030             type 1 as an ipv4 address
1031             everything is passed through
1032              
1033             =item I
1034              
1035             returns the packed Classless Static Route option built from a list of CIDR style address/mask combos
1036              
1037             =item I
1038              
1039             Not implemented, currently croaks.
1040              
1041             =item I
1042              
1043             I instead.>
1044              
1045             =item I
1046              
1047             I instead.>
1048              
1049             =back
1050              
1051             =head2 DHCP OPTIONS TYPES
1052              
1053             This section describes supported option types (cf. RFC 2132).
1054              
1055             For unsupported data types, please use C and
1056             C to manipulate binary format directly.
1057              
1058             =over 4
1059              
1060             =item dhcp message type
1061              
1062             Only supported for DHO_DHCP_MESSAGE_TYPE (053) option.
1063             Converts a integer to a single byte.
1064              
1065             Option code for 'dhcp message' format:
1066              
1067             (053) DHO_DHCP_MESSAGE_TYPE
1068              
1069             Example:
1070              
1071             $pac->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), DHCPINFORM());
1072              
1073             =item string
1074              
1075             Pure string attribute, no type conversion.
1076              
1077             Option codes for 'string' format:
1078              
1079             (012) DHO_HOST_NAME
1080             (014) DHO_MERIT_DUMP
1081             (015) DHO_DOMAIN_NAME
1082             (017) DHO_ROOT_PATH
1083             (018) DHO_EXTENSIONS_PATH
1084             (047) DHO_NETBIOS_SCOPE
1085             (056) DHO_DHCP_MESSAGE
1086             (060) DHO_VENDOR_CLASS_IDENTIFIER
1087             (062) DHO_NWIP_DOMAIN_NAME
1088             (064) DHO_NIS_DOMAIN
1089             (065) DHO_NIS_SERVER
1090             (066) DHO_TFTP_SERVER
1091             (067) DHO_BOOTFILE
1092             (086) DHO_NDS_TREE_NAME
1093             (098) DHO_USER_AUTHENTICATION_PROTOCOL
1094              
1095             Example:
1096              
1097             $pac->addOptionValue(DHO_TFTP_SERVER(), "foobar");
1098              
1099             =item single ip address
1100              
1101             Exactly one IP address, in dotted numerical format '192.168.1.1'.
1102              
1103             Option codes for 'single ip address' format:
1104              
1105             (001) DHO_SUBNET_MASK
1106             (016) DHO_SWAP_SERVER
1107             (028) DHO_BROADCAST_ADDRESS
1108             (032) DHO_ROUTER_SOLICITATION_ADDRESS
1109             (050) DHO_DHCP_REQUESTED_ADDRESS
1110             (054) DHO_DHCP_SERVER_IDENTIFIER
1111             (118) DHO_SUBNET_SELECTION
1112              
1113             Example:
1114              
1115             $pac->addOptionValue(DHO_SUBNET_MASK(), "255.255.255.0");
1116              
1117             =item multiple ip addresses
1118              
1119             Any number of IP address, in dotted numerical format '192.168.1.1'.
1120             Empty value allowed.
1121              
1122             Option codes for 'multiple ip addresses' format:
1123              
1124             (003) DHO_ROUTERS
1125             (004) DHO_TIME_SERVERS
1126             (005) DHO_NAME_SERVERS
1127             (006) DHO_DOMAIN_NAME_SERVERS
1128             (007) DHO_LOG_SERVERS
1129             (008) DHO_COOKIE_SERVERS
1130             (009) DHO_LPR_SERVERS
1131             (010) DHO_IMPRESS_SERVERS
1132             (011) DHO_RESOURCE_LOCATION_SERVERS
1133             (041) DHO_NIS_SERVERS
1134             (042) DHO_NTP_SERVERS
1135             (044) DHO_NETBIOS_NAME_SERVERS
1136             (045) DHO_NETBIOS_DD_SERVER
1137             (048) DHO_FONT_SERVERS
1138             (049) DHO_X_DISPLAY_MANAGER
1139             (068) DHO_MOBILE_IP_HOME_AGENT
1140             (069) DHO_SMTP_SERVER
1141             (070) DHO_POP3_SERVER
1142             (071) DHO_NNTP_SERVER
1143             (072) DHO_WWW_SERVER
1144             (073) DHO_FINGER_SERVER
1145             (074) DHO_IRC_SERVER
1146             (075) DHO_STREETTALK_SERVER
1147             (076) DHO_STDA_SERVER
1148             (085) DHO_NDS_SERVERS
1149              
1150             Example:
1151              
1152             $pac->addOptionValue(DHO_NAME_SERVERS(), "10.0.0.11 192.168.1.10");
1153              
1154             =item pairs of ip addresses
1155              
1156             Even number of IP address, in dotted numerical format '192.168.1.1'.
1157             Empty value allowed.
1158              
1159             Option codes for 'pairs of ip address' format:
1160              
1161             (021) DHO_POLICY_FILTER
1162             (033) DHO_STATIC_ROUTES
1163              
1164             Example:
1165              
1166             $pac->addOptionValue(DHO_STATIC_ROUTES(), "10.0.0.1 192.168.1.254");
1167              
1168             =item byte, short and integer
1169              
1170             Numerical value in byte (8 bits), short (16 bits) or integer (32 bits)
1171             format.
1172              
1173             Option codes for 'byte (8)' format:
1174              
1175             (019) DHO_IP_FORWARDING
1176             (020) DHO_NON_LOCAL_SOURCE_ROUTING
1177             (023) DHO_DEFAULT_IP_TTL
1178             (027) DHO_ALL_SUBNETS_LOCAL
1179             (029) DHO_PERFORM_MASK_DISCOVERY
1180             (030) DHO_MASK_SUPPLIER
1181             (031) DHO_ROUTER_DISCOVERY
1182             (034) DHO_TRAILER_ENCAPSULATION
1183             (036) DHO_IEEE802_3_ENCAPSULATION
1184             (037) DHO_DEFAULT_TCP_TTL
1185             (039) DHO_TCP_KEEPALIVE_GARBAGE
1186             (046) DHO_NETBIOS_NODE_TYPE
1187             (052) DHO_DHCP_OPTION_OVERLOAD
1188             (116) DHO_AUTO_CONFIGURE
1189              
1190             Option codes for 'short (16)' format:
1191              
1192             (013) DHO_BOOT_SIZE
1193             (022) DHO_MAX_DGRAM_REASSEMBLY
1194             (026) DHO_INTERFACE_MTU
1195             (057) DHO_DHCP_MAX_MESSAGE_SIZE
1196              
1197             Option codes for 'integer (32)' format:
1198              
1199             (002) DHO_TIME_OFFSET
1200             (024) DHO_PATH_MTU_AGING_TIMEOUT
1201             (035) DHO_ARP_CACHE_TIMEOUT
1202             (038) DHO_TCP_KEEPALIVE_INTERVAL
1203             (051) DHO_DHCP_LEASE_TIME
1204             (058) DHO_DHCP_RENEWAL_TIME
1205             (059) DHO_DHCP_REBINDING_TIME
1206              
1207             Examples:
1208              
1209             $pac->addOptionValue(DHO_DHCP_OPTION_OVERLOAD(), 3);
1210             $pac->addOptionValue(DHO_INTERFACE_MTU(), 1500);
1211             $pac->addOptionValue(DHO_DHCP_RENEWAL_TIME(), 24*60*60);
1212              
1213             =item multiple bytes, shorts
1214              
1215             A list a bytes or shorts.
1216              
1217             Option codes for 'multiple bytes (8)' format:
1218              
1219             (055) DHO_DHCP_PARAMETER_REQUEST_LIST
1220              
1221             Option codes for 'multiple shorts (16)' format:
1222              
1223             (025) DHO_PATH_MTU_PLATEAU_TABLE
1224             (117) DHO_NAME_SERVICE_SEARCH
1225              
1226             Examples:
1227              
1228             $pac->addOptionValue(DHO_DHCP_PARAMETER_REQUEST_LIST(), "1 3 6 12 15 28 42 72");
1229              
1230             =back
1231              
1232             =head2 SERIALIZATION METHODS
1233              
1234             =over 4
1235              
1236             =item serialize ()
1237              
1238             Converts a Net::DHCP::Packet to a string, ready to put on the network.
1239              
1240             =item marshall ( BYTES )
1241              
1242             The inverse of serialize. Converts a string, presumably a
1243             received UDP packet, into a Net::DHCP::Packet.
1244              
1245             If the packet is malformed, a fatal error is produced.
1246              
1247             =back
1248              
1249             =head2 HELPER METHODS
1250              
1251             =over 4
1252              
1253             =item toString ()
1254              
1255             Returns a textual representation of the packet, for debugging.
1256              
1257             =item packsuboptions ( LIST )
1258              
1259             Transforms an list of lists into packed option.
1260             For option 43 (vendor specific), 82 (relay agent) etc.
1261              
1262             =item unpacksuboptions ( STRING )
1263              
1264             Unpacks sub-options to a list of lists
1265              
1266             =back
1267              
1268             See also L
1269              
1270             =head1 EXAMPLES
1271              
1272             Sending a simple DHCP packet:
1273              
1274             #!/usr/bin/perl
1275             # Simple DHCP client - sending a broadcasted DHCP Discover request
1276              
1277             use IO::Socket::INET;
1278             use Net::DHCP::Packet;
1279             use Net::DHCP::Constants;
1280              
1281             # creat DHCP Packet
1282             $discover = Net::DHCP::Packet->new(
1283             xid => int(rand(0xFFFFFFFF)), # random xid
1284             Flags => 0x8000, # ask for broadcast answer
1285             DHO_DHCP_MESSAGE_TYPE() => DHCPDISCOVER()
1286             );
1287              
1288             # send packet
1289             $handle = IO::Socket::INET->new(Proto => 'udp',
1290             Broadcast => 1,
1291             PeerPort => '67',
1292             LocalPort => '68',
1293             PeerAddr => '255.255.255.255')
1294             or die "socket: $@"; # yes, it uses $@ here
1295             $handle->send($discover->serialize())
1296             or die "Error sending broadcast inform:$!\n";
1297              
1298             Sniffing DHCP packets.
1299              
1300             #!/usr/bin/perl
1301             # Simple DHCP server - listen to DHCP packets and print them
1302              
1303             use IO::Socket::INET;
1304             use Net::DHCP::Packet;
1305             $sock = IO::Socket::INET->new(LocalPort => 67, Proto => "udp", Broadcast => 1)
1306             or die "socket: $@";
1307             while ($sock->recv($newmsg, 1024)) {
1308             $packet = Net::DHCP::Packet->new($newmsg);
1309             print STDERR $packet->toString();
1310             }
1311              
1312             Sending a LEASEQUERY (provided by John A. Murphy).
1313              
1314             #!/usr/bin/perl
1315             # Simple DHCP client - send a LeaseQuery (by IP) and receive the response
1316              
1317             use IO::Socket::INET;
1318             use Net::DHCP::Packet;
1319             use Net::DHCP::Constants;
1320              
1321             $usage = "usage: $0 DHCP_SERVER_IP DHCP_CLIENT_IP\n"; $ARGV[1] || die $usage;
1322              
1323             # create a socket
1324             $handle = IO::Socket::INET->new(Proto => 'udp',
1325             Broadcast => 1,
1326             PeerPort => '67',
1327             LocalPort => '67',
1328             PeerAddr => $ARGV[0])
1329             or die "socket: $@"; # yes, it uses $@ here
1330              
1331             # create DHCP Packet
1332             $inform = Net::DHCP::Packet->new(
1333             op => BOOTREQUEST(),
1334             Htype => '0',
1335             Hlen => '0',
1336             Ciaddr => $ARGV[1],
1337             Giaddr => $handle->sockhost(),
1338             Xid => int(rand(0xFFFFFFFF)), # random xid
1339             DHO_DHCP_MESSAGE_TYPE() => DHCPLEASEQUERY
1340             );
1341              
1342             # send request
1343             $handle->send($inform->serialize()) or die "Error sending LeaseQuery: $!\n";
1344              
1345             #receive response
1346             $handle->recv($newmsg, 1024) or die;
1347             $packet = Net::DHCP::Packet->new($newmsg);
1348             print $packet->toString();
1349              
1350             A simple DHCP Server is provided in the "examples" directory. It is composed of
1351             "dhcpd.pl" a *very* simple server example, and "dhcpd_test.pl" a simple tester for
1352             this server.
1353              
1354             =head1 AUTHOR
1355              
1356             Dean Hamstead Edean@bytefoundry.com.au
1357             Previously Stephan Hadinger Eshadinger@cpan.orgE.
1358             Original version by F. van Dun.
1359              
1360             =head1 BUGS
1361              
1362             See L
1363              
1364             =head1 GOT PATCHES?
1365              
1366             Many young people like to use Github, so by all means send me pull requests at
1367              
1368             https://github.com/djzort/Net-DHCP
1369              
1370             =head1 COPYRIGHT
1371              
1372             This is free software. It can be distributed and/or modified under the same terms as
1373             Perl itself.
1374              
1375             =head1 SEE ALSO
1376              
1377             L, L, L,
1378             L, L.
1379              
1380             =cut