← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:01 2017

Filename/usr/local/lib/perl5/site_perl/mach/5.24/NetAddr/IP/Lite.pm
StatementsExecuted 918 statements in 21.9ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111.9ms27.0msNetAddr::IP::Lite::::BEGIN@9NetAddr::IP::Lite::BEGIN@9
19213.45ms9.22msNetAddr::IP::Lite::::_xnewNetAddr::IP::Lite::_xnew
1112.95ms13.9msNetAddr::IP::Lite::::BEGIN@18NetAddr::IP::Lite::BEGIN@18
11771520µs520µsNetAddr::IP::Lite::::CORE:matchNetAddr::IP::Lite::CORE:match (opcode)
111214µs832µsNetAddr::IP::Lite::::importNetAddr::IP::Lite::import
611208µs344µsNetAddr::IP::Lite::::networkNetAddr::IP::Lite::network
611137µs137µsNetAddr::IP::Lite::::_newNetAddr::IP::Lite::_new
411115µs140µsNetAddr::IP::Lite::::masklenNetAddr::IP::Lite::masklen
411113µs1.54msNetAddr::IP::Lite::::cidrNetAddr::IP::Lite::cidr
1032101µs101µsNetAddr::IP::Lite::::new6NetAddr::IP::Lite::new6
21189µs119µsNetAddr::IP::Lite::::withinNetAddr::IP::Lite::within
41180µs1.29msNetAddr::IP::Lite::::addrNetAddr::IP::Lite::addr
96272µs72µsNetAddr::IP::Lite::::newNetAddr::IP::Lite::new
42172µs1.61msNetAddr::IP::Lite::::__ANON__[:238]NetAddr::IP::Lite::__ANON__[:238]
11172µs788µsNetAddr::IP::Lite::::BEGIN@228NetAddr::IP::Lite::BEGIN@228
155168µs68µsNetAddr::IP::Lite::::OnesNetAddr::IP::Lite::Ones
11152µs243µsNetAddr::IP::Lite::::BEGIN@5NetAddr::IP::Lite::BEGIN@5
94142µs42µsNetAddr::IP::Lite::::ZerosNetAddr::IP::Lite::Zeros
11130µs36µsNetAddr::IP::Lite::::BEGIN@6NetAddr::IP::Lite::BEGIN@6
11126µs485µsNetAddr::IP::Lite::::BEGIN@33NetAddr::IP::Lite::BEGIN@33
21125µs144µsNetAddr::IP::Lite::::containsNetAddr::IP::Lite::contains
11122µs41µsNetAddr::IP::Lite::::BEGIN@174NetAddr::IP::Lite::BEGIN@174
21120µs20µsNetAddr::IP::Lite::::plusNetAddr::IP::Lite::plus
0000s0sNetAddr::IP::Lite::::AUTOLOADNetAddr::IP::Lite::AUTOLOAD
0000s0sNetAddr::IP::Lite::::DESTROYNetAddr::IP::Lite::DESTROY
0000s0sNetAddr::IP::Lite::::V4maskNetAddr::IP::Lite::V4mask
0000s0sNetAddr::IP::Lite::::V4netNetAddr::IP::Lite::V4net
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::::_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::::bitsNetAddr::IP::Lite::bits
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::::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::::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::::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
5272µs2435µs
# spent 243µs (52+191) within NetAddr::IP::Lite::BEGIN@5 which was called: # once (52µs+191µs) by NetAddr::IP::BEGIN@8 at line 5
use Carp;
# spent 243µs making 1 call to NetAddr::IP::Lite::BEGIN@5 # spent 191µs making 1 call to Exporter::import
6291µs243µs
# spent 36µs (30+7) within NetAddr::IP::Lite::BEGIN@6 which was called: # once (30µs+7µs) by NetAddr::IP::BEGIN@8 at line 6
use strict;
# spent 36µs making 1 call to NetAddr::IP::Lite::BEGIN@6 # spent 7µs making 1 call to strict::import
7#use diagnostics;
8#use warnings;
91228µs
# spent 27.0ms (11.9+15.1) within NetAddr::IP::Lite::BEGIN@9 which was called: # once (11.9ms+15.1ms) by NetAddr::IP::BEGIN@8 at line 17
use NetAddr::IP::InetBase qw(
10 inet_any2n
11 isIPv4
12 inet_n2dx
13 inet_aton
14 ipv6_aton
15 ipv6_n2x
16 fillIPv4
171128µs228.0ms);
# spent 27.0ms making 1 call to NetAddr::IP::Lite::BEGIN@9 # spent 1.01ms making 1 call to NetAddr::IP::InetBase::import
181246µs
# spent 13.9ms (2.95+10.9) within NetAddr::IP::Lite::BEGIN@18 which was called: # once (2.95ms+10.9ms) by NetAddr::IP::BEGIN@8 at line 31
use 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
311118µs215.1ms);
# spent 13.9ms making 1 call to NetAddr::IP::Lite::BEGIN@18 # spent 1.23ms making 1 call to NetAddr::IP::Util::import
32
332411µs2945µs
# spent 485µs (26+459) within NetAddr::IP::Lite::BEGIN@33 which was called: # once (26µs+459µs) by NetAddr::IP::BEGIN@8 at line 33
use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $NoFQDN $AUTOLOAD *Zero);
# spent 485µs making 1 call to NetAddr::IP::Lite::BEGIN@33 # spent 460µs making 1 call to vars::import
34
35373µs123µs$VERSION = do { my @r = (q$Revision: 1.56 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
# spent 23µs making 1 call to NetAddr::IP::Lite::CORE:match
36
3715µsrequire Exporter;
38
39124µs@ISA = qw(Exporter);
40
4115µs@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
4712µs$Accept_Binary_IP = 0;
4812µs$Old_nth = 0;
4917µs*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
15912µsmy $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 {
17421.49ms259µs
# spent 41µs (22+18) within NetAddr::IP::Lite::BEGIN@174 which was called: # once (22µs+18µs) by NetAddr::IP::BEGIN@8 at line 174
no strict;
# spent 41µs making 1 call to NetAddr::IP::Lite::BEGIN@174 # spent 18µs making 1 call to strict::unimport
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
20112µs15µsmy $_v4zero = pack('L',0);
# spent 5µs making 1 call to main::CORE:pack
20212µs110µsmy $_zero = pack('L4',0,0,0,0);
# spent 10µs making 1 call to main::CORE:pack
20313µsmy $_ones = ~$_zero;
20412µs14µsmy $_v4mask = pack('L4',0xffffffff,0xffffffff,0xffffffff,0);
# spent 4µs making 1 call to main::CORE:pack
20512µsmy $_v4net = ~ $_v4mask;
20612µs18µsmy $_ipv4FFFF = pack('N4',0,0,0xffff,0);
# spent 8µs making 1 call to main::CORE:pack
207
208
# spent 42µs within NetAddr::IP::Lite::Zeros which was called 9 times, avg 5µs/call: # 3 times (12µs+0s) by NetAddr::IP::BEGIN@8 at line 666, avg 4µs/call # 2 times (14µs+0s) by NetAddr::IP::BEGIN@8 at line 650, avg 7µs/call # 2 times (8µs+0s) by NetAddr::IP::BEGIN@8 at line 657, avg 4µs/call # 2 times (8µs+0s) by NetAddr::IP::BEGIN@8 at line 674, avg 4µs/call
sub Zeros() {
2099101µs return $_zero;
210}
211
# spent 68µs within NetAddr::IP::Lite::Ones which was called 15 times, avg 5µs/call: # 6 times (29µs+0s) by NetAddr::IP::Lite::_xnew at line 889, avg 5µs/call # 3 times (12µs+0s) by NetAddr::IP::BEGIN@8 at line 674, avg 4µs/call # 2 times (9µs+0s) by NetAddr::IP::Lite::_xnew at line 879, avg 5µs/call # 2 times (9µs+0s) by NetAddr::IP::BEGIN@8 at line 657, avg 4µs/call # 2 times (9µs+0s) by NetAddr::IP::Lite::_xnew at line 870, avg 4µs/call
sub Ones() {
21215171µs 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
# spent 788µs (72+716) within NetAddr::IP::Lite::BEGIN@228 which was called: # once (72µs+716µs) by NetAddr::IP::BEGIN@8 at line 280
'+' => \&plus,
229
230 '-' => \&minus,
231
232 '++' => \&plusplus,
233
234 '--' => \&minusminus,
235
236 "=" => \&copy,
237
238485µs41.54ms
# spent 1.61ms (72µs+1.54) within NetAddr::IP::Lite::__ANON__[/usr/local/lib/perl5/site_perl/mach/5.24/NetAddr/IP/Lite.pm:238] which was called 4 times, avg 403µs/call: # 2 times (20µs+1.32ms) by Mail::SpamAssassin::NetSet::is_net_declared at line 246 of Mail/SpamAssassin/NetSet.pm, avg 672µs/call # 2 times (52µs+214µs) by Mail::SpamAssassin::NetSet::CORE:match at line 213 of Mail/SpamAssassin/NetSet.pm, avg 133µs/call
'""' => sub { $_[0]->cidr(); },
# spent 1.54ms making 4 calls to NetAddr::IP::Lite::cidr, avg 385µ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
27812µs '<=>' => \&comp_addr_mask,
279
280112.6ms21.50ms 'cmp' => \&comp_addr_mask;
# spent 788µs making 1 call to NetAddr::IP::Lite::BEGIN@228 # spent 716µs making 1 call to overload::import
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
384
# spent 20µs within NetAddr::IP::Lite::plus which was called 2 times, avg 10µs/call: # 2 times (20µs+0s) by Mail::SpamAssassin::NetSet::_convert_ipv4_cidr_to_ipv6 at line 208 of Mail/SpamAssassin/NetSet.pm, avg 10µs/call
sub plus {
38524µs my $ip = shift;
38624µs my $const = shift;
387
388223µs 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
41612µs15µsmy $_smsk = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0x80000000);
# spent 5µs making 1 call to main::CORE:pack
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#
492
# spent 137µs within NetAddr::IP::Lite::_new which was called 6 times, avg 23µs/call: # 6 times (137µs+0s) by NetAddr::IP::Lite::network at line 1088, avg 23µs/call
sub _new ($$$) {
493612µs my $proto = shift;
494617µs my $class = ref($proto) || die "reference required";
495614µs $proto = $proto->{isv6};
496646µs my $self = {
497 addr => $_[0],
498 mask => $_[1],
499 isv6 => $proto,
500 };
501647µs 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
643112µs1147µsmy $lbmask = inet_aton('255.0.0.0');
# spent 147µs making 1 call to NetAddr::IP::InetBase::inet_aton
644119µs1643µsmy $_p4broad = inet_any2n('255.255.255.255');
# spent 643µs making 1 call to AutoLoader::AUTOLOAD
64517µs1307µsmy $_p4loop = inet_any2n('127.0.0.1');
# spent 307µs making 1 call to NetAddr::IP::InetBase::inet_any2n
64617µs199µsmy $_p4mloop = inet_aton('255.0.0.0');
# spent 99µs making 1 call to NetAddr::IP::InetBase::inet_aton
647125µs112µs $_p4mloop = mask4to6($_p4mloop);
# spent 12µs making 1 call to NetAddr::IP::Util::mask4to6
64817µs1302µsmy $_p6loop = inet_any2n('::1');
# spent 302µs making 1 call to NetAddr::IP::InetBase::inet_any2n
649
650132µs214µsmy %fip4 = (
# spent 14µs making 2 calls to NetAddr::IP::Lite::Zeros, avg 7µs/call
651 default => Zeros,
652 any => Zeros,
653 broadcast => $_p4broad,
654 loopback => $_p4loop,
655 unspecified => undef,
656);
657124µs417µsmy %fip4m = (
# spent 9µs making 2 calls to NetAddr::IP::Lite::Ones, avg 4µs/call # spent 8µs making 2 calls to NetAddr::IP::Lite::Zeros, avg 4µs/call
658 default => Zeros,
659 any => Zeros,
660 broadcast => Ones,
661 loopback => $_p4mloop,
662 unspecified => undef, # not applicable for ipV4
663 host => Ones,
664);
665
666132µs312µsmy %fip6 = (
# spent 12µs making 3 calls to NetAddr::IP::Lite::Zeros, avg 4µs/call
667 default => Zeros,
668 any => Zeros,
669 broadcast => undef, # not applicable for ipV6
670 loopback => $_p6loop,
671 unspecified => Zeros,
672);
673
674125µs520µsmy %fip6m = (
# spent 12µs making 3 calls to NetAddr::IP::Lite::Ones, avg 4µs/call # spent 8µs making 2 calls to NetAddr::IP::Lite::Zeros, avg 4µs/call
675 default => Zeros,
676 any => Zeros,
677 broadcast => undef, # not applicable for ipV6
678 loopback => Ones,
679 unspecified => Ones,
680 host => Ones,
681);
682
68312µs14µsmy $ff000000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFF000000);
# spent 4µs making 1 call to main::CORE:pack
68412µs13µsmy $ffff0000 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFF0000);
# spent 3µs making 1 call to main::CORE:pack
68512µs13µsmy $ffffff00 = pack('L3N',0xffffffff,0xffffffff,0xffffffff,0xFFFFFF00);
# spent 3µs making 1 call to main::CORE:pack
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 72µs within NetAddr::IP::Lite::new which was called 9 times, avg 8µs/call: # 4 times (34µs+0s) by Mail::SpamAssassin::NetSet::add_cidr at line 154 of Mail/SpamAssassin/NetSet.pm, avg 9µs/call # once (11µs+0s) by NetAddr::IP::BEGIN@8 at line 1374 # once (7µs+0s) by NetAddr::IP::BEGIN@8 at line 1378 # once (7µs+0s) by NetAddr::IP::BEGIN@8 at line 1404 # once (7µs+0s) by NetAddr::IP::BEGIN@8 at line 1382 # once (7µs+0s) by NetAddr::IP::BEGIN@8 at line 1405
sub new($;$$) {
700926µs unshift @_, 0;
7019160µs94.09ms goto &_xnew;
# spent 4.09ms making 9 calls to NetAddr::IP::Lite::_xnew, avg 455µ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
719
# spent 101µs within NetAddr::IP::Lite::new6 which was called 10 times, avg 10µs/call: # 6 times (69µs+0s) by Mail::SpamAssassin::Util::reverse_ip_address at line 914 of Mail/SpamAssassin/Util.pm, avg 12µs/call # 2 times (16µs+0s) by Mail::SpamAssassin::NetSet::_convert_ipv4_cidr_to_ipv6 at line 208 of Mail/SpamAssassin/NetSet.pm, avg 8µs/call # 2 times (15µs+0s) by Mail::SpamAssassin::NetSet::_convert_ipv4_cidr_to_ipv6 at line 218 of Mail/SpamAssassin/NetSet.pm, avg 8µs/call
sub new6($;$$) {
7201032µs unshift @_, 1;
72110181µs105.13ms goto &_xnew;
# spent 5.13ms making 10 calls to NetAddr::IP::Lite::_xnew, avg 513µs/call
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}
752
753
# spent 9.22ms (3.45+5.77) within NetAddr::IP::Lite::_xnew which was called 19 times, avg 485µs/call: # 10 times (1.78ms+3.35ms) by Mail::SpamAssassin::NetSet::_convert_ipv4_cidr_to_ipv6 or Mail::SpamAssassin::Util::reverse_ip_address at line 721, avg 513µs/call # 9 times (1.67ms+2.42ms) by Mail::SpamAssassin::NetSet::add_cidr or NetAddr::IP::BEGIN@8 at line 701, avg 455µs/call
sub _xnew($$;$$) {
7541938µs my $noctal = 0;
7551942µs my $isV6 = shift;
7561933µs if ($isV6 < 0) { # flag for no octal?
757 $isV6 = 0;
758 $noctal = 1;
759 }
7601938µs my $proto = shift;
7611939µs my $class = ref $proto || $proto || __PACKAGE__;
7621941µs my $ip = shift;
763
764# fix for bug #75976
7651942µs return undef if defined $ip && $ip eq '';
766
7671939µs $ip = 'default' unless defined $ip;
7681935µs $ip = _retMBIstring($ip) # treat as big bcd string
769 if ref $ip && ref $ip eq 'Math::BigInt'; # can /CIDR notation
7701933µs my $hasmask = 1;
7711931µs my($mask,$tmp);
772
773# IP to lower case AFTER ref test for Math::BigInt. 'lc' strips blessing
774
7751976µs $ip = lc $ip;
776
7771931µs while (1) {
778# process IP's with no CIDR or that have the CIDR as part of the IP argument string
7791972µs unless (@_) {
780# if ($ip =~ m!^(.+)/(.+)$!) {
78119716µs47251µs if ($ip !~ /\D/) { # binary number notation
# spent 251µs making 47 calls to NetAddr::IP::Lite::CORE:match, avg 5µs/call
782 $ip = bcd2bin($ip);
783 $mask = Ones;
784 last;
785 }
786 elsif ($ip =~ m!^([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)$! ||
787 $ip =~ m!^[\[]{1}([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)[\]]{1}$!) {
7881027µs $ip = $1;
7891022µs $mask = $2;
790 } elsif (grep($ip eq $_,(qw(default any broadcast loopback unspecified)))) {
791 $isV6 = 1 if $ip eq 'unspecified';
792 if ($isV6) {
793 $mask = $fip6m{$ip};
794 return undef unless defined ($ip = $fip6{$ip});
795 } else {
796 $mask = $fip4m{$ip};
797 return undef unless defined ($ip = $fip4{$ip});
798 }
799 last;
800 }
801 }
802# process "ipv6" token and default IP's
803 elsif (defined $_[0]) {
804 if ($_[0] =~ /ipv6/i || $isV6) {
805 if (grep($ip eq $_,(qw(default any loopback unspecified)))) {
806 $mask = $fip6m{$ip};
807 $ip = $fip6{$ip};
808 last;
809 } else {
810 return undef unless $isV6;
811# add for ipv6 notation "12345, 1"
812 }
813# $mask = lc $_[0];
814# } else {
815# $mask = lc $_[0];
816 }
817# extract mask
818 $mask = $_[0];
819 }
820###
821### process mask
8221961µs unless (defined $mask) {
823925µs $hasmask = 0;
824919µs $mask = 'host';
825 }
826
827# two kinds of IP's can turn on the isV6 flag
828# 1) big digits that are over the IPv4 boundry
829# 2) IPv6 IP syntax
830#
831# check these conditions and set isV6 as appropriate
832#
8331931µs my $try;
83419396µs302.63ms $isV6 = 1 if # check big bcd and IPv6 rfc1884
# spent 2.53ms making 11 calls to NetAddr::IP::InetBase::ipv6_aton, avg 230µs/call # spent 90µs making 19 calls to NetAddr::IP::Lite::CORE:match, avg 5µs/call
835 ( $ip !~ /\D/ && # ip is all decimal
836 (length($ip) > 3 || $ip > 255) && # exclude a single digit in the range of zero to 255, could be funny IPv4
837 ($try = bcd2bin($ip)) && ! isIPv4($try)) || # precedence so $try is not corrupted
838 (index($ip,':') >= 0 && ($try = ipv6_aton($ip))); # fails if not an rfc1884 address
839
840# if either of the above conditions is true, $try contains the NetAddr 128 bit address
841
842# checkfor Math::BigInt mask
8431932µs $mask = _retMBIstring($mask) # treat as big bcd string
844 if ref $mask && ref $mask eq 'Math::BigInt';
845
846# MASK to lower case AFTER ref test for Math::BigInt, 'lc' strips blessing
847
8481942µs $mask = lc $mask;
849
85019352µs2877µs if ($mask !~ /\D/) { # bcd or CIDR notation
# spent 77µs making 28 calls to NetAddr::IP::Lite::CORE:match, avg 3µs/call
8511028µs my $isCIDR = length($mask) < 4 && $mask < 129;
8521042µs if ($isV6) {
853412µs if ($isCIDR) {
85447µs my($dq1,$dq2,$dq3,$dq4);
855468µs416µs if ($ip =~ /^(\d+)(?:|\.(\d+)(?:|\.(\d+)(?:|\.(\d+))))$/ &&
# spent 16µs making 4 calls to NetAddr::IP::Lite::CORE:match, avg 4µs/call
85625µs do {$dq1 = $1;
85726µs $dq2 = $2 || 0;
85824µs $dq3 = $3 || 0;
85924µs $dq4 = $4 || 0;
86023µs 1;
861 } &&
862 $dq1 >= 0 && $dq1 < 256 &&
863 $dq2 >= 0 && $dq2 < 256 &&
864 $dq3 >= 0 && $dq3 < 256 &&
865 $dq4 >= 0 && $dq4 < 256
866 ) { # corner condition of IPv4 with isV6
86729µs $ip = join('.',$dq1,$dq2,$dq3,$dq4);
868236µs4131µs $try = ipv4to6(inet_aton($ip));
# spent 125µs making 2 calls to NetAddr::IP::InetBase::inet_aton, avg 62µs/call # spent 6µs making 2 calls to NetAddr::IP::Util::ipv4to6, avg 3µs/call
86927µs if ($mask < 32) {
870232µs417µs $mask = shiftleft(Ones,32 -$mask);
# spent 9µs making 2 calls to NetAddr::IP::Lite::Ones, avg 4µs/call # spent 9µs making 2 calls to NetAddr::IP::Util::shiftleft, avg 4µs/call
871 }
872 elsif ($mask == 32) {
873 $mask = Ones;
874 } else {
875 return undef; # undoubtably an error
876 }
877 }
878 elsif ($mask < 128) {
879235µs418µs $mask = shiftleft(Ones,128 -$mask); # small cidr
# spent 9µs making 2 calls to NetAddr::IP::Lite::Ones, avg 5µs/call # spent 9µs making 2 calls to NetAddr::IP::Util::shiftleft, avg 4µs/call
880 } else {
881 $mask = Ones();
882 }
883 } else {
884 $mask = bcd2bin($mask);
885 }
886 }
887 elsif ($isCIDR && $mask < 33) { # is V4
888620µs if ($mask < 32) {
8896146µs1274µs $mask = shiftleft(Ones,32 -$mask);
# spent 45µs making 6 calls to NetAddr::IP::Util::shiftleft, avg 7µs/call # spent 29µs making 6 calls to NetAddr::IP::Lite::Ones, avg 5µs/call
890 }
891 elsif ( $mask == 32) {
892 $mask = Ones;
893 } else {
894 $mask = bcd2bin($mask);
895 $mask |= $_v4mask; # v4 always
896 }
897 } else { # also V4
898 $mask = bcd2bin($mask);
899 $mask |= $_v4mask;
900 }
9011034µs if ($try) { # is a big number
90247µs $ip = $try;
90348µs last;
904 }
905 } elsif ($mask =~ m/^\d+\.\d+\.\d+\.\d+$/) { # ipv4 form of mask
906 $mask = _no_octal($mask) if $noctal; # filter for octal
907 return undef unless defined ($mask = inet_aton($mask));
908 $mask = mask4to6($mask);
909 } elsif (grep($mask eq $_,qw(default any broadcast loopback unspecified host))) {
910948µs if (index($ip,':') < 0 && ! $isV6) {
911 return undef unless defined ($mask = $fip4m{$mask});
912 } else {
913930µs return undef unless defined ($mask = $fip6m{$mask});
914 }
915 } else {
916 return undef unless defined ($mask = ipv6_aton($mask)); # try ipv6 form of mask
917 }
918
919# process remaining IP's
920
9211543µs if (index($ip,':') < 0) { # ipv4 address
9226115µs940µs if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
# spent 40µs making 9 calls to NetAddr::IP::Lite::CORE:match, avg 4µs/call
923 ; # the common case
924 }
925 elsif (grep($ip eq $_,(qw(default any broadcast loopback)))) {
926 return undef unless defined ($ip = $fip4{$ip});
927 last;
928 }
929 elsif ($ip =~ m/^(\d+)\.(\d+)$/) {
930 $ip = ($hasmask)
931 ? "${1}.${2}.0.0"
932 : "${1}.0.0.${2}";
933 }
934 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
935 $ip = ($hasmask)
936 ? "${1}.${2}.${3}.0"
937 : "${1}.${2}.0.${3}";
938 }
939 elsif ($ip =~ /^(\d+)$/ && $hasmask && $1 >= 0 and $1 < 256) { # pure numeric
94016µs $ip = sprintf("%d.0.0.0",$1);
941 }
942# elsif ($ip =~ /^\d+$/ && !$hasmask) { # a big integer
943 elsif ($ip =~ /^\d+$/ ) { # a big integer
944 $ip = bcd2bin($ip);
945 last;
946 }
947# these next three might be broken??? but they have been in the code a long time and no one has complained
948 elsif ($ip =~ /^0[xb]\d+$/ && $hasmask &&
949 (($tmp = eval "$ip") || 1) &&
950 $tmp >= 0 && $tmp < 256) {
951 $ip = sprintf("%d.0.0.0",$tmp);
952 }
953 elsif ($ip =~ /^-?\d+$/) {
954 $ip += 2 ** 32 if $ip < 0;
955 $ip = pack('L3N',0,0,0,$ip);
956 last;
957 }
958 elsif ($ip =~ /^-?0[xb]\d+$/) {
959 $ip = eval "$ip";
960 $ip = pack('L3N',0,0,0,$ip);
961 last;
962 }
963
964# notations below include an implicit mask specification
965
966 elsif ($ip =~ m/^(\d+)\.$/) {
967 $ip = "${1}.0.0.0";
968 $mask = $ff000000;
969 }
970 elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ && $2 <= $3 && $3 < 256) {
971 $ip = "${1}.${2}.0.0";
972 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,_obits($2,$3),0,0);
973 }
974 elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ and $1 <= $2 && $2 < 256) {
975 $ip = "${1}.0.0.0";
976 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,_obits($1,$2),0,0,0)
977 }
978 elsif ($ip =~ m/^(\d+)\.(\d+)\.$/) {
979 $ip = "${1}.${2}.0.0";
980 $mask = $ffff0000;
981 }
982 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ && $3 <= $4 && $4 < 256) {
983 $ip = "${1}.${2}.${3}.0";
984 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,_obits($3,$4),0);
985 }
986 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/) {
987 $ip = "${1}.${2}.${3}.0";
988 $mask = $ffffff00;
989 }
990 elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ && $4 <= $5 && $5 < 256) {
991 $ip = "${1}.${2}.${3}.${4}";
992 $mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,255,_obits($4,$5));
993 }
994 elsif ($ip =~ m/^(\d+\.\d+\.\d+\.\d+)
995 \s*-\s*(\d+\.\d+\.\d+\.\d+)$/x) {
996 if ($noctal) {
997 return undef unless ($ip = inet_aton(_no_octal($1)));
998 return undef unless ($tmp = inet_aton(_no_octal($2)));
999 } else {
1000 return undef unless ($ip = inet_aton($1));
1001 return undef unless ($tmp = inet_aton($2));
1002 }
1003# check for left side greater than right side
1004# save numeric difference in $mask
1005 return undef if ($tmp = unpack('N',$tmp) - unpack('N',$ip)) < 0;
1006 $ip = ipv4to6($ip);
1007 $tmp = pack('L3N',0,0,0,$tmp);
1008 $mask = ~$tmp;
1009 return undef if notcontiguous($mask);
1010# check for non-aligned left side
1011 return undef if hasbits($ip & $tmp);
1012 last;
1013 }
1014# check for resolvable IPv4 hosts
1015 elsif (! $NoFQDN && $ip !~ /[^a-zA-Z0-9\._-]/ && ($tmp = gethostbyname(fillIPv4($ip))) && $tmp ne $_v4zero && $tmp ne $_zero ) {
1016 $ip = ipv4to6($tmp);
1017 last;
1018 }
1019# check for resolvable IPv6 hosts
1020 elsif (! $NoFQDN && $ip !~ /[^a-zA-Z0-9\._-]/ && havegethostbyname2() && ($tmp = naip_gethostbyname($ip))) {
1021 $ip = $tmp;
1022 $isV6 = 1;
1023 last;
1024 }
1025 elsif ($Accept_Binary_IP && ! $hasmask) {
1026 if (length($ip) == 4) {
1027 $ip = ipv4to6($ip);
1028 } elsif (length($ip) == 16) {
1029 $isV6 = 1;
1030 } else {
1031 return undef;
1032 }
1033 last;
1034 } else {
1035 return undef;
1036 }
1037641µs6468µs return undef unless defined ($ip = inet_aton($ip));
# spent 468µs making 6 calls to NetAddr::IP::InetBase::inet_aton, avg 78µs/call
10386105µs641µs $ip = ipv4to6($ip);
# spent 41µs making 6 calls to NetAddr::IP::Util::ipv4to6, avg 7µs/call
1039616µs last;
1040 }
1041########## continuing
1042 else { # ipv6 address
1043918µs $isV6 = 1;
1044992µs922µs $ip = $1 if $ip =~ /\[([^\]]+)\]/; # transform URI notation
# spent 22µs making 9 calls to NetAddr::IP::Lite::CORE:match, avg 2µs/call
1045973µs91.92ms if (defined ($tmp = ipv6_aton($ip))) {
# spent 1.92ms making 9 calls to NetAddr::IP::InetBase::ipv6_aton, avg 213µs/call
1046919µs $ip = $tmp;
1047927µs last;
1048 }
1049 last if grep($ip eq $_,(qw(default any loopback unspecified))) &&
1050 defined ($ip = $fip6{$ip});
1051 return undef;
1052 }
1053 } # end while (1)
105419283µs1970µs return undef if notcontiguous($mask); # invalid if not contiguous
# spent 70µs making 19 calls to NetAddr::IP::Util::notcontiguous, avg 4µs/call
1055
105619119µs my $self = {
1057 addr => $ip,
1058 mask => $mask,
1059 isv6 => $isV6,
1060 };
106119203µs return bless $self, $class;
1062}
1063
1064=item C<-E<gt>broadcast()>
1065
1066Returns a new object referring to the broadcast address of a given
1067subnet. The broadcast address has all ones in all the bit positions
1068where the netmask has zero bits. This is normally used to address all
1069the hosts in a given subnet.
1070
1071=cut
1072
1073sub broadcast ($) {
1074 my $ip = _new($_[0],$_[0]->{addr} | ~$_[0]->{mask},$_[0]->{mask});
1075 $ip->{addr} &= V4net unless $ip->{isv6};
1076 return $ip;
1077}
1078
1079=item C<-E<gt>network()>
1080
1081Returns a new object referring to the network address of a given
1082subnet. A network address has all zero bits where the bits of the
1083netmask are zero. Normally this is used to refer to a subnet.
1084
1085=cut
1086
1087
# spent 344µs (208+137) within NetAddr::IP::Lite::network which was called 6 times, avg 57µs/call: # 6 times (208µs+137µs) by Mail::SpamAssassin::Util::reverse_ip_address at line 917 of Mail/SpamAssassin/Util.pm, avg 57µs/call
sub network ($) {
10886221µs6137µs return _new($_[0],$_[0]->{addr} & $_[0]->{mask},$_[0]->{mask});
# spent 137µs making 6 calls to NetAddr::IP::Lite::_new, avg 23µs/call
1089}
1090
1091=item C<-E<gt>addr()>
1092
1093Returns a scalar with the address part of the object as an IPv4 or IPv6 text
1094string as appropriate. This is useful for printing or for passing the address
1095part of the NetAddr::IP::Lite object to other components that expect an IP
1096address. If the object is an ipV6 address or was created using ->new6($ip)
1097it will be reported in ipV6 hex format otherwise it will be reported in dot
1098quad format only if it resides in ipV4 address space.
1099
1100=cut
1101
1102
# spent 1.29ms (80µs+1.20) within NetAddr::IP::Lite::addr which was called 4 times, avg 321µs/call: # 4 times (80µs+1.20ms) by NetAddr::IP::Lite::cidr at line 1169, avg 321µs/call
sub addr ($) {
1103 return ($_[0]->{isv6})
1104 ? ipv6_n2x($_[0]->{addr})
1105483µs41.05ms : inet_n2dx($_[0]->{addr});
# spent 872µs making 1 call to AutoLoader::AUTOLOAD # spent 96µs making 1 call to NetAddr::IP::InetBase::inet_n2dx # spent 79µs making 2 calls to NetAddr::IP::InetBase::ipv6_n2x, avg 40µs/call
1106}
1107
1108=item C<-E<gt>mask()>
1109
1110Returns a scalar with the mask as an IPv4 or IPv6 text string as
1111described above.
1112
1113=cut
1114
1115sub mask ($) {
1116 return ipv6_n2x($_[0]->{mask}) if $_[0]->{isv6};
1117 my $mask = isIPv4($_[0]->{addr})
1118 ? $_[0]->{mask} & V4net
1119 : $_[0]->{mask};
1120 return inet_n2dx($mask);
1121}
1122
1123=item C<-E<gt>masklen()>
1124
1125Returns a scalar the number of one bits in the mask.
1126
1127=cut
1128
1129
# spent 140µs (115+25) within NetAddr::IP::Lite::masklen which was called 4 times, avg 35µs/call: # 4 times (115µs+25µs) by NetAddr::IP::Lite::cidr at line 1169, avg 35µs/call
sub masklen ($) {
1130453µs412µs my $len = (notcontiguous($_[0]->{mask}))[1];
# spent 12µs making 4 calls to NetAddr::IP::Util::notcontiguous, avg 3µs/call
113147µs return 0 unless $len;
1132439µs return $len if $_[0]->{isv6};
1133 return isIPv4($_[0]->{addr})
1134236µs213µs ? $len -96
# spent 13µs making 2 calls to NetAddr::IP::InetBase::isIPv4, avg 6µs/call
1135 : $len;
1136}
1137
1138=item C<-E<gt>bits()>
1139
1140Returns the width of the address in bits. Normally 32 for v4 and 128 for v6.
1141
1142=cut
1143
1144sub bits {
1145 return $_[0]->{isv6} ? 128 : 32;
1146}
1147
1148=item C<-E<gt>version()>
1149
1150Returns the version of the address or subnet. Currently this can be
1151either 4 or 6.
1152
1153=cut
1154
1155sub version {
1156 my $self = shift;
1157 return $self->{isv6} ? 6 : 4;
1158}
1159
1160=item C<-E<gt>cidr()>
1161
1162Returns a scalar with the address and mask in CIDR notation. A
1163NetAddr::IP::Lite object I<stringifies> to the result of this function.
1164(see comments about ->new6() and ->addr() for output formats)
1165
1166=cut
1167
1168
# spent 1.54ms (113µs+1.43) within NetAddr::IP::Lite::cidr which was called 4 times, avg 385µs/call: # 4 times (113µs+1.43ms) by NetAddr::IP::Lite::__ANON__[/usr/local/lib/perl5/site_perl/mach/5.24/NetAddr/IP/Lite.pm:238] at line 238, avg 385µs/call
sub cidr ($) {
11694102µs81.43ms return $_[0]->addr . '/' . $_[0]->masklen;
# spent 1.29ms making 4 calls to NetAddr::IP::Lite::addr, avg 321µs/call # spent 140µs making 4 calls to NetAddr::IP::Lite::masklen, avg 35µs/call
1170}
1171
1172=item C<-E<gt>aton()>
1173
1174Returns the address part of the NetAddr::IP::Lite object in the same format
1175as the C<inet_aton()> or C<ipv6_aton> function respectively. If the object
1176was created using ->new6($ip), the address returned will always be in ipV6
1177format, even for addresses in ipV4 address space.
1178
1179=cut
1180
1181sub aton {
1182 return $_[0]->{addr} if $_[0]->{isv6};
1183 return isIPv4($_[0]->{addr})
1184 ? ipv6to4($_[0]->{addr})
1185 : $_[0]->{addr};
1186}
1187
1188=item C<-E<gt>range()>
1189
1190Returns a scalar with the base address and the broadcast address
1191separated by a dash and spaces. This is called range notation.
1192
1193=cut
1194
1195sub range ($) {
1196 return $_[0]->network->addr . ' - ' . $_[0]->broadcast->addr;
1197}
1198
1199=item C<-E<gt>numeric()>
1200
1201When called in a scalar context, will return a numeric representation
1202of the address part of the IP address. When called in an array
1203context, it returns a list of two elements. The first element is as
1204described, the second element is the numeric representation of the
1205netmask.
1206
1207This method is essential for serializing the representation of a
1208subnet.
1209
1210=cut
1211
1212sub numeric ($) {
1213 if (wantarray) {
1214 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1215 return ( sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))),
1216 sprintf("%u",unpack('N',ipv6to4($_[0]->{mask}))));
1217 }
1218 else {
1219 return ( bin2bcd($_[0]->{addr}),
1220 bin2bcd($_[0]->{mask}));
1221 }
1222 }
1223 return (! $_[0]->{isv6} && isIPv4($_[0]->{addr}))
1224 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1225 : bin2bcd($_[0]->{addr});
1226}
1227
1228=item C<-E<gt>bigint()>
1229
1230When called in a scalar context, will return a Math::BigInt representation
1231of the address part of the IP address. When called in an array
1232contest, it returns a list of two elements. The first element is as
1233described, the second element is the Math::BigInt representation of the
1234netmask.
1235
1236=cut
1237
123812µsmy $biloaded;
1239my $bi2strng;
124012µsmy $no_mbi_emu = 1;
1241
1242# function to force into test development mode
1243#
1244sub _force_bi_emu {
1245 undef $biloaded;
1246 undef $bi2strng;
1247 $no_mbi_emu = 0;
1248 print STDERR "\n\n\tWARNING: test development mode, this
1249\tmessage SHOULD NEVER BE SEEN IN PRODUCTION!
1250set my \$no_mbi_emu = 1 in t/bigint.t to remove this warning\n\n";
1251}
1252
1253# function to stringify various flavors of Math::BigInt objects
1254# tests to see if the object is a hash or a signed scalar
1255
1256sub _bi_stfy {
1257 "$_[0]" =~ /(\d+)/; # stringify and remove '+' if present
1258 $1;
1259}
1260
1261sub _fakebi2strg {
1262 ${$_[0]} =~ /(\d+)/;
1263 $1;
1264}
1265
1266# fake new from bi string Math::BigInt 0.01
1267#
1268sub _bi_fake {
1269 bless \('+'. $_[1]), 'Math::BigInt';
1270}
1271
1272# as of this writing there are three known flavors of Math::BigInt
1273# v0.01 MBI::new returns a scalar ref
1274# v1.?? - 1.69 CALC::_new takes a reference to a scalar, returns an array, MBI returns a hash ref
1275# v1.70 and up CALC::_new takes a scalar, returns and array, MBI returns a hash ref
1276
1277sub _loadMBI { # load Math::BigInt on demand
1278 if (eval {$no_mbi_emu && require Math::BigInt}) { # any version should work, three known
1279 import Math::BigInt;
1280 $biloaded = \&Math::BigInt::new;
1281 $bi2strng = \&_bi_stfy;
1282 } else {
1283 $biloaded = \&_bi_fake;
1284 $bi2strng = \&_fakebi2strg;
1285 }
1286}
1287
1288sub _retMBIstring {
1289 _loadMBI unless $biloaded; # load Math::BigInt on demand
1290 $bi2strng->(@_);
1291}
1292
1293sub _biRef {
1294 _loadMBI unless $biloaded; # load Math::BigInt on demand
1295 $biloaded->('Math::BigInt',$_[0]);
1296}
1297
1298sub bigint($) {
1299 my($addr,$mask);
1300 if (wantarray) {
1301 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1302 $addr = $_[0]->{addr}
1303 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1304 : 0;
1305 $mask = $_[0]->{mask}
1306 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{mask})))
1307 : 0;
1308 }
1309 else {
1310 $addr = $_[0]->{addr}
1311 ? bin2bcd($_[0]->{addr})
1312 : 0;
1313 $mask = $_[0]->{mask}
1314 ? bin2bcd($_[0]->{mask})
1315 : 0;
1316 }
1317 (_biRef($addr),_biRef($mask));
1318
1319 } else { # not wantarray
1320
1321 if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
1322 $addr = $_[0]->{addr}
1323 ? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr})))
1324 : 0;
1325 } else {
1326 $addr = $_[0]->{addr}
1327 ? bin2bcd($_[0]->{addr})
1328 : 0;
1329 }
1330 _biRef($addr);
1331 }
1332}
1333
1334=item C<$me-E<gt>contains($other)>
1335
1336Returns true when C<$me> completely contains C<$other>. False is
1337returned otherwise and C<undef> is returned if C<$me> and C<$other>
1338are not both C<NetAddr::IP::Lite> objects.
1339
1340=cut
1341
1342
# spent 144µs (25+119) within NetAddr::IP::Lite::contains which was called 2 times, avg 72µs/call: # 2 times (25µs+119µs) by Mail::SpamAssassin::NetSet::_nets_contains_network at line 229 of Mail/SpamAssassin/NetSet.pm, avg 72µs/call
sub contains ($$) {
1343224µs2119µs return within(@_[1,0]);
# spent 119µs making 2 calls to NetAddr::IP::Lite::within, avg 59µs/call
1344}
1345
1346=item C<$me-E<gt>within($other)>
1347
1348The complement of C<-E<gt>contains()>. Returns true when C<$me> is
1349completely contained within C<$other>, undef if C<$me> and C<$other>
1350are not both C<NetAddr::IP::Lite> objects.
1351
1352=cut
1353
1354
# spent 119µs (89+29) within NetAddr::IP::Lite::within which was called 2 times, avg 59µs/call: # 2 times (89µs+29µs) by NetAddr::IP::Lite::contains at line 1343, avg 59µs/call
sub within ($$) {
1355246µs222µs return 1 unless hasbits($_[1]->{mask}); # 0x0 contains everything
# spent 22µs making 2 calls to NetAddr::IP::Util::hasbits, avg 11µs/call
135628µs my $netme = $_[0]->{addr} & $_[0]->{mask};
1357210µs my $brdme = $_[0]->{addr} | ~ $_[0]->{mask};
135827µs my $neto = $_[1]->{addr} & $_[1]->{mask};
135927µs my $brdo = $_[1]->{addr} | ~ $_[1]->{mask};
1360244µs27µs return (sub128($netme,$neto) && sub128($brdo,$brdme))
# spent 7µs making 2 calls to NetAddr::IP::Util::sub128, avg 4µs/call
1361 ? 1 : 0;
1362}
1363
1364=item C-E<gt>is_rfc1918()>
1365
1366Returns true when C<$me> is an RFC 1918 address.
1367
1368 10.0.0.0 - 10.255.255.255 (10/8 prefix)
1369 172.16.0.0 - 172.31.255.255 (172.16/12 prefix)
1370 192.168.0.0 - 192.168.255.255 (192.168/16 prefix)
1371
1372=cut
1373
1374111µs111µsmy $ip_10 = NetAddr::IP::Lite->new('10.0.0.0/8');
# spent 11µs making 1 call to NetAddr::IP::Lite::new
1375164µsmy $ip_10n = $ip_10->{addr}; # already the right value
137617µsmy $ip_10b = $ip_10n | ~ $ip_10->{mask};
1377
137817µs17µsmy $ip_172 = NetAddr::IP::Lite->new('172.16.0.0/12');
# spent 7µs making 1 call to NetAddr::IP::Lite::new
137912µsmy $ip_172n = $ip_172->{addr}; # already the right value
138014µsmy $ip_172b = $ip_172n | ~ $ip_172->{mask};
1381
138216µs17µsmy $ip_192 = NetAddr::IP::Lite->new('192.168.0.0/16');
# spent 7µs making 1 call to NetAddr::IP::Lite::new
138313µsmy $ip_192n = $ip_192->{addr}; # already the right value
1384110µsmy $ip_192b = $ip_192n | ~ $ip_192->{mask};
1385
1386sub is_rfc1918 ($) {
1387 my $netme = $_[0]->{addr} & $_[0]->{mask};
1388 my $brdme = $_[0]->{addr} | ~ $_[0]->{mask};
1389 return 1 if (sub128($netme,$ip_10n) && sub128($ip_10b,$brdme));
1390 return 1 if (sub128($netme,$ip_192n) && sub128($ip_192b,$brdme));
1391 return (sub128($netme,$ip_172n) && sub128($ip_172b,$brdme))
1392 ? 1 : 0;
1393}
1394
1395=item C<-E<gt>is_local()>
1396
1397Returns true when C<$me> is a local network address.
1398
1399 i.e. ipV4 127.0.0.0 - 127.255.255.255
1400 or ipV6 === ::1
1401
1402=cut
1403
140416µs17µsmy $_lclhost6 = NetAddr::IP::Lite->new('::1');
# spent 7µs making 1 call to NetAddr::IP::Lite::new
140516µs17µsmy $_lclnet = NetAddr::IP::Lite->new('127/8');
# spent 7µs making 1 call to NetAddr::IP::Lite::new
1406
1407sub is_local ($) {
1408 return ($_[0]->{isv6})
1409 ? $_[0] == $_lclhost6
1410 : $_[0]->within($_lclnet);
1411}
1412
1413=item C<-E<gt>first()>
1414
1415Returns a new object representing the first usable IP address within
1416the subnet (ie, the first host address).
1417
1418=cut
1419
142012µs112µsmy $_cidr127 = pack('N4',0xffffffff,0xffffffff,0xffffffff,0xfffffffe);
# spent 12µs making 1 call to main::CORE:pack
1421
1422sub first ($) {
1423 if (hasbits($_[0]->{mask} ^ $_cidr127)) {
1424 return $_[0]->network + 1;
1425 } else {
1426 return $_[0]->network;
1427 }
1428# return $_[0]->network + 1;
1429}
1430
1431=item C<-E<gt>last()>
1432
1433Returns a new object representing the last usable IP address within
1434the subnet (ie, one less than the broadcast address).
1435
1436=cut
1437
1438sub last ($) {
1439 if (hasbits($_[0]->{mask} ^ $_cidr127)) {
1440 return $_[0]->broadcast - 1;
1441 } else {
1442 return $_[0]->broadcast;
1443 }
1444# return $_[0]->broadcast - 1;
1445}
1446
1447=item C<-E<gt>nth($index)>
1448
1449Returns a new object representing the I<n>-th usable IP address within
1450the subnet (ie, the I<n>-th host address). If no address is available
1451(for example, when the network is too small for C<$index> hosts),
1452C<undef> is returned.
1453
1454Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements
1455C<-E<gt>nth($index)> and C<-E<gt>num()> exactly as the documentation states.
1456Previous versions behaved slightly differently and not in a consistent
1457manner.
1458
1459To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
1460
1461 use NetAddr::IP::Lite qw(:old_nth);
1462
1463 old behavior:
1464 NetAddr::IP->new('10/32')->nth(0) == undef
1465 NetAddr::IP->new('10/32')->nth(1) == undef
1466 NetAddr::IP->new('10/31')->nth(0) == undef
1467 NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31
1468 NetAddr::IP->new('10/30')->nth(0) == undef
1469 NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30
1470 NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30
1471 NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30
1472
1473Note that in each case, the broadcast address is represented in the
1474output set and that the 'zero'th index is alway undef except for
1475a point-to-point /31 or /127 network where there are exactly two
1476addresses in the network.
1477
1478 new behavior:
1479 NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32
1480 NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32
1481 NetAddr::IP->new('10/31')->nth(0) == 10.0.0.0/32
1482 NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/32
1483 NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30
1484 NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30
1485 NetAddr::IP->new('10/30')->nth(2) == undef
1486
1487Note that a /32 net always has 1 usable address while a /31 has exactly
1488two usable addresses for point-to-point addressing. The first
1489index (0) returns the address immediately following the network address
1490except for a /31 or /127 when it return the network address.
1491
1492=cut
1493
1494sub nth ($$) {
1495 my $self = shift;
1496 my $count = shift;
1497
1498 my $slash31 = ! hasbits($self->{mask} ^ $_cidr127);
1499 if ($Old_nth) {
1500 return undef if $slash31 && $count != 1;
1501 return undef if ($count < 1 or $count > $self->num ());
1502 }
1503 elsif ($slash31) {
1504 return undef if ($count && $count != 1); # only index 0, 1 allowed for /31
1505 } else {
1506 ++$count;
1507 return undef if ($count < 1 or $count > $self->num ());
1508 }
1509 return $self->network + $count;
1510}
1511
1512=item C<-E<gt>num()>
1513
1514As of version 4.42 of NetAddr::IP and version 1.27 of NetAddr::IP::Lite
1515a /31 and /127 with return a net B<num> value of 2 instead of 0 (zero)
1516for point-to-point networks.
1517
1518Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite
1519return the number of usable IP addresses within the subnet,
1520not counting the broadcast or network address.
1521
1522Previous versions worked only for ipV4 addresses, returned a
1523maximum span of 2**32 and returned the number of IP addresses
1524not counting the broadcast address.
1525 (one greater than the new behavior)
1526
1527To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
1528
1529 use NetAddr::IP::Lite qw(:old_nth);
1530
1531WARNING:
1532
1533NetAddr::IP will calculate and return a numeric string for network
1534ranges as large as 2**128. These values are TEXT strings and perl
1535can treat them as integers for numeric calculations.
1536
1537Perl on 32 bit platforms only handles integer numbers up to 2**32
1538and on 64 bit platforms to 2**64.
1539
1540If you wish to manipulate numeric strings returned by NetAddr::IP
1541that are larger than 2**32 or 2**64, respectively, you must load
1542additional modules such as Math::BigInt, bignum or some similar
1543package to do the integer math.
1544
1545=cut
1546
1547sub num ($) {
1548 if ($Old_nth) {
1549 my @net = unpack('L3N',$_[0]->{mask} ^ Ones);
1550# number of ip's less broadcast
1551 return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1
1552 return $net[3] if $net[3];
1553 } else { # returns 1 for /32 /128, 2 for /31 /127 else n-2 up to 2**32
1554 (undef, my $net) = addconst($_[0]->{mask},1);
1555 return 1 unless hasbits($net); # ipV4/32 or ipV6/128
1556 $net = $net ^ Ones;
1557 return 2 unless hasbits($net); # ipV4/31 or ipV6/127
1558 $net &= $_v4net unless $_[0]->{isv6};
1559 return bin2bcd($net);
1560 }
1561}
1562
1563# deprecated
1564#sub num ($) {
1565# my @net = unpack('L3N',$_[0]->{mask} ^ Ones);
1566# if ($Old_nth) {
1567## number of ip's less broadcast
1568# return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1
1569# return $net[3] if $net[3];
1570# } else { # returns 1 for /32 /128, 0 for /31 /127 else n-2 up to 2**32
1571## number of usable IP's === number of ip's less broadcast & network addys
1572# return 0xfffffffd if $net[0] || $net[1] || $net[2]; # 2**32 -2
1573# return 1 unless $net[3];
1574# $net[3]--;
1575# }
1576# return $net[3];
1577#}
1578
1579=pod
1580
1581=back
1582
1583=cut
1584
1585
# spent 832µs (214+617) within NetAddr::IP::Lite::import which was called: # once (214µs+617µs) by NetAddr::IP::BEGIN@8 at line 8 of NetAddr/IP.pm
sub import {
1586748µs if (grep { $_ eq ':aton' } @_) {
1587 $Accept_Binary_IP = 1;
1588 @_ = grep { $_ ne ':aton' } @_;
1589 }
1590734µs if (grep { $_ eq ':old_nth' } @_) {
1591 $Old_nth = 1;
1592 @_ = grep { $_ ne ':old_nth' } @_;
1593 }
1594740µs if (grep { $_ eq ':lower' } @_)
1595 {
1596 NetAddr::IP::Util::lower();
1597 @_ = grep { $_ ne ':lower' } @_;
1598 }
1599732µs if (grep { $_ eq ':upper' } @_)
1600 {
1601 NetAddr::IP::Util::upper();
1602 @_ = grep { $_ ne ':upper' } @_;
1603 }
1604724µs if (grep { $_ eq ':nofqdn' } @_)
1605 {
1606 $NoFQDN = 1;
1607 @_ = grep { $_ ne ':nofqdn' } @_;
1608 }
1609127µs168µs NetAddr::IP::Lite->export_to_level(1, @_);
# spent 68µs making 1 call to Exporter::export_to_level
1610}
1611
1612=head1 EXPORT_OK
1613
1614 Zeros
1615 Ones
1616 V4mask
1617 V4net
1618 :aton DEPRECATED
1619 :old_nth
1620 :upper
1621 :lower
1622 :nofqdn
1623
1624=head1 AUTHORS
1625
1626Luis E. Muñoz E<lt>luismunoz@cpan.orgE<gt>,
1627Michael Robinton E<lt>michael@bizsystems.comE<gt>
1628
1629=head1 WARRANTY
1630
1631This software comes with the same warranty as perl itself (ie, none),
1632so by using it you accept any and all the liability.
1633
1634=head1 COPYRIGHT
1635
1636 This software is (c) Luis E. Muñoz, 1999 - 2005
1637 and (c) Michael Robinton, 2006 - 2014.
1638
1639All rights reserved.
1640
1641This program is free software; you can redistribute it and/or modify
1642it under the terms of either:
1643
1644 a) the GNU General Public License as published by the Free
1645 Software Foundation; either version 2, or (at your option) any
1646 later version, or
1647
1648 b) the "Artistic License" which comes with this distribution.
1649
1650This program is distributed in the hope that it will be useful,
1651but WITHOUT ANY WARRANTY; without even the implied warranty of
1652MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
1653the GNU General Public License or the Artistic License for more details.
1654
1655You should have received a copy of the Artistic License with this
1656distribution, in the file named "Artistic". If not, I'll be glad to provide
1657one.
1658
1659You should also have received a copy of the GNU General Public License
1660along with this program in the file named "Copying". If not, write to the
1661
1662 Free Software Foundation, Inc.,
1663 51 Franklin Street, Fifth Floor
1664 Boston, MA 02110-1301 USA
1665
1666or visit their web page on the internet at:
1667
1668 http://www.gnu.org/copyleft/gpl.html.
1669
1670=head1 SEE ALSO
1671
1672NetAddr::IP(3), NetAddr::IP::Util(3), NetAddr::IP::InetBase(3)
1673
1674=cut
1675
1676188µs1;
 
# spent 520µs within NetAddr::IP::Lite::CORE:match which was called 117 times, avg 4µs/call: # 47 times (251µs+0s) by NetAddr::IP::Lite::_xnew at line 781, avg 5µs/call # 28 times (77µs+0s) by NetAddr::IP::Lite::_xnew at line 850, avg 3µs/call # 19 times (90µs+0s) by NetAddr::IP::Lite::_xnew at line 834, avg 5µs/call # 9 times (40µs+0s) by NetAddr::IP::Lite::_xnew at line 922, avg 4µs/call # 9 times (22µs+0s) by NetAddr::IP::Lite::_xnew at line 1044, avg 2µs/call # 4 times (16µs+0s) by NetAddr::IP::Lite::_xnew at line 855, avg 4µs/call # once (23µs+0s) by NetAddr::IP::BEGIN@8 at line 35
sub NetAddr::IP::Lite::CORE:match; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.