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