line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package NetAddr::IP::Lite; |
4
|
|
|
|
|
|
|
|
5
|
31
|
|
|
31
|
|
180
|
use Carp; |
|
31
|
|
|
|
|
59
|
|
|
31
|
|
|
|
|
2227
|
|
6
|
31
|
|
|
31
|
|
161
|
use strict; |
|
31
|
|
|
|
|
52
|
|
|
31
|
|
|
|
|
1172
|
|
7
|
|
|
|
|
|
|
#use diagnostics; |
8
|
|
|
|
|
|
|
#use warnings; |
9
|
31
|
|
|
|
|
255
|
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
|
31
|
|
|
31
|
|
35006
|
); |
|
31
|
|
|
|
|
376
|
|
18
|
31
|
|
|
|
|
178
|
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
|
31
|
|
|
31
|
|
25455
|
); |
|
31
|
|
|
|
|
106
|
|
32
|
|
|
|
|
|
|
|
33
|
31
|
|
|
31
|
|
181
|
use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $NoFQDN $AUTOLOAD *Zero); |
|
31
|
|
|
|
|
127
|
|
|
31
|
|
|
|
|
9329
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
$VERSION = do { my @r = (q$Revision: 1.54 $ =~ /\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
|
|
|
0
|
|
0
|
sub DESTROY {}; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub AUTOLOAD { |
174
|
31
|
|
|
31
|
|
182
|
no strict; |
|
31
|
|
|
|
|
59
|
|
|
31
|
|
|
|
|
38053
|
|
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
|
281
|
|
|
281
|
0
|
1452
|
return $_zero; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
sub Ones() { |
212
|
8866
|
|
|
8866
|
0
|
38955
|
return $_ones; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
sub V4mask() { |
215
|
3
|
|
|
3
|
0
|
56
|
return $_v4mask; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
sub V4net() { |
218
|
336
|
|
|
336
|
0
|
816
|
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
|
22259
|
|
|
22259
|
|
92501
|
'""' => sub { $_[0]->cidr(); }, |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
'eq' => sub { |
241
|
533
|
50
|
|
533
|
|
8693
|
my $a = (UNIVERSAL::isa($_[0],__PACKAGE__)) ? $_[0]->cidr : $_[0]; |
242
|
533
|
100
|
|
|
|
3024
|
my $b = (UNIVERSAL::isa($_[1],__PACKAGE__)) ? $_[1]->cidr : $_[1]; |
243
|
533
|
|
|
|
|
1877
|
$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
|
|
51
|
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
|
|
125
|
return &comp_addr_mask > 0 ? 1 : 0; |
264
|
|
|
|
|
|
|
}, |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
'<' => sub { |
267
|
8464
|
100
|
|
8464
|
|
18999
|
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
|
31
|
|
|
|
|
1036
|
'<=>' => \&comp_addr_mask, |
279
|
|
|
|
|
|
|
|
280
|
31
|
|
|
31
|
|
39671
|
'cmp' => \&comp_addr_mask; |
|
31
|
|
|
|
|
21612
|
|
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub comp_addr_mask { |
283
|
68742
|
|
|
68742
|
0
|
282421
|
my($c,$rv) = sub128($_[0]->{addr},$_[1]->{addr}); |
284
|
68742
|
100
|
|
|
|
232447
|
return -1 unless $c; |
285
|
3621
|
100
|
|
|
|
13637
|
return 1 if hasbits($rv); |
286
|
199
|
|
|
|
|
965
|
($c,$rv) = sub128($_[0]->{mask},$_[1]->{mask}); |
287
|
199
|
100
|
|
|
|
6911
|
return -1 unless $c; |
288
|
167
|
100
|
|
|
|
930
|
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
|
153805
|
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
|
1414
|
my $ip = shift; |
386
|
24
|
|
|
|
|
28
|
my $const = shift; |
387
|
|
|
|
|
|
|
|
388
|
24
|
50
|
66
|
|
|
172
|
return $ip unless $const && |
|
|
|
66
|
|
|
|
|
389
|
|
|
|
|
|
|
$const < 2147483648 && |
390
|
|
|
|
|
|
|
$const > -2147483649; |
391
|
|
|
|
|
|
|
|
392
|
23
|
|
|
|
|
40
|
my $a = $ip->{addr}; |
393
|
23
|
|
|
|
|
40
|
my $m = $ip->{mask}; |
394
|
|
|
|
|
|
|
|
395
|
23
|
|
|
|
|
46
|
my $lo = $a & ~$m; |
396
|
23
|
|
|
|
|
36
|
my $hi = $a & $m; |
397
|
|
|
|
|
|
|
|
398
|
23
|
|
|
|
|
105
|
my $new = ((addconst($lo,$const))[1] & ~$m) | $hi; |
399
|
|
|
|
|
|
|
|
400
|
23
|
|
|
|
|
50
|
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
|
|
|
|
|
5
|
my $arg = shift; |
421
|
3
|
50
|
|
|
|
9
|
unless (ref $arg) { |
422
|
3
|
|
|
|
|
9
|
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
|
3876482
|
my $ip = shift; |
446
|
|
|
|
|
|
|
|
447
|
8333
|
|
|
|
|
25239
|
my $a = $ip->{addr}; |
448
|
8333
|
|
|
|
|
19208
|
my $m = $ip->{mask}; |
449
|
|
|
|
|
|
|
|
450
|
8333
|
|
|
|
|
19815
|
my $lo = $a & ~ $m; |
451
|
8333
|
|
|
|
|
11588
|
my $hi = $a & $m; |
452
|
|
|
|
|
|
|
|
453
|
8333
|
|
|
|
|
43608
|
$ip->{addr} = ((addconst($lo,1))[1] & ~ $m) | $hi; |
454
|
8333
|
|
|
|
|
63425
|
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
|
|
235252
|
my $proto = shift; |
494
|
150298
|
|
50
|
|
|
352138
|
my $class = ref($proto) || die "reference required"; |
495
|
150298
|
|
|
|
|
266337
|
$proto = $proto->{isv6}; |
496
|
150298
|
|
|
|
|
514744
|
my $self = { |
497
|
|
|
|
|
|
|
addr => $_[0], |
498
|
|
|
|
|
|
|
mask => $_[1], |
499
|
|
|
|
|
|
|
isv6 => $proto, |
500
|
|
|
|
|
|
|
}; |
501
|
150298
|
|
|
|
|
4219670
|
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
|
|
13
|
my($lo,$hi) = @_; |
689
|
|
|
|
|
|
|
|
690
|
5
|
50
|
|
|
|
14
|
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
|
7367
|
|
|
7367
|
1
|
131697
|
unshift @_, 0; |
701
|
7367
|
|
|
|
|
18603
|
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
|
|
|
0
|
|
0
|
$_[0] =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/; |
750
|
0
|
|
|
|
|
0
|
return sprintf("%d.%d.%d.%d",$1,$2,$3,$4); |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
sub _xnew($$;$$) { |
754
|
7367
|
|
|
7367
|
|
8304
|
my $noctal = 0; |
755
|
7367
|
|
|
|
|
10105
|
my $isV6 = shift; |
756
|
7367
|
50
|
|
|
|
16418
|
if ($isV6 < 0) { # flag for no octal? |
757
|
0
|
|
|
|
|
0
|
$isV6 = 0; |
758
|
0
|
|
|
|
|
0
|
$noctal = 1; |
759
|
|
|
|
|
|
|
} |
760
|
7367
|
|
|
|
|
8797
|
my $proto = shift; |
761
|
7367
|
|
50
|
|
|
31037
|
my $class = ref $proto || $proto || __PACKAGE__; |
762
|
7367
|
|
|
|
|
9593
|
my $ip = shift; |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
# fix for bug #75976 |
765
|
7367
|
50
|
33
|
|
|
34463
|
return undef if defined $ip && $ip eq ''; |
766
|
|
|
|
|
|
|
|
767
|
7367
|
50
|
|
|
|
13718
|
$ip = 'default' unless defined $ip; |
768
|
7367
|
50
|
33
|
|
|
22462
|
$ip = _retMBIstring($ip) # treat as big bcd string |
769
|
|
|
|
|
|
|
if ref $ip && ref $ip eq 'Math::BigInt'; # can /CIDR notation |
770
|
7367
|
|
|
|
|
8035
|
my $hasmask = 1; |
771
|
7367
|
|
|
|
|
6892
|
my($mask,$tmp); |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# IP to lower case AFTER ref test for Math::BigInt. 'lc' strips blessing |
774
|
|
|
|
|
|
|
|
775
|
7367
|
|
|
|
|
12313
|
$ip = lc $ip; |
776
|
|
|
|
|
|
|
|
777
|
7367
|
|
|
|
|
7632
|
while (1) { |
778
|
|
|
|
|
|
|
# process IP's with no CIDR or that have the CIDR as part of the IP argument string |
779
|
7367
|
100
|
|
|
|
14424
|
unless (@_) { |
|
|
50
|
|
|
|
|
|
780
|
|
|
|
|
|
|
# if ($ip =~ m!^(.+)/(.+)$!) { |
781
|
6829
|
50
|
66
|
|
|
50540
|
if ($ip !~ /\D/) { # binary number notation |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
782
|
0
|
|
|
|
|
0
|
$ip = bcd2bin($ip); |
783
|
0
|
|
|
|
|
0
|
$mask = Ones; |
784
|
0
|
|
|
|
|
0
|
last; |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
elsif ($ip =~ m!^([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)$! || |
787
|
|
|
|
|
|
|
$ip =~ m!^[\[]{1}([a-z0-9.:-]+)(?:/|\s+)([a-z0-9.:-]+)[\]]{1}$!) { |
788
|
5839
|
|
|
|
|
10394
|
$ip = $1; |
789
|
5839
|
|
|
|
|
11210
|
$mask = $2; |
790
|
|
|
|
|
|
|
} elsif (grep($ip eq $_,(qw(default any broadcast loopback unspecified)))) { |
791
|
9
|
50
|
|
|
|
25
|
$isV6 = 1 if $ip eq 'unspecified'; |
792
|
9
|
50
|
|
|
|
22
|
if ($isV6) { |
793
|
0
|
|
|
|
|
0
|
$mask = $fip6m{$ip}; |
794
|
0
|
0
|
|
|
|
0
|
return undef unless defined ($ip = $fip6{$ip}); |
795
|
|
|
|
|
|
|
} else { |
796
|
9
|
|
|
|
|
20
|
$mask = $fip4m{$ip}; |
797
|
9
|
50
|
|
|
|
31
|
return undef unless defined ($ip = $fip4{$ip}); |
798
|
|
|
|
|
|
|
} |
799
|
9
|
|
|
|
|
14
|
last; |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
# process "ipv6" token and default IP's |
803
|
|
|
|
|
|
|
elsif (defined $_[0]) { |
804
|
538
|
50
|
33
|
|
|
2197
|
if ($_[0] =~ /ipv6/i || $isV6) { |
805
|
0
|
0
|
|
|
|
0
|
if (grep($ip eq $_,(qw(default any loopback unspecified)))) { |
806
|
0
|
|
|
|
|
0
|
$mask = $fip6m{$ip}; |
807
|
0
|
|
|
|
|
0
|
$ip = $fip6{$ip}; |
808
|
0
|
|
|
|
|
0
|
last; |
809
|
|
|
|
|
|
|
} else { |
810
|
0
|
0
|
|
|
|
0
|
return undef unless $isV6; |
811
|
|
|
|
|
|
|
# add for ipv6 notation "12345, 1" |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
# $mask = lc $_[0]; |
814
|
|
|
|
|
|
|
# } else { |
815
|
|
|
|
|
|
|
# $mask = lc $_[0]; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
# extract mask |
818
|
538
|
|
|
|
|
950
|
$mask = $_[0]; |
819
|
|
|
|
|
|
|
} |
820
|
|
|
|
|
|
|
### |
821
|
|
|
|
|
|
|
### process mask |
822
|
7358
|
100
|
|
|
|
13749
|
unless (defined $mask) { |
823
|
981
|
|
|
|
|
1192
|
$hasmask = 0; |
824
|
981
|
|
|
|
|
1303
|
$mask = 'host'; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
# two kinds of IP's can turn on the isV6 flag |
828
|
|
|
|
|
|
|
# 1) big digits that are over the IPv4 boundry |
829
|
|
|
|
|
|
|
# 2) IPv6 IP syntax |
830
|
|
|
|
|
|
|
# |
831
|
|
|
|
|
|
|
# check these conditions and set isV6 as appropriate |
832
|
|
|
|
|
|
|
# |
833
|
7358
|
|
|
|
|
7152
|
my $try; |
834
|
7358
|
100
|
0
|
|
|
69454
|
$isV6 = 1 if # check big bcd and IPv6 rfc1884 |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
33
|
|
|
|
|
835
|
|
|
|
|
|
|
( $ip !~ /\D/ && # ip is all decimal |
836
|
|
|
|
|
|
|
(length($ip) > 3 || $ip > 255) && # exclude a single digit in the range of zero to 255, could be funny IPv4 |
837
|
|
|
|
|
|
|
($try = bcd2bin($ip)) && ! isIPv4($try)) || # precedence so $try is not corrupted |
838
|
|
|
|
|
|
|
(index($ip,':') >= 0 && ($try = ipv6_aton($ip))); # fails if not an rfc1884 address |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
# if either of the above conditions is true, $try contains the NetAddr 128 bit address |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
# checkfor Math::BigInt mask |
843
|
7358
|
50
|
33
|
|
|
52021
|
$mask = _retMBIstring($mask) # treat as big bcd string |
844
|
|
|
|
|
|
|
if ref $mask && ref $mask eq 'Math::BigInt'; |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# MASK to lower case AFTER ref test for Math::BigInt, 'lc' strips blessing |
847
|
|
|
|
|
|
|
|
848
|
7358
|
|
|
|
|
10308
|
$mask = lc $mask; |
849
|
|
|
|
|
|
|
|
850
|
7358
|
100
|
|
|
|
22388
|
if ($mask !~ /\D/) { # bcd or CIDR notation |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
851
|
6364
|
|
33
|
|
|
24558
|
my $isCIDR = length($mask) < 4 && $mask < 129; |
852
|
6364
|
100
|
33
|
|
|
29943
|
if ($isV6) { |
|
|
50
|
|
|
|
|
|
853
|
169
|
50
|
|
|
|
270
|
if ($isCIDR) { |
854
|
169
|
|
|
|
|
180
|
my($dq1,$dq2,$dq3,$dq4); |
855
|
169
|
50
|
33
|
|
|
822
|
if ($ip =~ /^(\d+)(?:|\.(\d+)(?:|\.(\d+)(?:|\.(\d+))))$/ && |
|
0
|
100
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
856
|
|
|
|
|
|
|
do {$dq1 = $1; |
857
|
0
|
|
0
|
|
|
0
|
$dq2 = $2 || 0; |
858
|
0
|
|
0
|
|
|
0
|
$dq3 = $3 || 0; |
859
|
0
|
|
0
|
|
|
0
|
$dq4 = $4 || 0; |
860
|
0
|
|
|
|
|
0
|
1; |
861
|
|
|
|
|
|
|
} && |
862
|
|
|
|
|
|
|
$dq1 >= 0 && $dq1 < 256 && |
863
|
|
|
|
|
|
|
$dq2 >= 0 && $dq2 < 256 && |
864
|
|
|
|
|
|
|
$dq3 >= 0 && $dq3 < 256 && |
865
|
|
|
|
|
|
|
$dq4 >= 0 && $dq4 < 256 |
866
|
|
|
|
|
|
|
) { # corner condition of IPv4 with isV6 |
867
|
0
|
|
|
|
|
0
|
$ip = join('.',$dq1,$dq2,$dq3,$dq4); |
868
|
0
|
|
|
|
|
0
|
$try = ipv4to6(inet_aton($ip)); |
869
|
0
|
0
|
|
|
|
0
|
if ($mask < 32) { |
|
|
0
|
|
|
|
|
|
870
|
0
|
|
|
|
|
0
|
$mask = shiftleft(Ones,32 -$mask); |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
elsif ($mask == 32) { |
873
|
0
|
|
|
|
|
0
|
$mask = Ones; |
874
|
|
|
|
|
|
|
} else { |
875
|
0
|
|
|
|
|
0
|
return undef; # undoubtably an error |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
elsif ($mask < 128) { |
879
|
165
|
|
|
|
|
285
|
$mask = shiftleft(Ones,128 -$mask); # small cidr |
880
|
|
|
|
|
|
|
} else { |
881
|
4
|
|
|
|
|
10
|
$mask = Ones(); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
} else { |
884
|
0
|
|
|
|
|
0
|
$mask = bcd2bin($mask); |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
elsif ($isCIDR && $mask < 33) { # is V4 |
888
|
6195
|
100
|
|
|
|
11365
|
if ($mask < 32) { |
|
|
50
|
|
|
|
|
|
889
|
6165
|
|
|
|
|
10516
|
$mask = shiftleft(Ones,32 -$mask); |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
elsif ( $mask == 32) { |
892
|
30
|
|
|
|
|
93
|
$mask = Ones; |
893
|
|
|
|
|
|
|
} else { |
894
|
0
|
|
|
|
|
0
|
$mask = bcd2bin($mask); |
895
|
0
|
|
|
|
|
0
|
$mask |= $_v4mask; # v4 always |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
} else { # also V4 |
898
|
0
|
|
|
|
|
0
|
$mask = bcd2bin($mask); |
899
|
0
|
|
|
|
|
0
|
$mask |= $_v4mask; |
900
|
|
|
|
|
|
|
} |
901
|
6364
|
100
|
|
|
|
15191
|
if ($try) { # is a big number |
902
|
169
|
|
|
|
|
203
|
$ip = $try; |
903
|
169
|
|
|
|
|
302
|
last; |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
} elsif ($mask =~ m/^\d+\.\d+\.\d+\.\d+$/) { # ipv4 form of mask |
906
|
9
|
50
|
|
|
|
25
|
$mask = _no_octal($mask) if $noctal; # filter for octal |
907
|
9
|
50
|
|
|
|
39
|
return undef unless defined ($mask = inet_aton($mask)); |
908
|
9
|
|
|
|
|
45
|
$mask = mask4to6($mask); |
909
|
|
|
|
|
|
|
} elsif (grep($mask eq $_,qw(default any broadcast loopback unspecified host))) { |
910
|
981
|
100
|
66
|
|
|
4000
|
if (index($ip,':') < 0 && ! $isV6) { |
911
|
799
|
50
|
|
|
|
2063
|
return undef unless defined ($mask = $fip4m{$mask}); |
912
|
|
|
|
|
|
|
} else { |
913
|
182
|
50
|
|
|
|
1187
|
return undef unless defined ($mask = $fip6m{$mask}); |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
} else { |
916
|
4
|
100
|
|
|
|
123
|
return undef unless defined ($mask = ipv6_aton($mask)); # try ipv6 form of mask |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
# process remaining IP's |
920
|
|
|
|
|
|
|
|
921
|
7187
|
100
|
|
|
|
13964
|
if (index($ip,':') < 0) { # ipv4 address |
922
|
7003
|
100
|
33
|
|
|
32638
|
if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { |
|
|
50
|
33
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
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
|
|
|
|
|
923
|
|
|
|
|
|
|
; # the common case |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
elsif (grep($ip eq $_,(qw(default any broadcast loopback)))) { |
926
|
0
|
0
|
|
|
|
0
|
return undef unless defined ($ip = $fip4{$ip}); |
927
|
0
|
|
|
|
|
0
|
last; |
928
|
|
|
|
|
|
|
} |
929
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)$/) { |
930
|
4
|
50
|
|
|
|
22
|
$ip = ($hasmask) |
931
|
|
|
|
|
|
|
? "${1}.${2}.0.0" |
932
|
|
|
|
|
|
|
: "${1}.0.0.${2}"; |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)$/) { |
935
|
2
|
50
|
|
|
|
11
|
$ip = ($hasmask) |
936
|
|
|
|
|
|
|
? "${1}.${2}.${3}.0" |
937
|
|
|
|
|
|
|
: "${1}.${2}.0.${3}"; |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
elsif ($ip =~ /^(\d+)$/ && $hasmask && $1 >= 0 and $1 < 256) { # pure numeric |
940
|
0
|
|
|
|
|
0
|
$ip = sprintf("%d.0.0.0",$1); |
941
|
|
|
|
|
|
|
} |
942
|
|
|
|
|
|
|
# elsif ($ip =~ /^\d+$/ && !$hasmask) { # a big integer |
943
|
|
|
|
|
|
|
elsif ($ip =~ /^\d+$/ ) { # a big integer |
944
|
0
|
|
|
|
|
0
|
$ip = bcd2bin($ip); |
945
|
0
|
|
|
|
|
0
|
last; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
# these next three might be broken??? but they have been in the code a long time and no one has complained |
948
|
|
|
|
|
|
|
elsif ($ip =~ /^0[xb]\d+$/ && $hasmask && |
949
|
|
|
|
|
|
|
(($tmp = eval "$ip") || 1) && |
950
|
|
|
|
|
|
|
$tmp >= 0 && $tmp < 256) { |
951
|
0
|
|
|
|
|
0
|
$ip = sprintf("%d.0.0.0",$tmp); |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
elsif ($ip =~ /^-?\d+$/) { |
954
|
0
|
0
|
|
|
|
0
|
$ip += 2 ** 32 if $ip < 0; |
955
|
0
|
|
|
|
|
0
|
$ip = pack('L3N',0,0,0,$ip); |
956
|
0
|
|
|
|
|
0
|
last; |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
elsif ($ip =~ /^-?0[xb]\d+$/) { |
959
|
0
|
|
|
|
|
0
|
$ip = eval "$ip"; |
960
|
0
|
|
|
|
|
0
|
$ip = pack('L3N',0,0,0,$ip); |
961
|
0
|
|
|
|
|
0
|
last; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
# notations below include an implicit mask specification |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.$/) { |
967
|
1
|
|
|
|
|
3
|
$ip = "${1}.0.0.0"; |
968
|
1
|
|
|
|
|
3
|
$mask = $ff000000; |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)-(\d+)\.?$/ && $2 <= $3 && $3 < 256) { |
971
|
0
|
|
|
|
|
0
|
$ip = "${1}.${2}.0.0"; |
972
|
0
|
|
|
|
|
0
|
$mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,_obits($2,$3),0,0); |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)-(\d+)\.?$/ and $1 <= $2 && $2 < 256) { |
975
|
4
|
|
|
|
|
11
|
$ip = "${1}.0.0.0"; |
976
|
4
|
|
|
|
|
12
|
$mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,_obits($1,$2),0,0,0) |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)\.$/) { |
979
|
1
|
|
|
|
|
7
|
$ip = "${1}.${2}.0.0"; |
980
|
1
|
|
|
|
|
3
|
$mask = $ffff0000; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)-(\d+)\.?$/ && $3 <= $4 && $4 < 256) { |
983
|
1
|
|
|
|
|
6
|
$ip = "${1}.${2}.${3}.0"; |
984
|
1
|
|
|
|
|
3
|
$mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,_obits($3,$4),0); |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.$/) { |
987
|
1
|
|
|
|
|
5
|
$ip = "${1}.${2}.${3}.0"; |
988
|
1
|
|
|
|
|
2
|
$mask = $ffffff00; |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)-(\d+)$/ && $4 <= $5 && $5 < 256) { |
991
|
0
|
|
|
|
|
0
|
$ip = "${1}.${2}.${3}.${4}"; |
992
|
0
|
|
|
|
|
0
|
$mask = pack('L3C4',0xffffffff,0xffffffff,0xffffffff,255,255,255,_obits($4,$5)); |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
elsif ($ip =~ m/^(\d+\.\d+\.\d+\.\d+) |
995
|
|
|
|
|
|
|
\s*-\s*(\d+\.\d+\.\d+\.\d+)$/x) { |
996
|
0
|
0
|
|
|
|
0
|
if ($noctal) { |
997
|
0
|
0
|
|
|
|
0
|
return undef unless ($ip = inet_aton(_no_octal($1))); |
998
|
0
|
0
|
|
|
|
0
|
return undef unless ($tmp = inet_aton(_no_octal($2))); |
999
|
|
|
|
|
|
|
} else { |
1000
|
0
|
0
|
|
|
|
0
|
return undef unless ($ip = inet_aton($1)); |
1001
|
0
|
0
|
|
|
|
0
|
return undef unless ($tmp = inet_aton($2)); |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
# check for left side greater than right side |
1004
|
|
|
|
|
|
|
# save numeric difference in $mask |
1005
|
0
|
0
|
|
|
|
0
|
return undef if ($tmp = unpack('N',$tmp) - unpack('N',$ip)) < 0; |
1006
|
0
|
|
|
|
|
0
|
$ip = ipv4to6($ip); |
1007
|
0
|
|
|
|
|
0
|
$tmp = pack('L3N',0,0,0,$tmp); |
1008
|
0
|
|
|
|
|
0
|
$mask = ~$tmp; |
1009
|
0
|
0
|
|
|
|
0
|
return undef if notcontiguous($mask); |
1010
|
|
|
|
|
|
|
# check for non-aligned left side |
1011
|
0
|
0
|
|
|
|
0
|
return undef if hasbits($ip & $tmp); |
1012
|
0
|
|
|
|
|
0
|
last; |
1013
|
|
|
|
|
|
|
} |
1014
|
|
|
|
|
|
|
# check for resolvable IPv4 hosts |
1015
|
|
|
|
|
|
|
elsif (! $NoFQDN && $ip !~ /[^a-zA-Z0-9\._-]/ && ($tmp = gethostbyname(fillIPv4($ip))) && $tmp ne $_v4zero && $tmp ne $_zero ) { |
1016
|
3
|
|
|
|
|
19
|
$ip = ipv4to6($tmp); |
1017
|
3
|
|
|
|
|
11
|
last; |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
# check for resolvable IPv6 hosts |
1020
|
|
|
|
|
|
|
elsif (! $NoFQDN && $ip !~ /[^a-zA-Z0-9\._-]/ && havegethostbyname2() && ($tmp = naip_gethostbyname($ip))) { |
1021
|
0
|
|
|
|
|
0
|
$ip = $tmp; |
1022
|
0
|
|
|
|
|
0
|
$isV6 = 1; |
1023
|
0
|
|
|
|
|
0
|
last; |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
elsif ($Accept_Binary_IP && ! $hasmask) { |
1026
|
0
|
0
|
|
|
|
0
|
if (length($ip) == 4) { |
|
|
0
|
|
|
|
|
|
1027
|
0
|
|
|
|
|
0
|
$ip = ipv4to6($ip); |
1028
|
|
|
|
|
|
|
} elsif (length($ip) == 16) { |
1029
|
0
|
|
|
|
|
0
|
$isV6 = 1; |
1030
|
|
|
|
|
|
|
} else { |
1031
|
0
|
|
|
|
|
0
|
return undef; |
1032
|
|
|
|
|
|
|
} |
1033
|
0
|
|
|
|
|
0
|
last; |
1034
|
|
|
|
|
|
|
} else { |
1035
|
0
|
|
|
|
|
0
|
return undef; |
1036
|
|
|
|
|
|
|
} |
1037
|
7000
|
50
|
|
|
|
18285
|
return undef unless defined ($ip = inet_aton($ip)); |
1038
|
7000
|
|
|
|
|
19230
|
$ip = ipv4to6($ip); |
1039
|
7000
|
|
|
|
|
10191
|
last; |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
########## continuing |
1042
|
|
|
|
|
|
|
else { # ipv6 address |
1043
|
184
|
|
|
|
|
311
|
$isV6 = 1; |
1044
|
184
|
100
|
|
|
|
879
|
$ip = $1 if $ip =~ /\[([^\]]+)\]/; # transform URI notation |
1045
|
184
|
50
|
|
|
|
7055
|
if (defined ($tmp = ipv6_aton($ip))) { |
1046
|
184
|
|
|
|
|
10276
|
$ip = $tmp; |
1047
|
184
|
|
|
|
|
385
|
last; |
1048
|
|
|
|
|
|
|
} |
1049
|
0
|
0
|
0
|
|
|
0
|
last if grep($ip eq $_,(qw(default any loopback unspecified))) && |
1050
|
|
|
|
|
|
|
defined ($ip = $fip6{$ip}); |
1051
|
0
|
|
|
|
|
0
|
return undef; |
1052
|
|
|
|
|
|
|
} |
1053
|
|
|
|
|
|
|
} # end while (1) |
1054
|
7365
|
100
|
|
|
|
22122
|
return undef if notcontiguous($mask); # invalid if not contiguous |
1055
|
|
|
|
|
|
|
|
1056
|
7363
|
|
|
|
|
27581
|
my $self = { |
1057
|
|
|
|
|
|
|
addr => $ip, |
1058
|
|
|
|
|
|
|
mask => $mask, |
1059
|
|
|
|
|
|
|
isv6 => $isV6, |
1060
|
|
|
|
|
|
|
}; |
1061
|
7363
|
|
|
|
|
63283
|
return bless $self, $class; |
1062
|
|
|
|
|
|
|
} |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=item C<-Ebroadcast()> |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
Returns a new object referring to the broadcast address of a given |
1067
|
|
|
|
|
|
|
subnet. The broadcast address has all ones in all the bit positions |
1068
|
|
|
|
|
|
|
where the netmask has zero bits. This is normally used to address all |
1069
|
|
|
|
|
|
|
the hosts in a given subnet. |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
=cut |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
sub broadcast ($) { |
1074
|
8867
|
|
|
8867
|
1
|
44795
|
my $ip = _new($_[0],$_[0]->{addr} | ~$_[0]->{mask},$_[0]->{mask}); |
1075
|
8867
|
100
|
|
|
|
44496
|
$ip->{addr} &= V4net unless $ip->{isv6}; |
1076
|
8867
|
|
|
|
|
29060
|
return $ip; |
1077
|
|
|
|
|
|
|
} |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=item C<-Enetwork()> |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
Returns a new object referring to the network address of a given |
1082
|
|
|
|
|
|
|
subnet. A network address has all zero bits where the bits of the |
1083
|
|
|
|
|
|
|
netmask are zero. Normally this is used to refer to a subnet. |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
=cut |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
sub network ($) { |
1088
|
59403
|
|
|
59403
|
1
|
324361
|
return _new($_[0],$_[0]->{addr} & $_[0]->{mask},$_[0]->{mask}); |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=item C<-Eaddr()> |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
Returns a scalar with the address part of the object as an IPv4 or IPv6 text |
1094
|
|
|
|
|
|
|
string as appropriate. This is useful for printing or for passing the address |
1095
|
|
|
|
|
|
|
part of the NetAddr::IP::Lite object to other components that expect an IP |
1096
|
|
|
|
|
|
|
address. If the object is an ipV6 address or was created using ->new6($ip) |
1097
|
|
|
|
|
|
|
it will be reported in ipV6 hex format otherwise it will be reported in dot |
1098
|
|
|
|
|
|
|
quad format only if it resides in ipV4 address space. |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=cut |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
sub addr ($) { |
1103
|
100645
|
100
|
|
100645
|
1
|
3205802
|
return ($_[0]->{isv6}) |
1104
|
|
|
|
|
|
|
? ipv6_n2x($_[0]->{addr}) |
1105
|
|
|
|
|
|
|
: inet_n2dx($_[0]->{addr}); |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=item C<-Emask()> |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
Returns a scalar with the mask as an IPv4 or IPv6 text string as |
1111
|
|
|
|
|
|
|
described above. |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=cut |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
sub mask ($) { |
1116
|
4
|
50
|
|
4
|
1
|
79
|
return ipv6_n2x($_[0]->{mask}) if $_[0]->{isv6}; |
1117
|
4
|
50
|
|
|
|
21
|
my $mask = isIPv4($_[0]->{addr}) |
1118
|
|
|
|
|
|
|
? $_[0]->{mask} & V4net |
1119
|
|
|
|
|
|
|
: $_[0]->{mask}; |
1120
|
4
|
|
|
|
|
155
|
return inet_n2dx($mask); |
1121
|
|
|
|
|
|
|
} |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=item C<-Emasklen()> |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
Returns a scalar the number of one bits in the mask. |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
=cut |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
sub masklen ($) { |
1130
|
40544
|
|
|
40544
|
1
|
196088
|
my $len = (notcontiguous($_[0]->{mask}))[1]; |
1131
|
40544
|
100
|
|
|
|
90228
|
return 0 unless $len; |
1132
|
40531
|
100
|
|
|
|
170967
|
return $len if $_[0]->{isv6}; |
1133
|
15546
|
50
|
|
|
|
41079
|
return isIPv4($_[0]->{addr}) |
1134
|
|
|
|
|
|
|
? $len -96 |
1135
|
|
|
|
|
|
|
: $len; |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
=item C<-Ebits()> |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Returns the width of the address in bits. Normally 32 for v4 and 128 for v6. |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=cut |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
sub bits { |
1145
|
0
|
0
|
|
0
|
1
|
0
|
return $_[0]->{isv6} ? 128 : 32; |
1146
|
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=item C<-Eversion()> |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
Returns the version of the address or subnet. Currently this can be |
1151
|
|
|
|
|
|
|
either 4 or 6. |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
=cut |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
sub version { |
1156
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1157
|
0
|
0
|
|
|
|
0
|
return $self->{isv6} ? 6 : 4; |
1158
|
|
|
|
|
|
|
} |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=item C<-Ecidr()> |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
Returns a scalar with the address and mask in CIDR notation. A |
1163
|
|
|
|
|
|
|
NetAddr::IP::Lite object I to the result of this function. |
1164
|
|
|
|
|
|
|
(see comments about ->new6() and ->addr() for output formats) |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=cut |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
sub cidr ($) { |
1169
|
22844
|
|
|
22844
|
1
|
76395
|
return $_[0]->addr . '/' . $_[0]->masklen; |
1170
|
|
|
|
|
|
|
} |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=item C<-Eaton()> |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
Returns the address part of the NetAddr::IP::Lite object in the same format |
1175
|
|
|
|
|
|
|
as the C or C function respectively. If the object |
1176
|
|
|
|
|
|
|
was created using ->new6($ip), the address returned will always be in ipV6 |
1177
|
|
|
|
|
|
|
format, even for addresses in ipV4 address space. |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
=cut |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
sub aton { |
1182
|
0
|
0
|
|
0
|
1
|
0
|
return $_[0]->{addr} if $_[0]->{isv6}; |
1183
|
0
|
0
|
|
|
|
0
|
return isIPv4($_[0]->{addr}) |
1184
|
|
|
|
|
|
|
? ipv6to4($_[0]->{addr}) |
1185
|
|
|
|
|
|
|
: $_[0]->{addr}; |
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
=item C<-Erange()> |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
Returns a scalar with the base address and the broadcast address |
1191
|
|
|
|
|
|
|
separated by a dash and spaces. This is called range notation. |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=cut |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
sub range ($) { |
1196
|
0
|
|
|
0
|
1
|
0
|
return $_[0]->network->addr . ' - ' . $_[0]->broadcast->addr; |
1197
|
|
|
|
|
|
|
} |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
=item C<-Enumeric()> |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
When called in a scalar context, will return a numeric representation |
1202
|
|
|
|
|
|
|
of the address part of the IP address. When called in an array |
1203
|
|
|
|
|
|
|
context, it returns a list of two elements. The first element is as |
1204
|
|
|
|
|
|
|
described, the second element is the numeric representation of the |
1205
|
|
|
|
|
|
|
netmask. |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
This method is essential for serializing the representation of a |
1208
|
|
|
|
|
|
|
subnet. |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=cut |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
sub numeric ($) { |
1213
|
0
|
0
|
|
0
|
1
|
0
|
if (wantarray) { |
1214
|
0
|
0
|
0
|
|
|
0
|
if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) { |
1215
|
0
|
|
|
|
|
0
|
return ( sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))), |
1216
|
|
|
|
|
|
|
sprintf("%u",unpack('N',ipv6to4($_[0]->{mask})))); |
1217
|
|
|
|
|
|
|
} |
1218
|
|
|
|
|
|
|
else { |
1219
|
0
|
|
|
|
|
0
|
return ( bin2bcd($_[0]->{addr}), |
1220
|
|
|
|
|
|
|
bin2bcd($_[0]->{mask})); |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
} |
1223
|
0
|
0
|
0
|
|
|
0
|
return (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) |
1224
|
|
|
|
|
|
|
? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))) |
1225
|
|
|
|
|
|
|
: bin2bcd($_[0]->{addr}); |
1226
|
|
|
|
|
|
|
} |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=item C<-Ebigint()> |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
When called in a scalar context, will return a Math::BigInt representation |
1231
|
|
|
|
|
|
|
of the address part of the IP address. When called in an array |
1232
|
|
|
|
|
|
|
contest, it returns a list of two elements. The first element is as |
1233
|
|
|
|
|
|
|
described, the second element is the Math::BigInt representation of the |
1234
|
|
|
|
|
|
|
netmask. |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
=cut |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
my $biloaded; |
1239
|
|
|
|
|
|
|
my $bi2strng; |
1240
|
|
|
|
|
|
|
my $no_mbi_emu = 1; |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
# function to force into test development mode |
1243
|
|
|
|
|
|
|
# |
1244
|
|
|
|
|
|
|
sub _force_bi_emu { |
1245
|
0
|
|
|
0
|
|
0
|
undef $biloaded; |
1246
|
0
|
|
|
|
|
0
|
undef $bi2strng; |
1247
|
0
|
|
|
|
|
0
|
$no_mbi_emu = 0; |
1248
|
0
|
|
|
|
|
0
|
print STDERR "\n\n\tWARNING: test development mode, this |
1249
|
|
|
|
|
|
|
\tmessage SHOULD NEVER BE SEEN IN PRODUCTION! |
1250
|
|
|
|
|
|
|
set my \$no_mbi_emu = 1 in t/bigint.t to remove this warning\n\n"; |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
# function to stringify various flavors of Math::BigInt objects |
1254
|
|
|
|
|
|
|
# tests to see if the object is a hash or a signed scalar |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
sub _bi_stfy { |
1257
|
0
|
|
|
0
|
|
0
|
"$_[0]" =~ /(\d+)/; # stringify and remove '+' if present |
1258
|
0
|
|
|
|
|
0
|
$1; |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
sub _fakebi2strg { |
1262
|
0
|
|
|
0
|
|
0
|
${$_[0]} =~ /(\d+)/; |
|
0
|
|
|
|
|
0
|
|
1263
|
0
|
|
|
|
|
0
|
$1; |
1264
|
|
|
|
|
|
|
} |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
# fake new from bi string Math::BigInt 0.01 |
1267
|
|
|
|
|
|
|
# |
1268
|
|
|
|
|
|
|
sub _bi_fake { |
1269
|
0
|
|
|
0
|
|
0
|
bless \('+'. $_[1]), 'Math::BigInt'; |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
# as of this writing there are three known flavors of Math::BigInt |
1273
|
|
|
|
|
|
|
# v0.01 MBI::new returns a scalar ref |
1274
|
|
|
|
|
|
|
# v1.?? - 1.69 CALC::_new takes a reference to a scalar, returns an array, MBI returns a hash ref |
1275
|
|
|
|
|
|
|
# v1.70 and up CALC::_new takes a scalar, returns and array, MBI returns a hash ref |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
sub _loadMBI { # load Math::BigInt on demand |
1278
|
0
|
0
|
|
0
|
|
0
|
if (eval {$no_mbi_emu && require Math::BigInt}) { # any version should work, three known |
|
0
|
0
|
|
|
|
0
|
|
1279
|
0
|
|
|
|
|
0
|
import Math::BigInt; |
1280
|
0
|
|
|
|
|
0
|
$biloaded = \&Math::BigInt::new; |
1281
|
0
|
|
|
|
|
0
|
$bi2strng = \&_bi_stfy; |
1282
|
|
|
|
|
|
|
} else { |
1283
|
0
|
|
|
|
|
0
|
$biloaded = \&_bi_fake; |
1284
|
0
|
|
|
|
|
0
|
$bi2strng = \&_fakebi2strg; |
1285
|
|
|
|
|
|
|
} |
1286
|
|
|
|
|
|
|
} |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
sub _retMBIstring { |
1289
|
0
|
0
|
|
0
|
|
0
|
_loadMBI unless $biloaded; # load Math::BigInt on demand |
1290
|
0
|
|
|
|
|
0
|
$bi2strng->(@_); |
1291
|
|
|
|
|
|
|
} |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
sub _biRef { |
1294
|
0
|
0
|
|
0
|
|
0
|
_loadMBI unless $biloaded; # load Math::BigInt on demand |
1295
|
0
|
|
|
|
|
0
|
$biloaded->('Math::BigInt',$_[0]); |
1296
|
|
|
|
|
|
|
} |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
sub bigint($) { |
1299
|
0
|
|
|
0
|
1
|
0
|
my($addr,$mask); |
1300
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
1301
|
0
|
0
|
0
|
|
|
0
|
if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) { |
1302
|
0
|
0
|
|
|
|
0
|
$addr = $_[0]->{addr} |
1303
|
|
|
|
|
|
|
? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))) |
1304
|
|
|
|
|
|
|
: 0; |
1305
|
0
|
0
|
|
|
|
0
|
$mask = $_[0]->{mask} |
1306
|
|
|
|
|
|
|
? sprintf("%u",unpack('N',ipv6to4($_[0]->{mask}))) |
1307
|
|
|
|
|
|
|
: 0; |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
else { |
1310
|
0
|
0
|
|
|
|
0
|
$addr = $_[0]->{addr} |
1311
|
|
|
|
|
|
|
? bin2bcd($_[0]->{addr}) |
1312
|
|
|
|
|
|
|
: 0; |
1313
|
0
|
0
|
|
|
|
0
|
$mask = $_[0]->{mask} |
1314
|
|
|
|
|
|
|
? bin2bcd($_[0]->{mask}) |
1315
|
|
|
|
|
|
|
: 0; |
1316
|
|
|
|
|
|
|
} |
1317
|
0
|
|
|
|
|
0
|
(_biRef($addr),_biRef($mask)); |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
} else { # not wantarray |
1320
|
|
|
|
|
|
|
|
1321
|
0
|
0
|
0
|
|
|
0
|
if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) { |
1322
|
0
|
0
|
|
|
|
0
|
$addr = $_[0]->{addr} |
1323
|
|
|
|
|
|
|
? sprintf("%u",unpack('N',ipv6to4($_[0]->{addr}))) |
1324
|
|
|
|
|
|
|
: 0; |
1325
|
|
|
|
|
|
|
} else { |
1326
|
0
|
0
|
|
|
|
0
|
$addr = $_[0]->{addr} |
1327
|
|
|
|
|
|
|
? bin2bcd($_[0]->{addr}) |
1328
|
|
|
|
|
|
|
: 0; |
1329
|
|
|
|
|
|
|
} |
1330
|
0
|
|
|
|
|
0
|
_biRef($addr); |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
|
1334
|
|
|
|
|
|
|
=item C<$me-Econtains($other)> |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
Returns true when C<$me> completely contains C<$other>. False is |
1337
|
|
|
|
|
|
|
returned otherwise and C is returned if C<$me> and C<$other> |
1338
|
|
|
|
|
|
|
are not both C objects. |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
=cut |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
sub contains ($$) { |
1343
|
293787
|
|
|
293787
|
1
|
597010
|
return within(@_[1,0]); |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
=item C<$me-Ewithin($other)> |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
The complement of C<-Econtains()>. Returns true when C<$me> is |
1349
|
|
|
|
|
|
|
completely contained within C<$other>, undef if C<$me> and C<$other> |
1350
|
|
|
|
|
|
|
are not both C objects. |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
=cut |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
sub within ($$) { |
1355
|
293787
|
50
|
|
293787
|
1
|
1023531
|
return 1 unless hasbits($_[1]->{mask}); # 0x0 contains everything |
1356
|
293787
|
|
|
|
|
841097
|
my $netme = $_[0]->{addr} & $_[0]->{mask}; |
1357
|
293787
|
|
|
|
|
639250
|
my $brdme = $_[0]->{addr} | ~ $_[0]->{mask}; |
1358
|
293787
|
|
|
|
|
572421
|
my $neto = $_[1]->{addr} & $_[1]->{mask}; |
1359
|
293787
|
|
|
|
|
577389
|
my $brdo = $_[1]->{addr} | ~ $_[1]->{mask}; |
1360
|
293787
|
100
|
100
|
|
|
10210793
|
return (sub128($netme,$neto) && sub128($brdo,$brdme)) |
1361
|
|
|
|
|
|
|
? 1 : 0; |
1362
|
|
|
|
|
|
|
} |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
=item C-Eis_rfc1918()> |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
Returns true when C<$me> is an RFC 1918 address. |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
10.0.0.0 - 10.255.255.255 (10/8 prefix) |
1369
|
|
|
|
|
|
|
172.16.0.0 - 172.31.255.255 (172.16/12 prefix) |
1370
|
|
|
|
|
|
|
192.168.0.0 - 192.168.255.255 (192.168/16 prefix) |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
=cut |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
my $ip_10 = NetAddr::IP::Lite->new('10.0.0.0/8'); |
1375
|
|
|
|
|
|
|
my $ip_10n = $ip_10->{addr}; # already the right value |
1376
|
|
|
|
|
|
|
my $ip_10b = $ip_10n | ~ $ip_10->{mask}; |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
my $ip_172 = NetAddr::IP::Lite->new('172.16.0.0/12'); |
1379
|
|
|
|
|
|
|
my $ip_172n = $ip_172->{addr}; # already the right value |
1380
|
|
|
|
|
|
|
my $ip_172b = $ip_172n | ~ $ip_172->{mask}; |
1381
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
my $ip_192 = NetAddr::IP::Lite->new('192.168.0.0/16'); |
1383
|
|
|
|
|
|
|
my $ip_192n = $ip_192->{addr}; # already the right value |
1384
|
|
|
|
|
|
|
my $ip_192b = $ip_192n | ~ $ip_192->{mask}; |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
sub is_rfc1918 ($) { |
1387
|
0
|
|
|
0
|
1
|
0
|
my $netme = $_[0]->{addr} & $_[0]->{mask}; |
1388
|
0
|
|
|
|
|
0
|
my $brdme = $_[0]->{addr} | ~ $_[0]->{mask}; |
1389
|
0
|
0
|
0
|
|
|
0
|
return 1 if (sub128($netme,$ip_10n) && sub128($ip_10b,$brdme)); |
1390
|
0
|
0
|
0
|
|
|
0
|
return 1 if (sub128($netme,$ip_192n) && sub128($ip_192b,$brdme)); |
1391
|
0
|
0
|
0
|
|
|
0
|
return (sub128($netme,$ip_172n) && sub128($ip_172b,$brdme)) |
1392
|
|
|
|
|
|
|
? 1 : 0; |
1393
|
|
|
|
|
|
|
} |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
=item C<-Efirst()> |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
Returns a new object representing the first usable IP address within |
1398
|
|
|
|
|
|
|
the subnet (ie, the first host address). |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
=cut |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
my $_cidr127 = pack('N4',0xffffffff,0xffffffff,0xffffffff,0xfffffffe); |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
sub first ($) { |
1405
|
16
|
50
|
|
16
|
1
|
109
|
if (hasbits($_[0]->{mask} ^ $_cidr127)) { |
1406
|
16
|
|
|
|
|
55
|
return $_[0]->network + 1; |
1407
|
|
|
|
|
|
|
} else { |
1408
|
0
|
|
|
|
|
0
|
return $_[0]->network; |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
# return $_[0]->network + 1; |
1411
|
|
|
|
|
|
|
} |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
=item C<-Elast()> |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
Returns a new object representing the last usable IP address within |
1416
|
|
|
|
|
|
|
the subnet (ie, one less than the broadcast address). |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=cut |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
sub last ($) { |
1421
|
3
|
50
|
|
3
|
1
|
17
|
if (hasbits($_[0]->{mask} ^ $_cidr127)) { |
1422
|
3
|
|
|
|
|
10
|
return $_[0]->broadcast - 1; |
1423
|
|
|
|
|
|
|
} else { |
1424
|
0
|
|
|
|
|
0
|
return $_[0]->broadcast; |
1425
|
|
|
|
|
|
|
} |
1426
|
|
|
|
|
|
|
# return $_[0]->broadcast - 1; |
1427
|
|
|
|
|
|
|
} |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
=item C<-Enth($index)> |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
Returns a new object representing the I-th usable IP address within |
1432
|
|
|
|
|
|
|
the subnet (ie, the I-th host address). If no address is available |
1433
|
|
|
|
|
|
|
(for example, when the network is too small for C<$index> hosts), |
1434
|
|
|
|
|
|
|
C is returned. |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements |
1437
|
|
|
|
|
|
|
C<-Enth($index)> and C<-Enum()> exactly as the documentation states. |
1438
|
|
|
|
|
|
|
Previous versions behaved slightly differently and not in a consistent |
1439
|
|
|
|
|
|
|
manner. |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
To use the old behavior for C<-Enth($index)> and C<-Enum()>: |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
use NetAddr::IP::Lite qw(:old_nth); |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
old behavior: |
1446
|
|
|
|
|
|
|
NetAddr::IP->new('10/32')->nth(0) == undef |
1447
|
|
|
|
|
|
|
NetAddr::IP->new('10/32')->nth(1) == undef |
1448
|
|
|
|
|
|
|
NetAddr::IP->new('10/31')->nth(0) == undef |
1449
|
|
|
|
|
|
|
NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31 |
1450
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(0) == undef |
1451
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30 |
1452
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30 |
1453
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30 |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
Note that in each case, the broadcast address is represented in the |
1456
|
|
|
|
|
|
|
output set and that the 'zero'th index is alway undef except for |
1457
|
|
|
|
|
|
|
a point-to-point /31 or /127 network where there are exactly two |
1458
|
|
|
|
|
|
|
addresses in the network. |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
new behavior: |
1461
|
|
|
|
|
|
|
NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32 |
1462
|
|
|
|
|
|
|
NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32 |
1463
|
|
|
|
|
|
|
NetAddr::IP->new('10/31')->nth(0) == 10.0.0.0/32 |
1464
|
|
|
|
|
|
|
NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/32 |
1465
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30 |
1466
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30 |
1467
|
|
|
|
|
|
|
NetAddr::IP->new('10/30')->nth(2) == undef |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
Note that a /32 net always has 1 usable address while a /31 has exactly |
1470
|
|
|
|
|
|
|
two usable addresses for point-to-point addressing. The first |
1471
|
|
|
|
|
|
|
index (0) returns the address immediately following the network address |
1472
|
|
|
|
|
|
|
except for a /31 or /127 when it return the network address. |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
=cut |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
sub nth ($$) { |
1477
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1478
|
0
|
|
|
|
|
0
|
my $count = shift; |
1479
|
|
|
|
|
|
|
|
1480
|
0
|
|
|
|
|
0
|
my $slash31 = ! hasbits($self->{mask} ^ $_cidr127); |
1481
|
0
|
0
|
|
|
|
0
|
if ($Old_nth) { |
|
|
0
|
|
|
|
|
|
1482
|
0
|
0
|
0
|
|
|
0
|
return undef if $slash31 && $count != 1; |
1483
|
0
|
0
|
0
|
|
|
0
|
return undef if ($count < 1 or $count > $self->num ()); |
1484
|
|
|
|
|
|
|
} |
1485
|
|
|
|
|
|
|
elsif ($slash31) { |
1486
|
0
|
0
|
0
|
|
|
0
|
return undef if ($count && $count != 1); # only index 0, 1 allowed for /31 |
1487
|
|
|
|
|
|
|
} else { |
1488
|
0
|
|
|
|
|
0
|
++$count; |
1489
|
0
|
0
|
0
|
|
|
0
|
return undef if ($count < 1 or $count > $self->num ()); |
1490
|
|
|
|
|
|
|
} |
1491
|
0
|
|
|
|
|
0
|
return $self->network + $count; |
1492
|
|
|
|
|
|
|
} |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=item C<-Enum()> |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
As of version 4.42 of NetAddr::IP and version 1.27 of NetAddr::IP::Lite |
1497
|
|
|
|
|
|
|
a /31 and /127 with return a net B value of 2 instead of 0 (zero) |
1498
|
|
|
|
|
|
|
for point-to-point networks. |
1499
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite |
1501
|
|
|
|
|
|
|
return the number of usable IP addresses within the subnet, |
1502
|
|
|
|
|
|
|
not counting the broadcast or network address. |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
Previous versions worked only for ipV4 addresses, returned a |
1505
|
|
|
|
|
|
|
maximum span of 2**32 and returned the number of IP addresses |
1506
|
|
|
|
|
|
|
not counting the broadcast address. |
1507
|
|
|
|
|
|
|
(one greater than the new behavior) |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
To use the old behavior for C<-Enth($index)> and C<-Enum()>: |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
use NetAddr::IP::Lite qw(:old_nth); |
1512
|
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
|
WARNING: |
1514
|
|
|
|
|
|
|
|
1515
|
|
|
|
|
|
|
NetAddr::IP will calculate and return a numeric string for network |
1516
|
|
|
|
|
|
|
ranges as large as 2**128. These values are TEXT strings and perl |
1517
|
|
|
|
|
|
|
can treat them as integers for numeric calculations. |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
Perl on 32 bit platforms only handles integer numbers up to 2**32 |
1520
|
|
|
|
|
|
|
and on 64 bit platforms to 2**64. |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
If you wish to manipulate numeric strings returned by NetAddr::IP |
1523
|
|
|
|
|
|
|
that are larger than 2**32 or 2**64, respectively, you must load |
1524
|
|
|
|
|
|
|
additional modules such as Math::BigInt, bignum or some similar |
1525
|
|
|
|
|
|
|
package to do the integer math. |
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
=cut |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
sub num ($) { |
1530
|
4608
|
100
|
|
4608
|
1
|
8765
|
if ($Old_nth) { |
1531
|
2304
|
|
|
|
|
5325
|
my @net = unpack('L3N',$_[0]->{mask} ^ Ones); |
1532
|
|
|
|
|
|
|
# number of ip's less broadcast |
1533
|
2304
|
50
|
33
|
|
|
11379
|
return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1 |
|
|
|
33
|
|
|
|
|
1534
|
2304
|
50
|
|
|
|
71436
|
return $net[3] if $net[3]; |
1535
|
|
|
|
|
|
|
} else { # returns 1 for /32 /128, 2 for /31 /127 else n-2 up to 2**32 |
1536
|
2304
|
|
|
|
|
8935
|
(undef, my $net) = addconst($_[0]->{mask},1); |
1537
|
2304
|
50
|
|
|
|
66233
|
return 1 unless hasbits($net); # ipV4/32 or ipV6/128 |
1538
|
0
|
|
|
|
|
0
|
$net = $net ^ Ones; |
1539
|
0
|
0
|
|
|
|
0
|
return 2 unless hasbits($net); # ipV4/31 or ipV6/127 |
1540
|
0
|
0
|
|
|
|
0
|
$net &= $_v4net unless $_[0]->{isv6}; |
1541
|
0
|
|
|
|
|
0
|
return bin2bcd($net); |
1542
|
|
|
|
|
|
|
} |
1543
|
|
|
|
|
|
|
} |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
# deprecated |
1546
|
|
|
|
|
|
|
#sub num ($) { |
1547
|
|
|
|
|
|
|
# my @net = unpack('L3N',$_[0]->{mask} ^ Ones); |
1548
|
|
|
|
|
|
|
# if ($Old_nth) { |
1549
|
|
|
|
|
|
|
## number of ip's less broadcast |
1550
|
|
|
|
|
|
|
# return 0xfffffffe if $net[0] || $net[1] || $net[2]; # 2**32 -1 |
1551
|
|
|
|
|
|
|
# return $net[3] if $net[3]; |
1552
|
|
|
|
|
|
|
# } else { # returns 1 for /32 /128, 0 for /31 /127 else n-2 up to 2**32 |
1553
|
|
|
|
|
|
|
## number of usable IP's === number of ip's less broadcast & network addys |
1554
|
|
|
|
|
|
|
# return 0xfffffffd if $net[0] || $net[1] || $net[2]; # 2**32 -2 |
1555
|
|
|
|
|
|
|
# return 1 unless $net[3]; |
1556
|
|
|
|
|
|
|
# $net[3]--; |
1557
|
|
|
|
|
|
|
# } |
1558
|
|
|
|
|
|
|
# return $net[3]; |
1559
|
|
|
|
|
|
|
#} |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
=pod |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
=back |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
=cut |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
sub import { |
1568
|
31
|
50
|
|
31
|
|
78
|
if (grep { $_ eq ':aton' } @_) { |
|
186
|
|
|
|
|
411
|
|
1569
|
0
|
|
|
|
|
0
|
$Accept_Binary_IP = 1; |
1570
|
0
|
|
|
|
|
0
|
@_ = grep { $_ ne ':aton' } @_; |
|
0
|
|
|
|
|
0
|
|
1571
|
|
|
|
|
|
|
} |
1572
|
31
|
50
|
|
|
|
80
|
if (grep { $_ eq ':old_nth' } @_) { |
|
186
|
|
|
|
|
577
|
|
1573
|
0
|
|
|
|
|
0
|
$Old_nth = 1; |
1574
|
0
|
|
|
|
|
0
|
@_ = grep { $_ ne ':old_nth' } @_; |
|
0
|
|
|
|
|
0
|
|
1575
|
|
|
|
|
|
|
} |
1576
|
31
|
50
|
|
|
|
59
|
if (grep { $_ eq ':lower' } @_) |
|
186
|
|
|
|
|
355
|
|
1577
|
|
|
|
|
|
|
{ |
1578
|
0
|
|
|
|
|
0
|
NetAddr::IP::Util::lower(); |
1579
|
0
|
|
|
|
|
0
|
@_ = grep { $_ ne ':lower' } @_; |
|
0
|
|
|
|
|
0
|
|
1580
|
|
|
|
|
|
|
} |
1581
|
31
|
50
|
|
|
|
61
|
if (grep { $_ eq ':upper' } @_) |
|
186
|
|
|
|
|
376
|
|
1582
|
|
|
|
|
|
|
{ |
1583
|
0
|
|
|
|
|
0
|
NetAddr::IP::Util::upper(); |
1584
|
0
|
|
|
|
|
0
|
@_ = grep { $_ ne ':upper' } @_; |
|
0
|
|
|
|
|
0
|
|
1585
|
|
|
|
|
|
|
} |
1586
|
31
|
50
|
|
|
|
56
|
if (grep { $_ eq ':nofqdn' } @_) |
|
186
|
|
|
|
|
421
|
|
1587
|
|
|
|
|
|
|
{ |
1588
|
0
|
|
|
|
|
0
|
$NoFQDN = 1; |
1589
|
0
|
|
|
|
|
0
|
@_ = grep { $_ ne ':nofqdn' } @_; |
|
0
|
|
|
|
|
0
|
|
1590
|
|
|
|
|
|
|
} |
1591
|
31
|
|
|
|
|
6717
|
NetAddr::IP::Lite->export_to_level(1, @_); |
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
|
|
|
|
|
|
|
:nofqdn |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
=head1 AUTHORS |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
Luis E. Muñoz Eluismunoz@cpan.orgE, |
1609
|
|
|
|
|
|
|
Michael Robinton Emichael@bizsystems.comE |
1610
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
=head1 WARRANTY |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
This software comes with the same warranty as perl itself (ie, none), |
1614
|
|
|
|
|
|
|
so by using it you accept any and all the liability. |
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
This software is (c) Luis E. Muñoz, 1999 - 2005 |
1619
|
|
|
|
|
|
|
and (c) Michael Robinton, 2006 - 2014. |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
All rights reserved. |
1622
|
|
|
|
|
|
|
|
1623
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
1624
|
|
|
|
|
|
|
it under the terms of either: |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
a) the GNU General Public License as published by the Free |
1627
|
|
|
|
|
|
|
Software Foundation; either version 2, or (at your option) any |
1628
|
|
|
|
|
|
|
later version, or |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
b) the "Artistic License" which comes with this distribution. |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
1633
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
1634
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either |
1635
|
|
|
|
|
|
|
the GNU General Public License or the Artistic License for more details. |
1636
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
You should have received a copy of the Artistic License with this |
1638
|
|
|
|
|
|
|
distribution, in the file named "Artistic". If not, I'll be glad to provide |
1639
|
|
|
|
|
|
|
one. |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
You should also have received a copy of the GNU General Public License |
1642
|
|
|
|
|
|
|
along with this program in the file named "Copying". If not, write to the |
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
Free Software Foundation, Inc., |
1645
|
|
|
|
|
|
|
51 Franklin Street, Fifth Floor |
1646
|
|
|
|
|
|
|
Boston, MA 02110-1301 USA |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
or visit their web page on the internet at: |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
http://www.gnu.org/copyleft/gpl.html. |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
=head1 SEE ALSO |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
NetAddr::IP(3), NetAddr::IP::Util(3), NetAddr::IP::InetBase(3) |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
=cut |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
1; |