File Coverage

blib/lib/NetAddr/IP.pm
Criterion Covered Total %
statement 180 215 83.7
branch 86 118 72.8
condition 17 27 62.9
subroutine 22 26 84.6
pod 12 13 92.3
total 317 399 79.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             package NetAddr::IP;
4              
5 31     31   309321 use strict;
  31         66  
  31         1255  
6             #use diagnostics;
7 31     31   170 use Carp;
  31         61  
  31         3847  
8 31     31   30609 use NetAddr::IP::Lite 1.54 qw(Zero Zeros Ones V4mask V4net);
  31         983  
  31         224  
9 31         330 use NetAddr::IP::Util 1.50 qw(
10             sub128
11             inet_aton
12             inet_any2n
13             ipv6_aton
14             isIPv4
15             ipv4to6
16             mask4to6
17             shiftleft
18             addconst
19             hasbits
20             notcontiguous
21 31     31   229 );
  31         742  
22              
23 31     31   178 use AutoLoader qw(AUTOLOAD);
  31         50  
  31         228  
24              
25 31         10023 use vars qw(
26             @EXPORT_OK
27             @EXPORT_FAIL
28             @ISA
29             $VERSION
30             $_netlimit
31             $rfc3021
32 31     31   1274 );
  31         139  
33             require Exporter;
34              
35             @EXPORT_OK = qw(Compact Coalesce Zero Zeros Ones V4mask V4net netlimit);
36             @EXPORT_FAIL = qw($_netlimit);
37              
38             @ISA = qw(Exporter NetAddr::IP::Lite);
39              
40             $VERSION = do { sprintf " %d.%03d", (q$Revision: 4.75 $ =~ /\d+/g) };
41              
42             $rfc3021 = 0;
43              
44             =pod
45              
46             =encoding UTF-8
47              
48             =head1 NAME
49              
50             NetAddr::IP - Manages IPv4 and IPv6 addresses and subnets
51              
52             =head1 SYNOPSIS
53              
54             use NetAddr::IP qw(
55             Compact
56             Coalesce
57             Zeros
58             Ones
59             V4mask
60             V4net
61             netlimit
62             :aton DEPRECATED
63             :lower
64             :upper
65             :old_storable
66             :old_nth
67             :rfc3021
68             :nofqdn
69             );
70              
71             NOTE: NetAddr::IP::Util has a full complement of network address
72             utilities to convert back and forth between binary and text.
73              
74             inet_aton, inet_ntoa, ipv6_aton, ipv6_ntoa
75             ipv6_n2x, ipv6_n2d inet_any2d, inet_n2dx,
76             inet_n2ad, inetanyto6, ipv6to4
77              
78             See L
79              
80              
81             my $ip = new NetAddr::IP '127.0.0.1';
82             or if you prefer
83             my $ip = NetAddr::IP->new('127.0.0.1);
84             or from a packed IPv4 address
85             my $ip = new_from_aton NetAddr::IP (inet_aton('127.0.0.1'));
86             or from an octal filtered IPv4 address
87             my $ip = new_no NetAddr::IP '127.012.0.0';
88              
89             print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;
90              
91             if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) {
92             print "Is a loopback address\n";
93             }
94              
95             # This prints 127.0.0.1/32
96             print "You can also say $ip...\n";
97              
98             * The following four functions return ipV6 representations of:
99              
100             :: = Zeros();
101             FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones();
102             FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask();
103             ::FFFF:FFFF = V4net();
104              
105             Will also return an ipV4 or ipV6 representation of a
106             resolvable Fully Qualified Domanin Name (FQDN).
107              
108             ###### DEPRECATED, will be remove in version 5 ############
109              
110             * To accept addresses in the format as returned by
111             inet_aton, invoke the module as:
112              
113             use NetAddr::IP qw(:aton);
114              
115             ###### USE new_from_aton instead ##########################
116              
117             * To enable usage of legacy data files containing NetAddr::IP
118             objects stored using the L module.
119              
120             use NetAddr::IP qw(:old_storable);
121              
122             * To compact many smaller subnets (see: C<$me-Ecompact($addr1,$addr2,...)>
123              
124             @compacted_object_list = Compact(@object_list)
125              
126             * Return a reference to list of C subnets of
127             C<$masklen> mask length, when C<$number> or more addresses from
128             C<@list_of_subnets> are found to be contained in said subnet.
129              
130             $arrayref = Coalesce($masklen, $number, @list_of_subnets)
131              
132             * By default B functions and methods return string IPv6
133             addresses in uppercase. To change that to lowercase:
134              
135             NOTE: the AUGUST 2010 RFC5952 states:
136              
137             4.3. Lowercase
138              
139             The characters "a", "b", "c", "d", "e", and "f" in an IPv6
140             address MUST be represented in lowercase.
141              
142             It is recommended that all NEW applications using NetAddr::IP be
143             invoked as shown on the next line.
144              
145             use NetAddr::IP qw(:lower);
146              
147             * To ensure the current IPv6 string case behavior even if the default changes:
148              
149             use NetAddr::IP qw(:upper);
150              
151             * To set a limit on the size of B processed or returned by NetAddr::IP.
152              
153             Set the maximum number of nets beyond which NetAddr::IP will return
154             an error as a power of 2 (default 16 or 65536 nets). Each 2**16
155             consumes approximately 4 megs of memory. A 2**20 consumes 64 megs of
156             memory, A 2**24 consumes 1 gigabyte of memory.
157              
158             use NetAddr::IP qw(netlimit);
159             netlimit 20;
160              
161             The maximum B allowed is 2**24. Attempts to set limits below
162             the default of 16 or above the maximum of 24 are ignored.
163              
164             Returns true on success, otherwise C.
165              
166             =cut
167              
168             $_netlimit = 2 ** 16; # default
169              
170             sub netlimit($) {
171 0 0   0 0 0 return undef unless $_[0];
172 0 0       0 return undef if $_[0] =~ /\D/;
173 0 0       0 return undef if $_[0] < 16;
174 0 0       0 return undef if $_[0] > 24;
175 0         0 $_netlimit = 2 ** $_[0];
176             };
177              
178             =head1 INSTALLATION
179              
180             Un-tar the distribution in an appropriate directory and type:
181              
182             perl Makefile.PL
183             make
184             make test
185             make install
186              
187             B depends on B which installs by
188             default with its primary functions compiled using Perl's XS extensions
189             to build a C library. If you do not have a C complier available or
190             would like the slower Pure Perl version for some other reason, then
191             type:
192              
193             perl Makefile.PL -noxs
194             make
195             make test
196             make install
197              
198             =head1 DESCRIPTION
199              
200             This module provides an object-oriented abstraction on top of IP
201             addresses or IP subnets that allows for easy manipulations. Version
202             4.xx of NetAddr::IP will work with older versions of Perl and is
203             compatible with Math::BigInt.
204              
205             The internal representation of all IP objects is in 128 bit IPv6 notation.
206             IPv4 and IPv6 objects may be freely mixed.
207              
208             =head2 Overloaded Operators
209              
210             Many operators have been overloaded, as described below:
211              
212             =cut
213              
214             #############################################
215             # These are the overload methods, placed here
216             # for convenience.
217             #############################################
218              
219             use overload
220              
221             '@{}' => sub {
222 3     3   217 return [ $_[0]->hostenum ];
223 31     31   190 };
  31         57  
  31         363  
224              
225             =pod
226              
227             =over
228              
229             =item B)>
230              
231             Has been optimized to copy one NetAddr::IP object to another very quickly.
232              
233             =item Bcopy()>>
234              
235             The B)> operation is only put in to operation when the
236             copied object is further mutated by another overloaded operation. See
237             L B for details.
238              
239             Bcopy()>> actually creates a new object when called.
240              
241             =item B
242              
243             An object can be used just as a string. For instance, the following code
244              
245             my $ip = new NetAddr::IP '192.168.1.123';
246             print "$ip\n";
247              
248             Will print the string 192.168.1.123/32.
249              
250             =item B
251              
252             You can test for equality with either C or C<==>. C allows
253             comparison with arbitrary strings as well as NetAddr::IP objects. The
254             following example:
255              
256             if (NetAddr::IP->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8')
257             { print "Yes\n"; }
258              
259             will print out "Yes".
260              
261             Comparison with C<==> requires both operands to be NetAddr::IP objects.
262              
263             In both cases, a true value is returned if the CIDR representation of
264             the operands is equal.
265              
266             =item B, E, E=, E=, E=E and C>
267              
268             Internally, all network objects are represented in 128 bit format.
269             The numeric representation of the network is compared through the
270             corresponding operation. Comparisons are tried first on the address portion
271             of the object and if that is equal then the NUMERIC cidr portion of the
272             masks are compared. This leads to the counterintuitive result that
273              
274             /24 > /16
275              
276             Comparison should not be done on netaddr objects with different CIDR as
277             this may produce indeterminate - unexpected results,
278             rather the determination of which netblock is larger or smaller should be
279             done by comparing
280              
281             $ip1->masklen <=> $ip2->masklen
282              
283             =item B)>
284              
285             Add a 32 bit signed constant to the address part of a NetAddr object.
286             This operation changes the address part to point so many hosts above the
287             current objects start address. For instance, this code:
288              
289             print NetAddr::IP->new('127.0.0.1/8') + 5;
290              
291             will output 127.0.0.6/8. The address will wrap around at the broadcast
292             back to the network address. This code:
293              
294             print NetAddr::IP->new('10.0.0.1/24') + 255;
295              
296             outputs 10.0.0.0/24.
297              
298             Returns the the unchanged object when the constant is missing or out of
299             range.
300              
301             2147483647 <= constant >= -2147483648
302              
303             =item B)>
304              
305             The complement of the addition of a constant.
306              
307             =item B)>
308              
309             Returns the difference between the address parts of two NetAddr::IP
310             objects address parts as a 32 bit signed number.
311              
312             Returns B if the difference is out of range.
313              
314             (See range restrictions on Addition above)
315              
316             =item B
317              
318             Auto-incrementing a NetAddr::IP object causes the address part to be
319             adjusted to the next host address within the subnet. It will wrap at
320             the broadcast address and start again from the network address.
321              
322             =item B
323              
324             Auto-decrementing a NetAddr::IP object performs exactly the opposite
325             of auto-incrementing it, as you would expect.
326              
327             =cut
328              
329             #############################################
330             # End of the overload methods.
331             #############################################
332              
333              
334             # Preloaded methods go here.
335              
336             =pod
337              
338             =back
339              
340             =head2 Serializing and Deserializing
341              
342             This module defines hooks to collaborate with L for
343             serializing C objects, through compact and human readable
344             strings. You can revert to the old format by invoking this module as
345              
346             use NetAddr::IP ':old_storable';
347              
348             You must do this if you have legacy data files containing NetAddr::IP
349             objects stored using the L module.
350              
351             =cut
352              
353             my $full_format = "%04X:%04X:%04X:%04X:%04X:%04X:%D.%D.%D.%D";
354             my $full6_format = "%04X:%04X:%04X:%04X:%04X:%04X:%04X:%04X";
355              
356             sub import
357             {
358 33 100   33   757 if (grep { $_ eq ':old_storable' } @_) {
  44         241  
359 1         2 @_ = grep { $_ ne ':old_storable' } @_;
  2         5  
360             } else {
361             *{STORABLE_freeze} = sub
362             {
363 1     1   589 my $self = shift;
364 1         13 return $self->cidr(); # use stringification
365 32         250 };
366             *{STORABLE_thaw} = sub
367             {
368 1     1   485 my $self = shift;
369 1         3 my $cloning = shift; # Not used
370 1         2 my $serial = shift;
371              
372 1         6 my $ip = new NetAddr::IP $serial;
373 1         5 $self->{addr} = $ip->{addr};
374 1         3 $self->{mask} = $ip->{mask};
375 1         4 $self->{isv6} = $ip->{isv6};
376 1         10 return;
377 32         137 };
378             }
379              
380 33 50       76 if (grep { $_ eq ':aton' } @_)
  43         187  
381             {
382 0         0 $NetAddr::IP::Lite::Accept_Binary_IP = 1;
383 0         0 @_ = grep { $_ ne ':aton' } @_;
  0         0  
384             }
385 33 100       65 if (grep { $_ eq ':old_nth' } @_)
  43         160  
386             {
387 1         3 $NetAddr::IP::Lite::Old_nth = 1;
388 1         2 @_ = grep { $_ ne ':old_nth' } @_;
  2         35  
389             }
390 33 100       83 if (grep { $_ eq ':lower' } @_)
  42         195  
391             {
392 1         2 $full_format = lc($full_format);
393 1         3 $full6_format = lc($full6_format);
394 1         4 NetAddr::IP::Util::lower();
395 1         2 @_ = grep { $_ ne ':lower' } @_;
  2         6  
396             }
397 33 50       128 if (grep { $_ eq ':upper' } @_)
  41         153  
398             {
399 0         0 $full_format = uc($full_format);
400 0         0 $full6_format = uc($full6_format);
401 0         0 NetAddr::IP::Util::upper();
402 0         0 @_ = grep { $_ ne ':upper' } @_;
  0         0  
403             }
404 33 100       57 if (grep { $_ eq ':rfc3021' } @_)
  41         150  
405             {
406 1         2 $rfc3021 = 1;
407 1         3 @_ = grep { $_ ne ':rfc3021' } @_;
  1         3  
408             }
409 33         35299 NetAddr::IP->export_to_level(1, @_);
410             }
411              
412             sub compact {
413 37         1534 return (ref $_[0] eq 'ARRAY')
414             ? compactref($_[0]) # Compact(\@list)
415 39 100   39 1 3727 : @{compactref(\@_)}; # Compact(@list) or ->compact(@list)
416             }
417              
418             *Compact = \&compact;
419              
420             sub Coalesce {
421 6     6 1 3074 return &coalesce;
422             }
423              
424             sub hostenumref($) {
425 8     8 1 154 my $r = _splitref(0,$_[0]);
426 8 100 66     100 unless ((notcontiguous($_[0]->{mask}))[1] == 128 ||
      66        
427             ($rfc3021 && $_[0]->masklen == 31) ) {
428 5         23 splice(@$r, 0, 1);
429 5         21 splice(@$r, scalar @$r - 1, 1);
430             }
431 8         190 return $r;
432             }
433              
434             sub splitref {
435 16     16 1 91 unshift @_, 0; # mark as no reverse
436             # perl 5.8.4 fails with this operation. see perl bug [ 23429]
437             # goto &_splitref;
438 16         450 &_splitref;
439             }
440              
441             sub rsplitref {
442 0     0 1 0 unshift @_, 1; # mark as reversed
443             # perl 5.8.4 fails with this operation. see perl bug [ 23429]
444             # goto &_splitref;
445 0         0 &_splitref;
446             }
447              
448             sub split {
449 10     10 1 37 unshift @_, 0; # mark as no reverse
450 10         225 my $rv = &_splitref;
451 10 50       2749 return $rv ? @$rv : ();
452             }
453              
454             sub rsplit {
455 0     0 1 0 unshift @_, 1; # mark as reversed
456 0         0 my $rv = &_splitref;
457 0 0       0 return $rv ? @$rv : ();
458             }
459              
460             sub full($) {
461 5 100 66 5 1 138 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
462 2         22 my @hex = (unpack("n8",$_[0]->{addr}));
463 2         5 $hex[9] = $hex[7] & 0xff;
464 2         4 $hex[8] = $hex[7] >> 8;
465 2         3 $hex[7] = $hex[6] & 0xff;
466 2         4 $hex[6] >>= 8;
467 2         17 return sprintf($full_format,@hex);
468             } else {
469 3         7 &full6;
470             }
471             }
472              
473             sub full6($) {
474 13     13 1 323 my @hex = (unpack("n8",$_[0]->{addr}));
475 13         99 return sprintf($full6_format,@hex);
476             }
477              
478 0     0   0 sub DESTROY {};
479              
480             1;
481             __END__