← Index
NYTProf Performance Profile   « line view »
For nd2: #2 manager: init
  Run on Thu May 2 17:38:58 2019
Reported on Thu May 2 17:40:49 2019

Filename/appl/netdisco/perl5/lib/perl5/x86_64-linux-thread-multi/NetAddr/IP/Lite.pm
StatementsExecuted 12637464 statements in 16.0s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
252786116.60s11.2sNetAddr::IP::Lite::::_xnewNetAddr::IP::Lite::_xnew
252582111.64s1.89sNetAddr::IP::Lite::::withinNetAddr::IP::Lite::within
252786111.28s1.59sNetAddr::IP::Lite::::masklenNetAddr::IP::Lite::masklen
252786111.13s8.26sNetAddr::IP::Lite::::cidrNetAddr::IP::Lite::cidr
176950241802ms802msNetAddr::IP::Lite::::CORE:matchNetAddr::IP::Lite::CORE:match (opcode)
25278611680ms5.53sNetAddr::IP::Lite::::addrNetAddr::IP::Lite::addr
25278621666ms8.92sNetAddr::IP::Lite::::__ANON__[:238]NetAddr::IP::Lite::__ANON__[:238]
25258211602ms2.49sNetAddr::IP::Lite::::containsNetAddr::IP::Lite::contains
25278621349ms349msNetAddr::IP::Lite::::newNetAddr::IP::Lite::new
50516411258ms258msNetAddr::IP::Lite::::bitsNetAddr::IP::Lite::bits
0000s0sNetAddr::IP::Lite::::AUTOLOADNetAddr::IP::Lite::AUTOLOAD
0000s0sNetAddr::IP::Lite::::BEGINNetAddr::IP::Lite::BEGIN
0000s0sNetAddr::IP::Lite::::DESTROYNetAddr::IP::Lite::DESTROY
0000s0sNetAddr::IP::Lite::::OnesNetAddr::IP::Lite::Ones
0000s0sNetAddr::IP::Lite::::V4maskNetAddr::IP::Lite::V4mask
0000s0sNetAddr::IP::Lite::::V4netNetAddr::IP::Lite::V4net
0000s0sNetAddr::IP::Lite::::ZerosNetAddr::IP::Lite::Zeros
0000s0sNetAddr::IP::Lite::::__ANON__[:244]NetAddr::IP::Lite::__ANON__[:244]
0000s0sNetAddr::IP::Lite::::__ANON__[:250]NetAddr::IP::Lite::__ANON__[:250]
0000s0sNetAddr::IP::Lite::::__ANON__[:255]NetAddr::IP::Lite::__ANON__[:255]
0000s0sNetAddr::IP::Lite::::__ANON__[:260]NetAddr::IP::Lite::__ANON__[:260]
0000s0sNetAddr::IP::Lite::::__ANON__[:264]NetAddr::IP::Lite::__ANON__[:264]
0000s0sNetAddr::IP::Lite::::__ANON__[:268]NetAddr::IP::Lite::__ANON__[:268]
0000s0sNetAddr::IP::Lite::::__ANON__[:272]NetAddr::IP::Lite::__ANON__[:272]
0000s0sNetAddr::IP::Lite::::__ANON__[:276]NetAddr::IP::Lite::__ANON__[:276]
0000s0sNetAddr::IP::Lite::::_biRefNetAddr::IP::Lite::_biRef
0000s0sNetAddr::IP::Lite::::_bi_fakeNetAddr::IP::Lite::_bi_fake
0000s0sNetAddr::IP::Lite::::_bi_stfyNetAddr::IP::Lite::_bi_stfy
0000s0sNetAddr::IP::Lite::::_fakebi2strgNetAddr::IP::Lite::_fakebi2strg
0000s0sNetAddr::IP::Lite::::_force_bi_emuNetAddr::IP::Lite::_force_bi_emu
0000s0sNetAddr::IP::Lite::::_loadMBINetAddr::IP::Lite::_loadMBI
0000s0sNetAddr::IP::Lite::::_newNetAddr::IP::Lite::_new
0000s0sNetAddr::IP::Lite::::_no_octalNetAddr::IP::Lite::_no_octal
0000s0sNetAddr::IP::Lite::::_obitsNetAddr::IP::Lite::_obits
0000s0sNetAddr::IP::Lite::::_retMBIstringNetAddr::IP::Lite::_retMBIstring
0000s0sNetAddr::IP::Lite::::atonNetAddr::IP::Lite::aton
0000s0sNetAddr::IP::Lite::::bigintNetAddr::IP::Lite::bigint
0000s0sNetAddr::IP::Lite::::broadcastNetAddr::IP::Lite::broadcast
0000s0sNetAddr::IP::Lite::::comp_addr_maskNetAddr::IP::Lite::comp_addr_mask
0000s0sNetAddr::IP::Lite::::copyNetAddr::IP::Lite::copy
0000s0sNetAddr::IP::Lite::::firstNetAddr::IP::Lite::first
0000s0sNetAddr::IP::Lite::::importNetAddr::IP::Lite::import
0000s0sNetAddr::IP::Lite::::is_localNetAddr::IP::Lite::is_local
0000s0sNetAddr::IP::Lite::::is_rfc1918NetAddr::IP::Lite::is_rfc1918
0000s0sNetAddr::IP::Lite::::lastNetAddr::IP::Lite::last
0000s0sNetAddr::IP::Lite::::maskNetAddr::IP::Lite::mask
0000s0sNetAddr::IP::Lite::::minusNetAddr::IP::Lite::minus
0000s0sNetAddr::IP::Lite::::minusminusNetAddr::IP::Lite::minusminus
0000s0sNetAddr::IP::Lite::::networkNetAddr::IP::Lite::network
0000s0sNetAddr::IP::Lite::::new6NetAddr::IP::Lite::new6
0000s0sNetAddr::IP::Lite::::new6FFFFNetAddr::IP::Lite::new6FFFF
0000s0sNetAddr::IP::Lite::::new_cisNetAddr::IP::Lite::new_cis
0000s0sNetAddr::IP::Lite::::new_cis6NetAddr::IP::Lite::new_cis6
0000s0sNetAddr::IP::Lite::::new_from_atonNetAddr::IP::Lite::new_from_aton
0000s0sNetAddr::IP::Lite::::new_noNetAddr::IP::Lite::new_no
0000s0sNetAddr::IP::Lite::::nthNetAddr::IP::Lite::nth
0000s0sNetAddr::IP::Lite::::numNetAddr::IP::Lite::num
0000s0sNetAddr::IP::Lite::::numericNetAddr::IP::Lite::numeric
0000s0sNetAddr::IP::Lite::::plusNetAddr::IP::Lite::plus
0000s0sNetAddr::IP::Lite::::plusplusNetAddr::IP::Lite::plusplus
0000s0sNetAddr::IP::Lite::::rangeNetAddr::IP::Lite::range
0000s0sNetAddr::IP::Lite::::versionNetAddr::IP::Lite::version
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#!/usr/bin/perl
2
3package NetAddr::IP::Lite;
4
5use Carp;
6use strict;
7#use diagnostics;
8#use warnings;
9use NetAddr::IP::InetBase qw(
10 inet_any2n
11 isIPv4
12 inet_n2dx
13 inet_aton
14 ipv6_aton
15 ipv6_n2x
16 fillIPv4
17);
18use NetAddr::IP::Util qw(
19 addconst
20 sub128
21 ipv6to4
22 notcontiguous
23 shiftleft
24 hasbits
25 bin2bcd
26 bcd2bin
27 mask4to6
28 ipv4to6
29 naip_gethostbyname
30 havegethostbyname2
31);
32
33use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $NoFQDN $AUTOLOAD *Zero);
34
35$VERSION = do { my @r = (q$Revision: 1.57 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
36
37require Exporter;
38
39@ISA = qw(Exporter);
40
41@EXPORT_OK = qw(Zeros Zero Ones V4mask V4net);
42
43# Set to true, to enable recognizing of ipV4 && ipV6 binary notation IP
44# addresses. Thanks to Steve Snodgrass for reporting. This can be done
45# at the time of use-ing the module. See docs for details.
46
47$Accept_Binary_IP = 0;
48$Old_nth = 0;
49*Zero = \&Zeros;
50
51=pod
52
53=encoding UTF-8
54
55=head1 NAME
56
57NetAddr::IP::Lite - Manages IPv4 and IPv6 addresses and subnets
58
59=head1 SYNOPSIS
60
61 use NetAddr::IP::Lite qw(
62 Zeros
63 Ones
64 V4mask
65 V4net
66 :aton DEPRECATED !
67 :old_nth
68 :upper
69 :lower
70 :nofqdn
71 );
72
73 my $ip = new NetAddr::IP::Lite '127.0.0.1';
74 or if your prefer
75 my $ip = NetAddr::IP::Lite->new('127.0.0.1);
76 or from a packed IPv4 address
77 my $ip = new_from_aton NetAddr::IP::Lite (inet_aton('127.0.0.1'));
78 or from an octal filtered IPv4 address
79 my $ip = new_no NetAddr::IP::Lite '127.012.0.0';
80
81 print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;
82
83 if ($ip->within(new NetAddr::IP::Lite "127.0.0.0", "255.0.0.0")) {
84 print "Is a loopback address\n";
85 }
86
87 # This prints 127.0.0.1/32
88 print "You can also say $ip...\n";
89
90 The following four functions return ipV6 representations of:
91
92 :: = Zeros();
93 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones();
94 FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask();
95 ::FFFF:FFFF = V4net();
96
97 Will also return an ipV4 or ipV6 representation of a
98 resolvable Fully Qualified Domanin Name (FQDN).
99
100=head1 INSTALLATION
101
102Un-tar the distribution in an appropriate directory and type:
103
104 perl Makefile.PL
105 make
106 make test
107 make install
108
109B<NetAddr::IP::Lite> depends on B<NetAddr::IP::Util> which installs by default with its primary functions compiled
110using Perl's XS extensions to build a 'C' library. If you do not have a 'C'
111complier available or would like the slower Pure Perl version for some other
112reason, then type:
113
114 perl Makefile.PL -noxs
115 make
116 make test
117 make install
118
119=head1 DESCRIPTION
120
121This module provides an object-oriented abstraction on top of IP
122addresses or IP subnets, that allows for easy manipulations. Most of the
123operations of NetAddr::IP are supported. This module will work with older
124versions of Perl and is compatible with Math::BigInt.
125
126* By default B<NetAddr::IP> functions and methods return string IPv6
127addresses in uppercase. To change that to lowercase:
128
129NOTE: the AUGUST 2010 RFC5952 states:
130
131 4.3. Lowercase
132
133 The characters "a", "b", "c", "d", "e", and "f" in an IPv6
134 address MUST be represented in lowercase.
135
136It is recommended that all NEW applications using NetAddr::IP::Lite be
137invoked as shown on the next line.
138
139 use NetAddr::IP::Lite qw(:lower);
140
141* To ensure the current IPv6 string case behavior even if the default changes:
142
143 use NetAddr::IP::Lite qw(:upper);
144
145
146The internal representation of all IP objects is in 128 bit IPv6 notation.
147IPv4 and IPv6 objects may be freely mixed.
148
149The supported operations are described below:
150
151=cut
152
153# in the off chance that NetAddr::IP::Lite objects are created
154# and the caller later loads NetAddr::IP and expects to use
155# those objects, let the AUTOLOAD routine find and redirect
156# NetAddr::IP::Lite method and subroutine calls to NetAddr::IP.
157#
158
159my $parent = 'NetAddr::IP';
160
161# test function
162#
163# input: subroutine name in NetAddr::IP
164# output: t/f if sub name exists in NetAddr::IP namespace
165#
166#sub sub_exists {
167# my $other = $parent .'::';
168# return exists ${$other}{$_[0]};
169#}
170
171sub DESTROY {};
172
173sub AUTOLOAD {
174 no strict;
175 my ($pkg,$func) = ($AUTOLOAD =~ /(.*)::([^:]+)$/);
176 my $other = $parent .'::';
177
178 if ($pkg =~ /^$other/o && exists ${$other}{$func}) {
179 $other .= $func;
180 goto &{$other};
181 }
182
183 my @stack = caller(0);
184
185 if ( $pkg eq ref $_[0] ) {
186 $other = qq|Can't locate object method "$func" via|;
187 }
188 else {
189 $other = qq|Undefined subroutine \&$AUTOLOAD not found in|;
190 }
191 die $other . qq| package "$parent" or "$pkg" (did you forgot to load a module?) at $stack[1] line $stack[2].\n|;
192}
193
194=head2 Overloaded Operators
195
196=cut
197
198# these really should be packed in Network Long order but since they are
199# symmetrical, that extra internal processing can be skipped
200
201my $_v4zero = pack('L',0);
202my $_zero = pack('L4',0,0,0,0);
203my $_ones = ~$_zero;
204my $_v4mask = pack('L4',0xffffffff,0xffffffff,0xffffffff,0);
205my $_v4net = ~ $_v4mask;
206my $_ipv4FFFF = pack('N4',0,0,0xffff,0);
207
208sub Zeros() {
209 return $_zero;
210}
211sub Ones() {
212 return $_ones;
213}
214sub V4mask() {
215 return $_v4mask;
216}
217sub V4net() {
218 return $_v4net;
219}
220
221 #############################################
222 # These are the overload methods, placed here
223 # for convenience.
224 #############################################
225
226use overload
227
228 '+' => \&plus,
229
230 '-' => \&minus,
231
232 '++' => \&plusplus,
233
234 '--' => \&minusminus,
235
236 "=" => \&copy,
237
238252786980ms2527868.26s
# spent 8.92s (666ms+8.26) within NetAddr::IP::Lite::__ANON__[/appl/netdisco/perl5/lib/perl5/x86_64-linux-thread-multi/NetAddr/IP/Lite.pm:238] which was called 252786 times, avg 35µs/call: # 252582 times (665ms+8.25s) by App::Netdisco::Util::Permission::check_acl at line 203 of App/Netdisco/Util/Permission.pm, avg 35µs/call # 204 times (632µs+9.93ms) by App::Netdisco::Util::Permission::check_acl at line 110 of App/Netdisco/Util/Permission.pm, avg 52µs/call
'""' => sub { $_[0]->cidr(); },
# spent 8.26s making 252786 calls to NetAddr::IP::Lite::cidr, avg 33µs/call
239
240 'eq' => sub {
241 my $a = (UNIVERSAL::isa($_[0],__PACKAGE__)) ? $_[0]->cidr : $_[0];
242 my $b = (UNIVERSAL::isa($_[1],__PACKAGE__)) ? $_[1]->cidr : $_[1];
243 $a eq $b;
244 },
245
246 'ne' => sub {
247 my $a = (UNIVERSAL::isa($_[0],__PACKAGE__)) ? $_[0]->cidr : $_[0];
248 my $b = (UNIVERSAL::isa($_[1],__PACKAGE__)) ? $_[1]->cidr : $_[1];
249 $a ne $b;
250 },
251
252 '==' => sub {
253 return 0 unless UNIVERSAL::isa($_[0],__PACKAGE__) && UNIVERSAL::isa($_[1],__PACKAGE__);
254 $_[0]->cidr eq $_[1]->cidr;
255 },
256
257 '!=' => sub {
258 return 1 unless UNIVERSAL::isa($_[0],__PACKAGE__) && UNIVERSAL::isa($_[1],__PACKAGE__);
259 $_[0]->cidr ne $_[1]->cidr;
260 },
261
262 '>' => sub {
263 return &comp_addr_mask > 0 ? 1 : 0;
264 },
265
266 '<' => sub {
267 return &comp_addr_mask < 0 ? 1 : 0;
268 },
269
270 '>=' => sub {
271 return &comp_addr_mask < 0 ? 0 : 1;
272 },
273
274 '<=' => sub {
275 return &comp_addr_mask > 0 ? 0 : 1;
276 },
277
278 '<=>' => \&comp_addr_mask,
279
280 'cmp' => \&comp_addr_mask;
281
282sub comp_addr_mask {
283 my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr});
284 return -1 unless $c;
285 return 1 if hasbits($rv);
286 ($c,$rv) = sub128($_[0]->{mask},$_[1]->{mask});
287 return -1 unless $c;
288 return hasbits($rv) ? 1 : 0;
289}
290
291#sub comp_addr {
292# my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr});
293# return -1 unless $c;
294# return hasbits($rv) ? 1 : 0;
295#}
296
297=pod
298
299=over
300
301=item B<Assignment (C<=>)>
302
303Has been optimized to copy one NetAddr::IP::Lite object to another very quickly.
304
305=item B<C<-E<gt>copy()>>
306
307The B<assignment (C<=>)> operation is only put in to operation when the
308copied object is further mutated by another overloaded operation. See
309L<overload> B<SPECIAL SYMBOLS FOR "use overload"> for details.
310
311B<C<-E<gt>copy()>> actually creates a new object when called.
312
313=cut
314
315sub copy {
316 return _new($_[0],$_[0]->{addr}, $_[0]->{mask});
317}
318
319=item B<Stringification>
320
321An object can be used just as a string. For instance, the following code
322
323 my $ip = new NetAddr::IP::Lite '192.168.1.123';
324 print "$ip\n";
325
326Will print the string 192.168.1.123/32.
327
328 my $ip = new6 NetAddr::IP::Lite '192.168.1.123';
329 print "$ip\n";
330
331Will print the string 0:0:0:0:0:0:C0A8:17B/128
332
333=item B<Equality>
334
335You can test for equality with either C<eq>, C<ne>, C<==> or C<!=>. C<eq>, C<ne> allows the
336comparison with arbitrary strings as well as NetAddr::IP::Lite objects. The
337following example:
338
339 if (NetAddr::IP::Lite->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8')
340 { print "Yes\n"; }
341
342Will print out "Yes".
343
344Comparison with C<==> and C<!=> requires both operands to be NetAddr::IP::Lite objects.
345
346=item B<Comparison via E<gt>, E<lt>, E<gt>=, E<lt>=, E<lt>=E<gt> and C<cmp>>
347
348Internally, all network objects are represented in 128 bit format.
349The numeric representation of the network is compared through the
350corresponding operation. Comparisons are tried first on the address portion
351of the object and if that is equal then the NUMERIC cidr portion of the
352masks are compared. This leads to the counterintuitive result that
353
354 /24 > /16
355
356Comparison should not be done on netaddr objects with different CIDR as
357this may produce indeterminate - unexpected results,
358rather the determination of which netblock is larger or smaller should be
359done by comparing
360
361 $ip1->masklen <=> $ip2->masklen
362
363=item B<Addition of a constant (C<+>)>
364
365Add a 32 bit signed constant to the address part of a NetAddr object.
366This operation changes the address part to point so many hosts above the
367current objects start address. For instance, this code:
368
369 print NetAddr::IP::Lite->new('127.0.0.1/8') + 5;
370
371will output 127.0.0.6/8. The address will wrap around at the broadcast
372back to the network address. This code:
373
374 print NetAddr::IP::Lite->new('10.0.0.1/24') + 255;
375
376outputs 10.0.0.0/24.
377
378Returns the the unchanged object when the constant is missing or out of range.
379
380 2147483647 <= constant >= -2147483648
381
382=cut
383
384sub plus {
385 my $ip = shift;
386 my $const = shift;
387
388 return $ip unless $const &&
389 $const < 2147483648 &&
390 $const > -2147483649;
391
392 my $a = $ip->{addr};
393 my $m = $ip->{mask};
394
395 my $lo = $a & ~$m;
396 my $hi = $a & $m;
397
398 my $new = ((addconst($lo,$const))[1] & ~$m) | $hi;
399
400 return _new($ip,$new,$m);
401}
402
403=item B<Subtraction of a constant (C<->)>
404
405The complement of the addition of a constant.
406
407=item B<Difference (C<->)>
408
409Returns the difference between the address parts of two NetAddr::IP::Lite
410objects address parts as a 32 bit signed number.
411
412Returns B<undef> if the difference is out of range.
413
414=cut
415
416my $_smsk = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0x80000000);
417
418sub minus {
419 my $ip = shift;
420 my $arg = shift;
421 unless (ref $arg) {
422 return plus($ip, -$arg);
423 }
424 my($carry,$dif) = sub128($ip->{addr},$arg->{addr});
425 if ($carry) { # value is positive
426 return undef if hasbits($dif & $_smsk); # all sign bits should be 0's
427 return (unpack('L3N',$dif))[3];
428 } else {
429 return undef if hasbits(($dif & $_smsk) ^ $_smsk); # sign is 1's
430 return (unpack('L3N',$dif))[3] - 4294967296;
431 }
432}
433
434 # Auto-increment an object
435
436=item B<Auto-increment>
437
438Auto-incrementing a NetAddr::IP::Lite object causes the address part to be
439adjusted to the next host address within the subnet. It will wrap at
440the broadcast address and start again from the network address.
441
442=cut
443
444sub plusplus {
445 my $ip = shift;
446
447 my $a = $ip->{addr};
448 my $m = $ip->{mask};
449
450 my $lo = $a & ~ $m;
451 my $hi = $a & $m;
452
453 $ip->{addr} = ((addconst($lo,1))[1] & ~ $m) | $hi;
454 return $ip;
455}
456
457=item B<Auto-decrement>
458
459Auto-decrementing a NetAddr::IP::Lite object performs exactly the opposite
460of auto-incrementing it, as you would expect.
461
462=cut
463
464sub minusminus {
465 my $ip = shift;
466
467 my $a = $ip->{addr};
468 my $m = $ip->{mask};
469
470 my $lo = $a & ~$m;
471 my $hi = $a & $m;
472
473 $ip->{addr} = ((addconst($lo,-1))[1] & ~$m) | $hi;
474 return $ip;
475}
476
477 #############################################
478 # End of the overload methods.
479 #############################################
480
481# Preloaded methods go here.
482
483 # This is a variant to ->new() that
484 # creates and blesses a new object
485 # without the fancy parsing of
486 # IP formats and shorthands.
487
488# return a blessed IP object without parsing
489# input: prototype, naddr, nmask
490# returns: blessed IP object
491#
492sub _new ($$$) {
493 my $proto = shift;
494 my $class = ref($proto) || die "reference required";
495 $proto = $proto->{isv6};
496 my $self = {
497 addr => $_[0],
498 mask => $_[1],
499 isv6 => $proto,
500 };
501 return bless $self, $class;
502}
503
504=pod
505
506=back
507
508=head2 Methods
509
510=over
511
512=item C<-E<gt>new([$addr, [ $mask|IPv6 ]])>
513
514=item C<-E<gt>new6([$addr, [ $mask]])>
515
516=item C<-E<gt>new6FFFF([$addr, [ $mask]])>
517
518=item C<-E<gt>new_no([$addr, [ $mask]])>
519
520=item C<-E<gt>new_from_aton($netaddr)>
521
522=item new_cis and new_cis6 are DEPRECATED
523
524=item C<-E<gt>new_cis("$addr $mask)>
525
526=item C<-E<gt>new_cis6("$addr $mask)>
527
528The first three methods create a new address with the supplied address in
529C<$addr> and an optional netmask C<$mask>, which can be omitted to get
530a /32 or /128 netmask for IPv4 / IPv6 addresses respectively.
531
532new6FFFF specifically returns an IPv4 address in IPv6 format according to RFC4291
533
534 new6 ::xxxx:xxxx
535 new6FFFF ::FFFF:xxxx:xxxx
536
537The third method C<new_no> is exclusively for IPv4 addresses and filters
538improperly formatted
539dot quad strings for leading 0's that would normally be interpreted as octal
540format by NetAddr per the specifications for inet_aton.
541
542B<new_from_aton> takes a packed IPv4 address and assumes a /32 mask. This
543function replaces the DEPRECATED :aton functionality which is fundamentally
544broken.
545
546The last two methods B<new_cis> and B<new_cis6> differ from B<new> and
547B<new6> only in that they except the common Cisco address notation for
548address/mask pairs with a B<space> as a separator instead of a slash (/)
549
550These methods are DEPRECATED because the functionality is now included
551in the other "new" methods
552
553 i.e. ->new_cis('1.2.3.0 24')
554 or
555 ->new_cis6('::1.2.3.0 120')
556
557C<-E<gt>new6> and
558C<-E<gt>new_cis6> mark the address as being in ipV6 address space even
559if the format would suggest otherwise.
560
561 i.e. ->new6('1.2.3.4') will result in ::102:304
562
563 addresses submitted to ->new in ipV6 notation will
564 remain in that notation permanently. i.e.
565 ->new('::1.2.3.4') will result in ::102:304
566 whereas new('1.2.3.4') would print out as 1.2.3.4
567
568 See "STRINGIFICATION" below.
569
570C<$addr> can be almost anything that can be resolved to an IP address
571in all the notations I have seen over time. It can optionally contain
572the mask in CIDR notation. If the OPTIONAL perl module Socket6 is
573available in the local library it will autoload and ipV6 host6
574names will be resolved as well as ipV4 hostnames.
575
576B<prefix> notation is understood, with the limitation that the range
577specified by the prefix must match with a valid subnet.
578
579Addresses in the same format returned by C<inet_aton> or
580C<gethostbyname> can also be understood, although no mask can be
581specified for them. The default is to not attempt to recognize this
582format, as it seems to be seldom used.
583
584###### DEPRECATED, will be remove in version 5 ############
585To accept addresses in that format, invoke the module as in
586
587 use NetAddr::IP::Lite ':aton'
588
589###### USE new_from_aton instead ##########################
590
591If called with no arguments, 'default' is assumed.
592
593If called with an empty string as the argument, returns 'undef'
594
595C<$addr> can be any of the following and possibly more...
596
597 n.n
598 n.n/mm
599 n.n mm
600 n.n.n
601 n.n.n/mm
602 n.n.n mm
603 n.n.n.n
604 n.n.n.n/mm 32 bit cidr notation
605 n.n.n.n mm
606 n.n.n.n/m.m.m.m
607 n.n.n.n m.m.m.m
608 loopback, localhost, broadcast, any, default
609 x.x.x.x/host
610 0xABCDEF, 0b111111000101011110, (or a bcd number)
611 a netaddr as returned by 'inet_aton'
612
613
614Any RFC1884 notation
615
616 ::n.n.n.n
617 ::n.n.n.n/mmm 128 bit cidr notation
618 ::n.n.n.n/::m.m.m.m
619 ::x:x
620 ::x:x/mmm
621 x:x:x:x:x:x:x:x
622 x:x:x:x:x:x:x:x/mmm
623 x:x:x:x:x:x:x:x/m:m:m:m:m:m:m:m any RFC1884 notation
624 loopback, localhost, unspecified, any, default
625 ::x:x/host
626 0xABCDEF, 0b111111000101011110 within the limits
627 of perl's number resolution
628 123456789012 a 'big' bcd number (bigger than perl likes)
629 and Math::BigInt
630
631A Fully Qualified Domain Name which returns an ipV4 address or an ipV6
632address, embodied in that order. This previously undocumented feature
633may be disabled with:
634
635 use NetAddr::IP::Lite ':nofqdn';
636
637If called with no arguments, 'default' is assumed.
638
639If called with and empty string as the argument, 'undef' is returned;
640
641=cut
642
643my $lbmask = inet_aton('255.0.0.0');
644my $_p4broad = inet_any2n('255.255.255.255');
645my $_p4loop = inet_any2n('127.0.0.1');
646my $_p4mloop = inet_aton('255.0.0.0');
647 $_p4mloop = mask4to6($_p4mloop);
648my $_p6loop = inet_any2n('::1');
649
650my %fip4 = (
651 default => Zeros,
652 any => Zeros,
653 broadcast => $_p4broad,
654 loopback => $_p4loop,
655 unspecified => undef,
656);
657my %fip4m = (
658 default => Zeros,
659 any => Zeros,
660 broadcast => Ones,
661 loopback => $_p4mloop,
662 unspecified => undef, # not applicable for ipV4
663 host => Ones,
664);
665
666my %fip6 = (
667 default => Zeros,
668 any => Zeros,
669 broadcast => undef, # not applicable for ipV6
670 loopback => $_p6loop,
671 unspecified => Zeros,
672);
673
674my %fip6m = (
675 default => Zeros,
676 any => Zeros,
677 broadcast => undef, # not applicable for ipV6
678 loopback => Ones,
679 unspecified => Ones,
680 host => Ones,
681);
682
683my $ff000000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFF000000);
684my $ffff0000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFF0000);
685my $ffffff00 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFFFF00);
686
687sub _obits ($$) {
688 my($lo,$hi) = @_;
689
690 return 0xFF if $lo == $hi;
691 return (~ ($hi ^ $lo)) & 0xFF;
692}
693
694sub new_no($;$$) {
695 unshift @_, -1;
696 goto &_xnew;
697}
698
699
# spent 349ms within NetAddr::IP::Lite::new which was called 252786 times, avg 1µs/call: # 252582 times (349ms+0s) by App::Netdisco::Util::Permission::check_acl at line 203 of App/Netdisco/Util/Permission.pm, avg 1µs/call # 204 times (627µs+0s) by App::Netdisco::Util::Permission::check_acl at line 110 of App/Netdisco/Util/Permission.pm, avg 3µs/call
sub new($;$$) {
700252786134ms unshift @_, 0;
701252786600ms25278611.2s goto &_xnew;
# spent 11.2s making 252786 calls to NetAddr::IP::Lite::_xnew, avg 44µs/call
702}
703
704sub new_from_aton($$) {
705 my $proto = shift;
706 my $class = ref $proto || $proto || __PACKAGE__;
707 my $ip = shift;
708 return undef unless defined $ip;
709 my $addrlen = length($ip);
710 return undef unless $addrlen == 4;
711 my $self = {
712 addr => ipv4to6($ip),
713 mask => &Ones,
714 isv6 => 0,
715 };
716 return bless $self, $class;
717}
718
719sub new6($;$$) {
720 unshift @_, 1;
721 goto &_xnew;
722}
723
724sub new6FFFF($;$$) {
725 my $ip = _xnew(1,@_);
726 $ip->{addr} |= $_ipv4FFFF;
727 return $ip;
728}
729
730sub new_cis($;$$) {
731 my @in = @_;
732 if ( $in[1] && $in[1] =~ m!^(.+)\s+(.+)$! ) {
733 $in[1] = $1 .'/'. $2;
734 }
735 @_ = (0,@in);
736 goto &_xnew;
737}
738
739sub new_cis6($;$$) {
740 my @in = @_;
741 if ( $in[1] && $in[1] =~ m!^(.+)\s+(.+)$! ) {
742 $in[1] = $1 .'/'. $2;
743 }
744 @_ = (1,@in);
745 goto &_xnew;
746}
747
748sub _no_octal {
749# $_[0] =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
750# return sprintf("%d.%d.%d.%d",$1,$2,$3,$4);
751 (my $rv = $_[0]) =~ s#\b0*([1-9]\d*/?|0/?)#$1#g; # suppress leading zeros
752 $rv;
753}
754
755
# spent 11.2s (6.60+4.63) within NetAddr::IP::Lite::_xnew which was called 252786 times, avg 44µs/call: # 252786 times (6.60s+4.63s) by App::Netdisco::Util::Permission::check_acl at line 701, avg 44µs/call
sub _xnew($$;$$) {
75625278636.2ms my $noctal = 0;
75725278653.2ms my $isV6 = shift;
75825278644.2ms if ($isV6 < 0) { # flag for no octal?
759 $isV6 = 0;
760 $noctal = 1;
761 }
76225278643.5ms my $proto = shift;
76325278655.9ms my $class = ref $proto || $proto || __PACKAGE__;
76425278641.7ms my $ip = shift;
765
76625278639.5ms if ($ip && $noctal && $ip !~ m|(?:[^\s0123456789/. -])|) { # octal suppression required if not an IPv4 address
767 $ip = _no_octal($ip);
768 }
769
770# fix for bug #75976
77125278660.0ms return undef if defined $ip && $ip eq '';
772
77325278624.2ms $ip = 'default' unless defined $ip;
77425278628.6ms $ip = _retMBIstring($ip) # treat as big bcd string
775 if ref $ip && ref $ip eq 'Math::BigInt'; # can /CIDR notation
77625278629.5ms my $hasmask = 1;
77725278628.4ms my($mask,$tmp);
778
779# IP to lower case AFTER ref test for Math::BigInt. 'lc' strips blessing
780
78125278669.9ms $ip = lc $ip;
782
78325278635.1ms while (1) {
784# process IP's with no CIDR or that have the CIDR as part of the IP argument string
78525278678.9ms unless (@_) {
786# if ($ip =~ m!^(.+)/(.+)$!) {
7872527861.99s758358488ms if ($ip !~ /\D/) { # binary number notation
# spent 488ms making 758358 calls to NetAddr::IP::Lite::CORE:match, avg 644ns/call
788 $ip = bcd2bin($ip);
789 $mask = Ones;
790 last;
791 }
792 elsif ($ip =~ m!^([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)$! ||
793 $ip =~ m!^[\[]{1}([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)[\]]{1}$!) {
794 $ip = $1;
795 $mask = $2;
796 } elsif (grep($ip eq $_,(qw(default any broadcast loopback unspecified)))) {
797 $isV6 = 1 if $ip eq 'unspecified';
798 if ($isV6) {
799 $mask = $fip6m{$ip};
800 return undef unless defined ($ip = $fip6{$ip});
801 } else {
802 $mask = $fip4m{$ip};
803 return undef unless defined ($ip = $fip4{$ip});
804 }
805 last;
806 }
807 }
808# process "ipv6" token and default IP's
809 elsif (defined $_[0]) {
810 if ($_[0] =~ /ipv6/i || $isV6) {
811 if (grep($ip eq $_,(qw(default any loopback unspecified)))) {
812 $mask = $fip6m{$ip};
813 $ip = $fip6{$ip};
814 last;
815 } else {
816 return undef unless $isV6;
817# add for ipv6 notation "12345, 1"
818 }
819# $mask = lc $_[0];
820# } else {
821# $mask = lc $_[0];
822 }
823# extract mask
824 $mask = $_[0];
825 }
826###
827### process mask
82825278666.2ms unless (defined $mask) {
82925278638.8ms $hasmask = 0;
83025278650.2ms $mask = 'host';
831 }
832
833# two kinds of IP's can turn on the isV6 flag
834# 1) big digits that are over the IPv4 boundry
835# 2) IPv6 IP syntax
836#
837# check these conditions and set isV6 as appropriate
838#
83925278622.1ms my $try;
840252786552ms25278659.6ms $isV6 = 1 if # check big bcd and IPv6 rfc1884
# spent 59.6ms making 252786 calls to NetAddr::IP::Lite::CORE:match, avg 236ns/call
841 ( $ip !~ /\D/ && # ip is all decimal
842 (length($ip) > 3 || $ip > 255) && # exclude a single digit in the range of zero to 255, could be funny IPv4
843 ($try = bcd2bin($ip)) && ! isIPv4($try)) || # precedence so $try is not corrupted
844 (index($ip,':') >= 0 && ($try = ipv6_aton($ip))); # fails if not an rfc1884 address
845
846# if either of the above conditions is true, $try contains the NetAddr 128 bit address
847
848# checkfor Math::BigInt mask
84925278633.3ms $mask = _retMBIstring($mask) # treat as big bcd string
850 if ref $mask && ref $mask eq 'Math::BigInt';
851
852# MASK to lower case AFTER ref test for Math::BigInt, 'lc' strips blessing
853
85425278654.6ms $mask = lc $mask;
855
8562527861.14s50557279.2ms if ($mask !~ /\D/) { # bcd or CIDR notation
# spent 79.2ms making 505572 calls to NetAddr::IP::Lite::CORE:match, avg 157ns/call
857 my $isCIDR = length($mask) < 4 && $mask < 129;
858 if ($isV6) {
859 if ($isCIDR) {
860 my($dq1,$dq2,$dq3,$dq4);
861 if ($ip =~ /^(\d+)(?:|\.(\d+)(?:|\.(\d+)(?:|\.(\d+))))$/ &&
862 do {$dq1 = $1;
863 $dq2 = $2 || 0;
864 $dq3 = $3 || 0;
865 $dq4 = $4 || 0;
866 1;
867 } &&
868 $dq1 >= 0 && $dq1 < 256 &&
869 $dq2 >= 0 && $dq2 < 256 &&
870 $dq3 >= 0 && $dq3 < 256 &&
871 $dq4 >= 0 && $dq4 < 256
872 ) { # corner condition of IPv4 with isV6
873 $ip = join('.',$dq1,$dq2,$dq3,$dq4);
874 $try = ipv4to6(inet_aton($ip));
875 if ($mask < 32) {
876 $mask = shiftleft(Ones,32 -$mask);
877 }
878 elsif ($mask == 32) {
879 $mask = Ones;
880 } else {
881 return undef; # undoubtably an error
882 }
883 }
884 elsif ($mask < 128) {
885 $mask = shiftleft(Ones,128 -$mask); # small cidr
886 } else {
887 $mask = Ones();
888 }
889 } else {
890 $mask = bcd2bin($mask);
891 }
892 }
893 elsif ($isCIDR && $mask < 33) { # is V4
894# if ($ip && $noctal && $ip !~ m|(?:[^\s0123456789.])|) { # octal suppression required if not an IPv4 address
895# $mask = _no_octal($mask);
896# }
897 if ($mask < 32) {
898 $mask = shiftleft(Ones,32 -$mask);
899 }
900 elsif ( $mask == 32) {
901 $mask = Ones;
902 } else {
903 $mask = bcd2bin($mask);
904 $mask |= $_v4mask; # v4 always
905 }
906 } else { # also V4
907 $mask = bcd2bin($mask);
908 $mask |= $_v4mask;
909 }
910 if ($try) { # is a big number
911 $ip = $try;
912 last;
913 }
914 } elsif ($mask =~ m/^\d+\.\d+\.\d+\.\d+$/) { # ipv4 form of mask
915 $mask = _no_octal($mask) if $noctal; # filter for octal
916 return undef unless defined ($mask = inet_aton($mask));
917 $mask = mask4to6($mask);
918 } elsif (grep($mask eq $_,qw(default any broadcast loopback unspecified host))) {
919 if (index($ip,':') < 0 && ! $isV6) {
920 return undef unless defined ($mask = $fip4m{$mask});
921 } else {
922 return undef unless defined ($mask = $fip6m{$mask});
923 }
924 } else {
925 return undef unless defined ($mask = ipv6_aton($mask)); # try ipv6 form of mask
926 }
927
928# process remaining IP's
929
93025278658.8ms if (index($ip,':') < 0) { # ipv4 address
931252786618ms252786175ms if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
# spent 175ms making 252786 calls to NetAddr::IP::Lite::CORE:match, avg 691ns/call
932 ; # the common case
933 }
934 elsif (grep($ip eq $_,(qw(default any broadcast loopback)))) {
935 return undef unless defined ($ip = $fip4{$ip});
936 last;
937 }
938 elsif ($ip =~ m/^(\d+)\.(\d+)$/) {
939 $ip = ($hasmask)
940 ? "${1}.${2}.0.0"
941 : "${1}.0.0.${2}";
942 }
943 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
944 $ip = ($hasmask)
945 ? "${1}.${2}.${3}.0"
946 : "${1}.${2}.0.${3}";
947 }
948 elsif ($ip =~ /^(\d+)$/ && $hasmask && $1 >= 0 and $1 < 256) { # pure numeric
949 $ip = sprintf("%d.0.0.0",$1);
950 }
951# elsif ($ip =~ /^\d+$/ && !$hasmask) { # a big integer
952 elsif ($ip =~ /^\d+$/ ) { # a big integer
953 $ip = bcd2bin($ip);
954 last;
955 }
956# these next three might be broken??? but they have been in the code a long time and no one has complained
957 elsif ($ip =~ /^0[xb]\d+$/ && $hasmask &&
958 (($tmp = eval "$ip") || 1) &&
959 $tmp >= 0 && $tmp < 256) {
960 $ip = sprintf("%d.0.0.0",$tmp);
961 }
962 elsif ($ip =~ /^-?\d+$/) {
963 $ip += 2 ** 32 if $ip < 0;
964 $ip = pack('L3N',0,0,0,$ip);
965 last;
966 }
967 elsif ($ip =~ /^-?0[xb]\d+$/) {
968 $ip = eval "$ip";
969 $ip = pack('L3N',0,0,0,$ip);
970 last;
971 }
972
973# notations below include an implicit mask specification
974
975 elsif ($ip =~ m/^(\d+)\.$/) {
976 $ip = "${1}.0.0.0";
977 $mask = $ff000000;
978 }
979 elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ && $2 <= $3 && $3 < 256) {
980 $ip = "${1}.${2}.0.0";
981 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,_obits($2,$3),0,0);
982 }
983 elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ and $1 <= $2 && $2 < 256) {
984 $ip = "${1}.0.0.0";
985 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,_obits($1,$2),0,0,0)
986 }
987 elsif ($ip =~ m/^(\d+)\.(\d+)\.$/) {
988 $ip = "${1}.${2}.0.0";
989 $mask = $ffff0000;
990 }
991 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ && $3 <= $4 && $4 < 256) {
992 $ip = "${1}.${2}.${3}.0";
993 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,_obits($3,$4),0);
994 }
995 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/) {
996 $ip = "${1}.${2}.${3}.0";
997 $mask = $ffffff00;
998 }
999 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ && $4 <= $5 && $5 < 256) {
1000 $ip = "${1}.${2}.${3}.${4}";
1001 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,255,_obits($4,$5));
1002 }
1003 elsif ($ip =~ m/^(\d+\.\d+\.\d+\.\d+)
1004 \s*-\s*(\d+\.\d+\.\d+\.\d+)$/x) {
1005# if ($noctal) {
1006# return undef unless ($ip = inet_aton(_no_octal($1)));
1007# return undef unless ($tmp = inet_aton(_no_octal($2)));
1008# } else {
1009 return undef unless ($ip = inet_aton($1));
1010 return undef unless ($tmp = inet_aton($2));
1011# }
1012# check for left side greater than right side
1013# save numeric difference in $mask
1014 return undef if ($tmp = unpack('N',$tmp) - unpack('N',$ip)) < 0;
1015 $ip = ipv4to6($ip);
1016 $tmp = pack('L3N',0,0,0,$tmp);
1017 $mask = ~$tmp;
1018 return undef if notcontiguous($mask);
1019# check for non-aligned left side
1020 return undef if hasbits($ip & $tmp);
1021 last;
1022 }
1023# check for resolvable IPv4 hosts
1024 elsif (! $NoFQDN && $ip !~ /[^a-zA-Z0-9\._-]/ && ($tmp = gethostbyname(fillIPv4($ip))) && $tmp ne $_v4zero && $tmp ne $_zero ) {
1025 $ip = ipv4to6($tmp);
1026 last;
1027 }
1028# check for resolvable IPv6 hosts
1029 elsif (! $NoFQDN && $ip !~ /[^a-zA-Z0-9\._-]/ && havegethostbyname2() && ($tmp = naip_gethostbyname($ip))) {
1030 $ip = $tmp;
1031 $isV6 = 1;
1032 last;
1033 }
1034 elsif ($Accept_Binary_IP && ! $hasmask) {
1035 if (length($ip) == 4) {
1036 $ip = ipv4to6($ip);
1037 } elsif (length($ip) == 16) {
1038 $isV6 = 1;
1039 } else {
1040 return undef;
1041 }
1042 last;
1043 } else {
1044 return undef;
1045 }
1046252786216ms2527863.52s return undef unless defined ($ip = inet_aton($ip));
# spent 3.52s making 252786 calls to NetAddr::IP::InetBase::inet_aton, avg 14µs/call
1047252786648ms252786184ms $ip = ipv4to6($ip);
# spent 184ms making 252786 calls to NetAddr::IP::Util::ipv4to6, avg 727ns/call
104825278682.4ms last;
1049 }
1050########## continuing
1051 else { # ipv6 address
1052 $isV6 = 1;
1053 $ip = $1 if $ip =~ /\[([^\]]+)\]/; # transform URI notation
1054 if (defined ($tmp = ipv6_aton($ip))) {
1055 $ip = $tmp;
1056 last;
1057 }
1058 last if grep($ip eq $_,(qw(default any loopback unspecified))) &&
1059 defined ($ip = $fip6{$ip});
1060 return undef;
1061 }
1062 } # end while (1)
1063252786563ms252786123ms return undef if notcontiguous($mask); # invalid if not contiguous
# spent 123ms making 252786 calls to NetAddr::IP::Util::notcontiguous, avg 486ns/call
1064
1065252786278ms my $self = {
1066 addr => $ip,
1067 mask => $mask,
1068 isv6 => $isV6,
1069 };
1070252786663ms return bless $self, $class;
1071}
1072
1073=item C<-E<gt>broadcast()>
1074
1075Returns a new object referring to the broadcast address of a given
1076subnet. The broadcast address has all ones in all the bit positions
1077where the netmask has zero bits. This is normally used to address all
1078the hosts in a given subnet.
1079
1080=cut
1081
1082sub broadcast ($) {
1083 my $ip = _new($_[0],$_[0]->{addr} | ~$_[0]->{mask},$_[0]->{mask});
1084 $ip->{addr} &= V4net unless $ip->{isv6};
1085 return $ip;
1086}
1087
1088=item C<-E<gt>network()>
1089
1090Returns a new object referring to the network address of a given
1091subnet. A network address has all zero bits where the bits of the
1092netmask are zero. Normally this is used to refer to a subnet.
1093
1094=cut
1095
1096sub network ($) {
1097 return _new($_[0],$_[0]->{addr} & $_[0]->{mask},$_[0]->{mask});
1098}
1099
1100=item C<-E<gt>addr()>
1101
1102Returns a scalar with the address part of the object as an IPv4 or IPv6 text
1103string as appropriate. This is useful for printing or for passing the address
1104part of the NetAddr::IP::Lite object to other components that expect an IP
1105address. If the object is an ipV6 address or was created using ->new6($ip)
1106it will be reported in ipV6 hex format otherwise it will be reported in dot
1107quad format only if it resides in ipV4 address space.
1108
1109=cut
1110
1111
# spent 5.53s (680ms+4.85) within NetAddr::IP::Lite::addr which was called 252786 times, avg 22µs/call: # 252786 times (680ms+4.85s) by NetAddr::IP::Lite::cidr at line 1178, avg 22µs/call
sub addr ($) {
1112252786644ms2527864.85s return ($_[0]->{isv6})
# spent 4.85s making 252785 calls to NetAddr::IP::InetBase::inet_n2dx, avg 19µs/call # spent 352µs making 1 call to AutoLoader::AUTOLOAD
1113 ? ipv6_n2x($_[0]->{addr})
1114 : inet_n2dx($_[0]->{addr});
1115}
1116
1117=item C<-E<gt>mask()>
1118
1119Returns a scalar with the mask as an IPv4 or IPv6 text string as
1120described above.
1121
1122=cut
1123
1124sub mask ($) {
1125 return ipv6_n2x($_[0]->{mask}) if $_[0]->{isv6};
1126 my $mask = isIPv4($_[0]->{addr})
1127 ? $_[0]->{mask} & V4net
1128 : $_[0]->{mask};
1129 return inet_n2dx($mask);
1130}
1131
1132=item C<-E<gt>masklen()>
1133
1134Returns a scalar the number of one bits in the mask.
1135
1136=cut
1137
1138
# spent 1.59s (1.28+308ms) within NetAddr::IP::Lite::masklen which was called 252786 times, avg 6µs/call: # 252786 times (1.28s+308ms) by NetAddr::IP::Lite::cidr at line 1178, avg 6µs/call
sub masklen ($) {
1139252786679ms252786127ms my $len = (notcontiguous($_[0]->{mask}))[1];
# spent 127ms making 252786 calls to NetAddr::IP::Util::notcontiguous, avg 502ns/call
114025278625.1ms return 0 unless $len;
114125278665.9ms return $len if $_[0]->{isv6};
1142252786583ms252786181ms return isIPv4($_[0]->{addr})
# spent 181ms making 252786 calls to NetAddr::IP::InetBase::isIPv4, avg 716ns/call
1143 ? $len -96
1144 : $len;
1145}
1146
1147=item C<-E<gt>bits()>
1148
1149Returns the width of the address in bits. Normally 32 for v4 and 128 for v6.
1150
1151=cut
1152
1153
# spent 258ms within NetAddr::IP::Lite::bits which was called 505164 times, avg 511ns/call: # 505164 times (258ms+0s) by App::Netdisco::Util::Permission::check_acl at line 205 of App/Netdisco/Util/Permission.pm, avg 511ns/call
sub bits {
1154505164882ms return $_[0]->{isv6} ? 128 : 32;
1155}
1156
1157=item C<-E<gt>version()>
1158
1159Returns the version of the address or subnet. Currently this can be
1160either 4 or 6.
1161
1162=cut
1163
1164sub version {
1165 my $self = shift;
1166 return $self->{isv6} ? 6 : 4;
1167}
1168
1169=item C<-E<gt>cidr()>
1170
1171Returns a scalar with the address and mask in CIDR notation. A
1172NetAddr::IP::Lite object I<stringifies> to the result of this function.
1173(see comments about ->new6() and ->addr() for output formats)
1174
1175=cut
1176
1177
# spent 8.26s (1.13+7.12) within NetAddr::IP::Lite::cidr which was called 252786 times, avg 33µs/call: # 252786 times (1.13s+7.12s) by NetAddr::IP::Lite::__ANON__[/appl/netdisco/perl5/lib/perl5/x86_64-linux-thread-multi/NetAddr/IP/Lite.pm:238] at line 238, avg 33µs/call
sub cidr ($) {
1178252786897ms5055727.12s return $_[0]->addr . '/' . $_[0]->masklen;
# spent 5.53s making 252786 calls to NetAddr::IP::Lite::addr, avg 22µs/call # spent 1.59s making 252786 calls to NetAddr::IP::Lite::masklen, avg 6µs/call
1179}
1180
1181=item C<-E<gt>aton()>
1182
1183Returns the address part of the NetAddr::IP::Lite object in the same format
1184as the C<inet_aton()> or C<ipv6_aton> function respectively. If the object
1185was created using ->new6($ip), the address returned will always be in ipV6
1186format, even for addresses in ipV4 address space.
1187
1188=cut
1189
1190sub aton {
1191 return $_[0]->{addr} if $_[0]->{isv6};
1192 return isIPv4($_[0]->{addr})
1193 ? ipv6to4($_[0]->{addr})
1194 : $_[0]->{addr};
1195}
1196
1197=item C<-E<gt>range()>
1198
1199Returns a scalar with the base address and the broadcast address
1200separated by a dash and spaces. This is called range notation.
1201
1202=cut
1203
1204sub range ($) {
1205 return $_[0]->network->addr . ' - ' . $_[0]->broadcast->addr;
1206}
1207
1208=item C<-E<gt>numeric()>
1209
1210When called in a scalar context, will return a numeric representation
1211of the address part of the IP address. When called in an array
1212context, it returns a list of two elements. The first element is as
1213described, the second element is the numeric representation of the
1214netmask.
1215
1216This method is essential for serializing the representation of a
1217subnet.
1218
1219=cut
1220
1221sub numeric ($) {
1222 if (wantarray) {
1223 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1224 return ( sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))),
1225 sprintf("%u",unpack('N',ipv6to4($_[0]->{mask}))));
1226 }
1227 else {
1228 return ( bin2bcd($_[0]->{addr}),
1229 bin2bcd($_[0]->{mask}));
1230 }
1231 }
1232 return (! $_[0]->{isv6} && isIPv4($_[0]->{addr}))
1233 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1234 : bin2bcd($_[0]->{addr});
1235}
1236
1237=item C<-E<gt>bigint()>
1238
1239When called in a scalar context, will return a Math::BigInt representation
1240of the address part of the IP address. When called in an array
1241contest, it returns a list of two elements. The first element is as
1242described, the second element is the Math::BigInt representation of the
1243netmask.
1244
1245=cut
1246
1247my $biloaded;
1248my $bi2strng;
1249my $no_mbi_emu = 1;
1250
1251# function to force into test development mode
1252#
1253sub _force_bi_emu {
1254 undef $biloaded;
1255 undef $bi2strng;
1256 $no_mbi_emu = 0;
1257 print STDERR "\n\n\tWARNING: test development mode, this
1258\tmessage SHOULD NEVER BE SEEN IN PRODUCTION!
1259set my \$no_mbi_emu = 1 in t/bigint.t to remove this warning\n\n";
1260}
1261
1262# function to stringify various flavors of Math::BigInt objects
1263# tests to see if the object is a hash or a signed scalar
1264
1265sub _bi_stfy {
1266 "$_[0]" =~ /(\d+)/; # stringify and remove '+' if present
1267 $1;
1268}
1269
1270sub _fakebi2strg {
1271 ${$_[0]} =~ /(\d+)/;
1272 $1;
1273}
1274
1275# fake new from bi string Math::BigInt 0.01
1276#
1277sub _bi_fake {
1278 bless \('+'. $_[1]), 'Math::BigInt';
1279}
1280
1281# as of this writing there are three known flavors of Math::BigInt
1282# v0.01 MBI::new returns a scalar ref
1283# v1.?? - 1.69 CALC::_new takes a reference to a scalar, returns an array, MBI returns a hash ref
1284# v1.70 and up CALC::_new takes a scalar, returns and array, MBI returns a hash ref
1285
1286sub _loadMBI { # load Math::BigInt on demand
1287 if (eval {$no_mbi_emu && require Math::BigInt}) { # any version should work, three known
1288 import Math::BigInt;
1289 $biloaded = \&Math::BigInt::new;
1290 $bi2strng = \&_bi_stfy;
1291 } else {
1292 $biloaded = \&_bi_fake;
1293 $bi2strng = \&_fakebi2strg;
1294 }
1295}
1296
1297sub _retMBIstring {
1298 _loadMBI unless $biloaded; # load Math::BigInt on demand
1299 $bi2strng->(@_);
1300}
1301
1302sub _biRef {
1303 _loadMBI unless $biloaded; # load Math::BigInt on demand
1304 $biloaded->('Math::BigInt',$_[0]);
1305}
1306
1307sub bigint($) {
1308 my($addr,$mask);
1309 if (wantarray) {
1310 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1311 $addr = $_[0]->{addr}
1312 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1313 : 0;
1314 $mask = $_[0]->{mask}
1315 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{mask})))
1316 : 0;
1317 }
1318 else {
1319 $addr = $_[0]->{addr}
1320 ? bin2bcd($_[0]->{addr})
1321 : 0;
1322 $mask = $_[0]->{mask}
1323 ? bin2bcd($_[0]->{mask})
1324 : 0;
1325 }
1326 (_biRef($addr),_biRef($mask));
1327
1328 } else { # not wantarray
1329
1330 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1331 $addr = $_[0]->{addr}
1332 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1333 : 0;
1334 } else {
1335 $addr = $_[0]->{addr}
1336 ? bin2bcd($_[0]->{addr})
1337 : 0;
1338 }
1339 _biRef($addr);
1340 }
1341}
1342
1343=item C<$me-E<gt>contains($other)>
1344
1345Returns true when C<$me> completely contains C<$other>. False is
1346returned otherwise and C<undef> is returned if C<$me> and C<$other>
1347are not both C<NetAddr::IP::Lite> objects.
1348
1349=cut
1350
1351
# spent 2.49s (602ms+1.89) within NetAddr::IP::Lite::contains which was called 252582 times, avg 10µs/call: # 252582 times (602ms+1.89s) by App::Netdisco::Util::Permission::check_acl at line 207 of App/Netdisco/Util/Permission.pm, avg 10µs/call
sub contains ($$) {
1352252582635ms2525821.89s return within(@_[1,0]);
# spent 1.89s making 252582 calls to NetAddr::IP::Lite::within, avg 7µs/call
1353}
1354
1355=item C<$me-E<gt>within($other)>
1356
1357The complement of C<-E<gt>contains()>. Returns true when C<$me> is
1358completely contained within C<$other>, undef if C<$me> and C<$other>
1359are not both C<NetAddr::IP::Lite> objects.
1360
1361=cut
1362
1363
# spent 1.89s (1.64+243ms) within NetAddr::IP::Lite::within which was called 252582 times, avg 7µs/call: # 252582 times (1.64s+243ms) by NetAddr::IP::Lite::contains at line 1352, avg 7µs/call
sub within ($$) {
1364252582572ms252582106ms return 1 unless hasbits($_[1]->{mask}); # 0x0 contains everything
# spent 106ms making 252582 calls to NetAddr::IP::Util::hasbits, avg 421ns/call
1365252582149ms my $netme = $_[0]->{addr} & $_[0]->{mask};
1366252582142ms my $brdme = $_[0]->{addr} | ~ $_[0]->{mask};
1367252582114ms my $neto = $_[1]->{addr} & $_[1]->{mask};
1368252582113ms my $brdo = $_[1]->{addr} | ~ $_[1]->{mask};
13692525821.08s296979137ms return (sub128($netme,$neto) && sub128($brdo,$brdme))
# spent 137ms making 296979 calls to NetAddr::IP::Util::sub128, avg 461ns/call
1370 ? 1 : 0;
1371}
1372
1373=item C-E<gt>is_rfc1918()>
1374
1375Returns true when C<$me> is an RFC 1918 address.
1376
1377 10.0.0.0 - 10.255.255.255 (10/8 prefix)
1378 172.16.0.0 - 172.31.255.255 (172.16/12 prefix)
1379 192.168.0.0 - 192.168.255.255 (192.168/16 prefix)
1380
1381=cut
1382
1383my $ip_10 = NetAddr::IP::Lite->new('10.0.0.0/8');
1384my $ip_10n = $ip_10->{addr}; # already the right value
1385my $ip_10b = $ip_10n | ~ $ip_10->{mask};
1386
1387my $ip_172 = NetAddr::IP::Lite->new('172.16.0.0/12');
1388my $ip_172n = $ip_172->{addr}; # already the right value
1389my $ip_172b = $ip_172n | ~ $ip_172->{mask};
1390
1391my $ip_192 = NetAddr::IP::Lite->new('192.168.0.0/16');
1392my $ip_192n = $ip_192->{addr}; # already the right value
1393my $ip_192b = $ip_192n | ~ $ip_192->{mask};
1394
1395sub is_rfc1918 ($) {
1396 my $netme = $_[0]->{addr} & $_[0]->{mask};
1397 my $brdme = $_[0]->{addr} | ~ $_[0]->{mask};
1398 return 1 if (sub128($netme,$ip_10n) && sub128($ip_10b,$brdme));
1399 return 1 if (sub128($netme,$ip_192n) && sub128($ip_192b,$brdme));
1400 return (sub128($netme,$ip_172n) && sub128($ip_172b,$brdme))
1401 ? 1 : 0;
1402}
1403
1404=item C<-E<gt>is_local()>
1405
1406Returns true when C<$me> is a local network address.
1407
1408 i.e. ipV4 127.0.0.0 - 127.255.255.255
1409 or ipV6 === ::1
1410
1411=cut
1412
1413my $_lclhost6 = NetAddr::IP::Lite->new('::1');
1414my $_lclnet = NetAddr::IP::Lite->new('127/8');
1415
1416sub is_local ($) {
1417 return ($_[0]->{isv6})
1418 ? $_[0] == $_lclhost6
1419 : $_[0]->within($_lclnet);
1420}
1421
1422=item C<-E<gt>first()>
1423
1424Returns a new object representing the first usable IP address within
1425the subnet (ie, the first host address).
1426
1427=cut
1428
1429my $_cidr127 = pack('N4',0xffffffff,0xffffffff,0xffffffff,0xfffffffe);
1430
1431sub first ($) {
1432 if (hasbits($_[0]->{mask} ^ $_cidr127)) {
1433 return $_[0]->network + 1;
1434 } else {
1435 return $_[0]->network;
1436 }
1437# return $_[0]->network + 1;
1438}
1439
1440=item C<-E<gt>last()>
1441
1442Returns a new object representing the last usable IP address within
1443the subnet (ie, one less than the broadcast address).
1444
1445=cut
1446
1447sub last ($) {
1448 if (hasbits($_[0]->{mask} ^ $_cidr127)) {
1449 return $_[0]->broadcast - 1;
1450 } else {
1451 return $_[0]->broadcast;
1452 }
1453# return $_[0]->broadcast - 1;
1454}
1455
1456=item C<-E<gt>nth($index)>
1457
1458Returns a new object representing the I<n>-th usable IP address within
1459the subnet (ie, the I<n>-th host address). If no address is available
1460(for example, when the network is too small for C<$index> hosts),
1461C<undef> is returned.
1462
1463Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements
1464C<-E<gt>nth($index)> and C<-E<gt>num()> exactly as the documentation states.
1465Previous versions behaved slightly differently and not in a consistent
1466manner.
1467
1468To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
1469
1470 use NetAddr::IP::Lite qw(:old_nth);
1471
1472 old behavior:
1473 NetAddr::IP->new('10/32')->nth(0) == undef
1474 NetAddr::IP->new('10/32')->nth(1) == undef
1475 NetAddr::IP->new('10/31')->nth(0) == undef
1476 NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31
1477 NetAddr::IP->new('10/30')->nth(0) == undef
1478 NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30
1479 NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30
1480 NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30
1481
1482Note that in each case, the broadcast address is represented in the
1483output set and that the 'zero'th index is alway undef except for
1484a point-to-point /31 or /127 network where there are exactly two
1485addresses in the network.
1486
1487 new behavior:
1488 NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32
1489 NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32
1490 NetAddr::IP->new('10/31')->nth(0) == 10.0.0.0/32
1491 NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/32
1492 NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30
1493 NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30
1494 NetAddr::IP->new('10/30')->nth(2) == undef
1495
1496Note that a /32 net always has 1 usable address while a /31 has exactly
1497two usable addresses for point-to-point addressing. The first
1498index (0) returns the address immediately following the network address
1499except for a /31 or /127 when it return the network address.
1500
1501=cut
1502
1503sub nth ($$) {
1504 my $self = shift;
1505 my $count = shift;
1506
1507 my $slash31 = ! hasbits($self->{mask} ^ $_cidr127);
1508 if ($Old_nth) {
1509 return undef if $slash31 && $count != 1;
1510 return undef if ($count < 1 or $count > $self->num ());
1511 }
1512 elsif ($slash31) {
1513 return undef if ($count && $count != 1); # only index 0, 1 allowed for /31
1514 } else {
1515 ++$count;
1516 return undef if ($count < 1 or $count > $self->num ());
1517 }
1518 return $self->network + $count;
1519}
1520
1521=item C<-E<gt>num()>
1522
1523As of version 4.42 of NetAddr::IP and version 1.27 of NetAddr::IP::Lite
1524a /31 and /127 with return a net B<num> value of 2 instead of 0 (zero)
1525for point-to-point networks.
1526
1527Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite
1528return the number of usable IP addresses within the subnet,
1529not counting the broadcast or network address.
1530
1531Previous versions worked only for ipV4 addresses, returned a
1532maximum span of 2**32 and returned the number of IP addresses
1533not counting the broadcast address.
1534 (one greater than the new behavior)
1535
1536To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
1537
1538 use NetAddr::IP::Lite qw(:old_nth);
1539
1540WARNING:
1541
1542NetAddr::IP will calculate and return a numeric string for network
1543ranges as large as 2**128. These values are TEXT strings and perl
1544can treat them as integers for numeric calculations.
1545
1546Perl on 32 bit platforms only handles integer numbers up to 2**32
1547and on 64 bit platforms to 2**64.
1548
1549If you wish to manipulate numeric strings returned by NetAddr::IP
1550that are larger than 2**32 or 2**64, respectively, you must load
1551additional modules such as Math::BigInt, bignum or some similar
1552package to do the integer math.
1553
1554=cut
1555
1556sub num ($) {
1557 if ($Old_nth) {
1558 my @net = unpack('L3N',$_[0]->{mask} ^ Ones);
1559# number of ip's less broadcast
1560 return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1
1561 return $net[3] if $net[3];
1562 } else { # returns 1 for /32 /128, 2 for /31 /127 else n-2 up to 2**32
1563 (undef, my $net) = addconst($_[0]->{mask},1);
1564 return 1 unless hasbits($net); # ipV4/32 or ipV6/128
1565 $net = $net ^ Ones;
1566 return 2 unless hasbits($net); # ipV4/31 or ipV6/127
1567 $net &= $_v4net unless $_[0]->{isv6};
1568 return bin2bcd($net);
1569 }
1570}
1571
1572# deprecated
1573#sub num ($) {
1574# my @net = unpack('L3N',$_[0]->{mask} ^ Ones);
1575# if ($Old_nth) {
1576## number of ip's less broadcast
1577# return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1
1578# return $net[3] if $net[3];
1579# } else { # returns 1 for /32 /128, 0 for /31 /127 else n-2 up to 2**32
1580## number of usable IP's === number of ip's less broadcast & network addys
1581# return 0xfffffffd if $net[0] || $net[1] || $net[2]; # 2**32 -2
1582# return 1 unless $net[3];
1583# $net[3]--;
1584# }
1585# return $net[3];
1586#}
1587
1588=pod
1589
1590=back
1591
1592=cut
1593
1594sub import {
1595 if (grep { $_ eq ':aton' } @_) {
1596 $Accept_Binary_IP = 1;
1597 @_ = grep { $_ ne ':aton' } @_;
1598 }
1599 if (grep { $_ eq ':old_nth' } @_) {
1600 $Old_nth = 1;
1601 @_ = grep { $_ ne ':old_nth' } @_;
1602 }
1603 if (grep { $_ eq ':lower' } @_)
1604 {
1605 NetAddr::IP::Util::lower();
1606 @_ = grep { $_ ne ':lower' } @_;
1607 }
1608 if (grep { $_ eq ':upper' } @_)
1609 {
1610 NetAddr::IP::Util::upper();
1611 @_ = grep { $_ ne ':upper' } @_;
1612 }
1613 if (grep { $_ eq ':nofqdn' } @_)
1614 {
1615 $NoFQDN = 1;
1616 @_ = grep { $_ ne ':nofqdn' } @_;
1617 }
1618 NetAddr::IP::Lite->export_to_level(1, @_);
1619}
1620
1621=head1 EXPORT_OK
1622
1623 Zeros
1624 Ones
1625 V4mask
1626 V4net
1627 :aton DEPRECATED
1628 :old_nth
1629 :upper
1630 :lower
1631 :nofqdn
1632
1633=head1 AUTHORS
1634
1635Luis E. Muñoz E<lt>luismunoz@cpan.orgE<gt>,
1636Michael Robinton E<lt>michael@bizsystems.comE<gt>
1637
1638=head1 WARRANTY
1639
1640This software comes with the same warranty as perl itself (ie, none),
1641so by using it you accept any and all the liability.
1642
1643=head1 COPYRIGHT
1644
1645 This software is (c) Luis E. Muñoz, 1999 - 2005
1646 and (c) Michael Robinton, 2006 - 2014.
1647
1648All rights reserved.
1649
1650This program is free software; you can redistribute it and/or modify
1651it under the terms of either:
1652
1653 a) the GNU General Public License as published by the Free
1654 Software Foundation; either version 2, or (at your option) any
1655 later version, or
1656
1657 b) the "Artistic License" which comes with this distribution.
1658
1659This program is distributed in the hope that it will be useful,
1660but WITHOUT ANY WARRANTY; without even the implied warranty of
1661MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
1662the GNU General Public License or the Artistic License for more details.
1663
1664You should have received a copy of the Artistic License with this
1665distribution, in the file named "Artistic". If not, I'll be glad to provide
1666one.
1667
1668You should also have received a copy of the GNU General Public License
1669along with this program in the file named "Copying". If not, write to the
1670
1671 Free Software Foundation, Inc.,
1672 51 Franklin Street, Fifth Floor
1673 Boston, MA 02110-1301 USA
1674
1675or visit their web page on the internet at:
1676
1677 http://www.gnu.org/copyleft/gpl.html.
1678
1679=head1 SEE ALSO
1680
1681NetAddr::IP(3), NetAddr::IP::Util(3), NetAddr::IP::InetBase(3)
1682
1683=cut
1684
16851;
 
# spent 802ms within NetAddr::IP::Lite::CORE:match which was called 1769502 times, avg 453ns/call: # 758358 times (488ms+0s) by NetAddr::IP::Lite::_xnew at line 787, avg 644ns/call # 505572 times (79.2ms+0s) by NetAddr::IP::Lite::_xnew at line 856, avg 157ns/call # 252786 times (175ms+0s) by NetAddr::IP::Lite::_xnew at line 931, avg 691ns/call # 252786 times (59.6ms+0s) by NetAddr::IP::Lite::_xnew at line 840, avg 236ns/call
sub NetAddr::IP::Lite::CORE:match; # opcode
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.