File Coverage

blib/lib/Net/DHCP/Packet/Attributes.pm
Criterion Covered Total %
statement 111 123 90.2
branch 42 52 80.7
condition n/a
subroutine 30 30 100.0
pod 22 22 100.0
total 205 227 90.3


line stmt bran cond sub pod time code
1             #!/bin/false
2             # Net::DHCP::Packet/Attributes.pm
3             # Author : D. Hamstead
4             # Original Author: F. van Dun, S. Hadinger
5 11     11   50 use strict;
  11         17  
  11         301  
6 11     11   51 use warnings;
  11         17  
  11         295  
7 11     11   116 use 5.8.0;
  11         28  
8              
9             package Net::DHCP::Packet::Attributes;
10             $Net::DHCP::Packet::Attributes::VERSION = '0.7_005';
11             # standard module declaration
12             our ( @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
13 11     11   54 use Exporter;
  11         15  
  11         985  
14             @ISA = qw(Exporter);
15             @EXPORT = qw( );
16             @EXPORT_OK = qw(
17             comment op htype hlen hops xid secs flags ciaddr
18             ciaddrRaw yiaddr yiaddrRaw siaddr siaddrRaw giaddr giaddrRaw
19             chaddr chaddrRaw sname file isDhcp padding
20             );
21             %EXPORT_TAGS = ( all => \@EXPORT_OK );
22              
23 11     11   48 use Carp qw/ carp /;
  11         18  
  11         511  
24 11     11   5475 use Net::DHCP::Packet::IPv4Utils qw( packinet unpackinet );
  11         23  
  11         9727  
25              
26             #=======================================================================
27             # comment attribute : enables transaction number identification
28             sub comment {
29 2     2 1 14 my $self = shift;
30 2 50       19 if (@_) { $self->{comment} = shift }
  0         0  
31 2         18 return $self->{comment};
32             }
33              
34             # op attribute
35             sub op {
36 3     3 1 6 my $self = shift;
37 3 100       15 if (@_) { $self->{op} = shift }
  1         3  
38 3         15 return $self->{op};
39             }
40              
41             # htype attribute
42             sub htype {
43 3     3 1 5 my $self = shift;
44 3 100       10 if (@_) { $self->{htype} = shift }
  1         2  
45 3         11 return $self->{htype};
46             }
47              
48             # hlen attribute
49             sub hlen {
50 3     3 1 6 my $self = shift;
51 3 100       10 if (@_) { $self->{hlen} = shift }
  1         3  
52 3 50       11 if ( $self->{hlen} < 0 ) {
53 0         0 carp( 'hlen must not be < 0 (currently ' . $self->{hlen} . ')' );
54 0         0 $self->{hlen} = 0;
55             }
56 3 50       10 if ( $self->{hlen} > 16 ) {
57 0         0 carp( 'hlen must not be > 16 (currently ' . $self->{hlen} . ')' );
58 0         0 $self->{hlen} = 16;
59             }
60 3         11 return $self->{hlen};
61             }
62              
63             # hops attribute
64             sub hops {
65 3     3 1 5 my $self = shift;
66 3 100       10 if (@_) { $self->{hops} = shift }
  1         2  
67 3         11 return $self->{hops};
68             }
69              
70             # xid attribute
71             sub xid {
72 3     3 1 6 my $self = shift;
73 3 100       12 if (@_) { $self->{xid} = shift }
  1         3  
74 3         11 return $self->{xid};
75             }
76              
77             # secs attribute
78             sub secs {
79 1     1 1 2 my $self = shift;
80 1 50       5 if (@_) { $self->{secs} = shift }
  0         0  
81 1         4 return $self->{secs};
82             }
83              
84             # flags attribute
85             sub flags {
86 2     2 1 4 my $self = shift;
87 2 100       7 if (@_) { $self->{flags} = shift }
  1         2  
88 2         6 return $self->{flags};
89             }
90              
91             # ciaddr attribute
92             sub ciaddr {
93 3     3 1 7 my $self = shift;
94 3 100       11 if (@_) { $self->{ciaddr} = packinet(shift) }
  1         7  
95 3         18 return unpackinet( $self->{ciaddr} );
96             }
97              
98             # ciaddr attribute, Raw version
99             sub ciaddrRaw {
100 2     2 1 4 my $self = shift;
101 2 50       9 if (@_) { $self->{ciaddr} = shift }
  0         0  
102 2         10 return $self->{ciaddr};
103             }
104              
105             # yiaddr attribute
106             sub yiaddr {
107 3     3 1 7 my $self = shift;
108 3 100       14 if (@_) { $self->{yiaddr} = packinet(shift) }
  1         3  
109 3         13 return unpackinet( $self->{yiaddr} );
110             }
111              
112             # yiaddr attribute, Raw version
113             sub yiaddrRaw {
114 2     2 1 5 my $self = shift;
115 2 50       9 if (@_) { $self->{yiaddr} = shift }
  0         0  
116 2         8 return $self->{yiaddr};
117             }
118              
119             # siaddr attribute
120             sub siaddr {
121 3     3 1 8 my $self = shift;
122 3 100       10 if (@_) { $self->{siaddr} = packinet(shift) }
  1         4  
123 3         14 return unpackinet( $self->{siaddr} );
124             }
125              
126             # siaddr attribute, Raw version
127             sub siaddrRaw {
128 2     2 1 4 my $self = shift;
129 2 50       12 if (@_) { $self->{siaddr} = shift }
  0         0  
130 2         10 return $self->{siaddr};
131             }
132              
133             # giaddr attribute
134             sub giaddr {
135 3     3 1 7 my $self = shift;
136 3 100       10 if (@_) { $self->{giaddr} = packinet(shift) }
  1         3  
137 3         12 return unpackinet( $self->{giaddr} );
138             }
139              
140             # giaddr attribute, Raw version
141             sub giaddrRaw {
142 2     2 1 7 my $self = shift;
143 2 50       12 if (@_) { $self->{giaddr} = shift }
  0         0  
144 2         10 return $self->{giaddr};
145             }
146              
147             # chaddr attribute
148             sub chaddr {
149 3     3 1 7 my $self = shift;
150 3 100       11 if (@_) { $self->{chaddr} = pack( 'H*', shift ) }
  1         10  
151 3         19 return unpack( 'H*', $self->{chaddr} );
152             }
153              
154             # chaddr attribute, Raw version
155             sub chaddrRaw {
156 1     1 1 2 my $self = shift;
157 1 50       4 if (@_) { $self->{chaddr} = shift }
  0         0  
158 1         5 return $self->{chaddr};
159             }
160              
161             # sname attribute
162             sub sname {
163 11     11   64 use bytes;
  11         24  
  11         36  
164 3     3 1 7 my $self = shift;
165 3 100       12 if (@_) { $self->{sname} = shift }
  1         3  
166 3 100       21 if ( length( $self->{sname} ) > 63 ) {
167             carp( sprintf q|'sname' must not be > 63 bytes, (currently %d)|,
168 1         13 length( $self->{sname} ));
169 1         554 $self->{sname} = substr( $self->{sname}, 0, 63 );
170             }
171 3         12 return $self->{sname};
172             }
173              
174             # file attribute
175             sub file {
176 11     11   1214 use bytes;
  11         17  
  11         45  
177 3     3 1 6 my $self = shift;
178 3 100       12 if (@_) { $self->{file} = shift }
  1         3  
179 3 100       13 if ( length( $self->{file} ) > 127 ) {
180             carp( sprintf q|'file' must not be > 127 bytes, (currently %d)|,
181 1         24 length( $self->{file} ));
182 1         713 $self->{file} = substr( $self->{file}, 0, 127 );
183             }
184 3         13 return $self->{file};
185             }
186              
187             # is it DHCP or BOOTP
188             # -> DHCP needs magic cookie and options
189             sub isDhcp {
190 2     2 1 5 my $self = shift;
191 2 50       11 if (@_) { $self->{isDhcp} = shift }
  0         0  
192 2         15 return $self->{isDhcp};
193             }
194              
195             # padding attribute
196             sub padding {
197 4     4 1 18 my $self = shift;
198 4 100       15 if (@_) { $self->{padding} = shift }
  2         4  
199 4         17 return $self->{padding};
200             }
201              
202             #=======================================================================
203              
204             1;
205              
206             =pod
207              
208             =head1 NAME
209              
210             Net::DHCP::Packet::Attributes - Attribute methods for Net::DHCP::Packet
211              
212             =head1 VERSION
213              
214             version 0.7_005
215              
216             =head1 SYNOPSIS
217              
218             use Net::DHCP::Packet::Attributes qw( :all );
219              
220             =head1 DESCRIPTION
221              
222             Provides attribute methods for Net::DHCP::Packet.
223              
224             This module is not particularly useful on its own.
225              
226             =head1 METHODS
227              
228             =over 4
229              
230             =item comment( [STRING] )
231              
232             Sets or gets the comment attribute (object meta-data only)
233              
234             =item op( [BYTE] )
235              
236             Sets/gets the I.
237              
238             Normal values are:
239              
240             BOOTREQUEST()
241             BOOTREPLY()
242              
243             =item htype( [BYTE] )
244              
245             Sets/gets the I.
246              
247             Common value is: C (1) = ethernet
248              
249             =item hlen ( [BYTE] )
250              
251             Sets/gets the I. Value must be between C<0> and C<16>.
252              
253             For most NIC's, the MAC address has 6 bytes.
254              
255             =item hops ( [BYTE] )
256              
257             Sets/gets the I.
258              
259             This field is incremented by each encountered DHCP relay agent.
260              
261             =item xid ( [INTEGER] )
262              
263             Sets/gets the 32 bits I.
264              
265             This field should be a random value set by the DHCP client.
266              
267             =item secs ( [SHORT] )
268              
269             Sets/gets the 16 bits I in seconds.
270              
271             =item flags ( [SHORT] )
272              
273             Sets/gets the 16 bits I.
274              
275             0x8000 = Broadcast reply requested.
276              
277             =item ciaddr ( [STRING] )
278              
279             Sets/gets the I.
280              
281             IP address is only accepted as a string like '10.24.50.3'.
282              
283             Note: IP address is internally stored as a 4 bytes binary string.
284             See L below.
285              
286             =item yiaddr ( [STRING] )
287              
288             Sets/gets the I.
289              
290             IP address is only accepted as a string like '10.24.50.3'.
291              
292             Note: IP address is internally stored as a 4 bytes binary string.
293             See L below.
294              
295             =item siaddr ( [STRING] )
296              
297             Sets/gets the I.
298              
299             IP address is only accepted as a string like '10.24.50.3'.
300              
301             Note: IP address is internally stored as a 4 bytes binary string.
302             See L below.
303              
304             =item giaddr ( [STRING] )
305              
306             Sets/gets the I.
307              
308             IP address is only accepted as a string like '10.24.50.3'.
309              
310             Note: IP address is internally stored as a 4 bytes binary string.
311             See L below.
312              
313             =item chaddr ( [STRING] )
314              
315             Sets/gets the I. Its length is given by the C attribute.
316              
317             Value is formatted as an Hexadecimal string representation.
318              
319             Example: "0010A706DFFF" for 6 bytes mac address.
320              
321             Note : internal format is packed bytes string.
322             See L below.
323              
324             =item sname ( [STRING] )
325              
326             Sets/gets the "server host name". Maximum size is 63 bytes. If greater
327             a warning is issued.
328              
329             =item file ( [STRING] )
330              
331             Sets/gets the "boot file name". Maximum size is 127 bytes. If greater
332             a warning is issued.
333              
334             =item isDhcp ( [BOOLEAN] )
335              
336             Sets/gets the I. Returns whether the cookie is valid or not,
337             hence whether the packet is DHCP or BOOTP.
338              
339             Default value is C<1>, valid DHCP cookie.
340              
341             =item padding ( [BYTES] )
342              
343             Sets/gets the optional padding at the end of the DHCP packet, i.e. after
344             DHCP options.
345              
346             Convert to hex with:
347             unpack( 'H*', $obj->padding() )
348              
349             =back
350              
351             =head2 SPECIAL METHODS
352              
353             These methods are provided for performance tuning only. They give access
354             to internal data representation , thus avoiding unnecessary type conversion.
355              
356             =over 4
357              
358             =item ciaddrRaw ( [STRING])
359              
360             Sets/gets the I in packed 4 characters binary strings.
361              
362             =item yiaddrRaw ( [STRING] )
363              
364             Sets/gets the I in packed 4 characters binary strings.
365              
366             =item siaddrRaw ( [STRING] )
367              
368             Sets/gets the I in packed 4 characters binary strings.
369              
370             =item giaddrRaw ( [STRING] )
371              
372             Sets/gets the I in packed 4 characters binary strings.
373              
374             =item chaddrRaw ( [STRING] )
375              
376             Sets/gets the I in packed binary string.
377             Its length is given by the C attribute.
378              
379             =back
380              
381             =head1 AUTHOR
382              
383             Dean Hamstead Edean@bytefoundry.com.au
384             Previously Stephan Hadinger Eshadinger@cpan.orgE.
385             Original version by F. van Dun.
386              
387             =head1 BUGS
388              
389             See L
390              
391             =head1 GOT PATCHES?
392              
393             Many young people like to use Github, so by all means send me pull requests at
394              
395             https://github.com/djzort/Net-DHCP
396              
397             =head1 COPYRIGHT
398              
399             This is free software. It can be distributed and/or modified under the same terms as
400             Perl itself.
401              
402             =head1 SEE ALSO
403              
404             L, L, L.
405              
406             =cut