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