| 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; |