line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright (c) 1999 - 2002 RIPE NCC |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# All Rights Reserved |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# Permission to use, copy, modify, and distribute this software and its |
6
|
|
|
|
|
|
|
# documentation for any purpose and without fee is hereby granted, |
7
|
|
|
|
|
|
|
# provided that the above copyright notice appear in all copies and that |
8
|
|
|
|
|
|
|
# both that copyright notice and this permission notice appear in |
9
|
|
|
|
|
|
|
# supporting documentation, and that the name of the author not be |
10
|
|
|
|
|
|
|
# used in advertising or publicity pertaining to distribution of the |
11
|
|
|
|
|
|
|
# software without specific, written prior permission. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING |
14
|
|
|
|
|
|
|
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL |
15
|
|
|
|
|
|
|
# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY |
16
|
|
|
|
|
|
|
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN |
17
|
|
|
|
|
|
|
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF |
18
|
|
|
|
|
|
|
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
21
|
|
|
|
|
|
|
# Module Header |
22
|
|
|
|
|
|
|
# Filename : IP.pm |
23
|
|
|
|
|
|
|
# Purpose : Provide functions to manipulate IPv4/v6 addresses |
24
|
|
|
|
|
|
|
# Author : Manuel Valente |
25
|
|
|
|
|
|
|
# Date : 19991124 |
26
|
|
|
|
|
|
|
# Description : |
27
|
|
|
|
|
|
|
# Language Version : Perl 5 |
28
|
|
|
|
|
|
|
# OSs Tested : BSDI 3.1 - Linux |
29
|
|
|
|
|
|
|
# Command Line : ipcount |
30
|
|
|
|
|
|
|
# Input Files : |
31
|
|
|
|
|
|
|
# Output Files : |
32
|
|
|
|
|
|
|
# External Programs : Math::BigInt.pm |
33
|
|
|
|
|
|
|
# Problems : |
34
|
|
|
|
|
|
|
# To Do : |
35
|
|
|
|
|
|
|
# Comments : Based on ipv4pack.pm (Monica) and iplib.pm (Lee) |
36
|
|
|
|
|
|
|
# Math::BigInt is only loaded if int functions are used |
37
|
|
|
|
|
|
|
# $Id: IP.pm,v 1.23 2003/02/18 16:13:01 manuel Exp $ |
38
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
package Net::IP; |
41
|
|
|
|
|
|
|
|
42
|
2
|
|
|
2
|
|
39794
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
77
|
|
43
|
2
|
|
|
2
|
|
11148
|
use Math::BigInt; |
|
2
|
|
|
|
|
60548
|
|
|
2
|
|
|
|
|
13
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Global Variables definition |
46
|
2
|
|
|
|
|
1124
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $ERROR $ERRNO |
47
|
|
|
|
|
|
|
%IPv4ranges %IPv6ranges $useBigInt |
48
|
2
|
|
|
2
|
|
47005
|
$IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL); |
|
2
|
|
|
|
|
11
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
$VERSION = '1.26'; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
require Exporter; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Functions and variables exported in all cases |
57
|
|
|
|
|
|
|
@EXPORT = qw(&Error &Errno |
58
|
|
|
|
|
|
|
$IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Functions exported on demand (with :PROC) |
62
|
|
|
|
|
|
|
@EXPORT_OK = qw(&Error &Errno &ip_iptobin &ip_bintoip &ip_bintoint &ip_inttobin |
63
|
|
|
|
|
|
|
&ip_get_version &ip_is_ipv4 &ip_is_ipv6 &ip_expand_address &ip_get_mask |
64
|
|
|
|
|
|
|
&ip_last_address_bin &ip_splitprefix &ip_prefix_to_range |
65
|
|
|
|
|
|
|
&ip_is_valid_mask &ip_bincomp &ip_binadd &ip_get_prefix_length |
66
|
|
|
|
|
|
|
&ip_range_to_prefix &ip_compress_address &ip_is_overlap |
67
|
|
|
|
|
|
|
&ip_get_embedded_ipv4 &ip_aggregate &ip_iptype &ip_check_prefix |
68
|
|
|
|
|
|
|
&ip_reverse &ip_normalize &ip_normal_range &ip_iplengths |
69
|
|
|
|
|
|
|
$IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL |
70
|
|
|
|
|
|
|
); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
%EXPORT_TAGS = (PROC => [@EXPORT_OK],); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Definition of the Ranges for IPv4 IPs |
75
|
|
|
|
|
|
|
%IPv4ranges = ( |
76
|
|
|
|
|
|
|
'00000000' => 'PRIVATE', # 0/8 |
77
|
|
|
|
|
|
|
'00001010' => 'PRIVATE', # 10/8 |
78
|
|
|
|
|
|
|
'0110010001' => 'SHARED', # 100.64/10 |
79
|
|
|
|
|
|
|
'01111111' => 'LOOPBACK', # 127.0/8 |
80
|
|
|
|
|
|
|
'1010100111111110' => 'LINK-LOCAL', # 169.254/16 |
81
|
|
|
|
|
|
|
'101011000001' => 'PRIVATE', # 172.16/12 |
82
|
|
|
|
|
|
|
'110000000000000000000000' => 'RESERVED', # 192.0.0/24 |
83
|
|
|
|
|
|
|
'110000000000000000000010' => 'TEST-NET', # 192.0.2/24 |
84
|
|
|
|
|
|
|
'110000000101100001100011' => '6TO4-RELAY', # 192.88.99.0/24 |
85
|
|
|
|
|
|
|
'1100000010101000' => 'PRIVATE', # 192.168/16 |
86
|
|
|
|
|
|
|
'110001100001001' => 'RESERVED', # 198.18/15 |
87
|
|
|
|
|
|
|
'110001100011001101100100' => 'TEST-NET', # 198.51.100/24 |
88
|
|
|
|
|
|
|
'110010110000000001110001' => 'TEST-NET', # 203.0.113/24 |
89
|
|
|
|
|
|
|
'1110' => 'MULTICAST', # 224/4 |
90
|
|
|
|
|
|
|
'1111' => 'RESERVED', # 240/4 |
91
|
|
|
|
|
|
|
'11111111111111111111111111111111' => 'BROADCAST', # 255.255.255.255/32 |
92
|
|
|
|
|
|
|
); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Definition of the Ranges for Ipv6 IPs |
95
|
|
|
|
|
|
|
%IPv6ranges = ( |
96
|
|
|
|
|
|
|
'00000000' => 'RESERVED', # ::/8 |
97
|
|
|
|
|
|
|
('0' x 128) => 'UNSPECIFIED', # ::/128 |
98
|
|
|
|
|
|
|
('0' x 127) . '1' => 'LOOPBACK', # ::1/128 |
99
|
|
|
|
|
|
|
('0' x 80) . ('1' x 16) => 'IPV4MAP', # ::FFFF:0:0/96 |
100
|
|
|
|
|
|
|
'00000001' => 'RESERVED', # 0100::/8 |
101
|
|
|
|
|
|
|
'0000000100000000' . ('0' x 48) => 'DISCARD', # 0100::/64 |
102
|
|
|
|
|
|
|
'0000001' => 'RESERVED', # 0200::/7 |
103
|
|
|
|
|
|
|
'000001' => 'RESERVED', # 0400::/6 |
104
|
|
|
|
|
|
|
'00001' => 'RESERVED', # 0800::/5 |
105
|
|
|
|
|
|
|
'0001' => 'RESERVED', # 1000::/4 |
106
|
|
|
|
|
|
|
'001' => 'GLOBAL-UNICAST', # 2000::/3 |
107
|
|
|
|
|
|
|
'0010000000000001' . ('0' x 16) => 'TEREDO', # 2001::/32 |
108
|
|
|
|
|
|
|
'00100000000000010000000000000010' . ('0' x 16) => 'BMWG', # 2001:0002::/48 |
109
|
|
|
|
|
|
|
'00100000000000010000110110111000' => 'DOCUMENTATION', # 2001:DB8::/32 |
110
|
|
|
|
|
|
|
'0010000000000001000000000001' => 'ORCHID', # 2001:10::/28 |
111
|
|
|
|
|
|
|
'0010000000000010' => '6TO4', # 2002::/16 |
112
|
|
|
|
|
|
|
'010' => 'RESERVED', # 4000::/3 |
113
|
|
|
|
|
|
|
'011' => 'RESERVED', # 6000::/3 |
114
|
|
|
|
|
|
|
'100' => 'RESERVED', # 8000::/3 |
115
|
|
|
|
|
|
|
'101' => 'RESERVED', # A000::/3 |
116
|
|
|
|
|
|
|
'110' => 'RESERVED', # C000::/3 |
117
|
|
|
|
|
|
|
'1110' => 'RESERVED', # E000::/4 |
118
|
|
|
|
|
|
|
'11110' => 'RESERVED', # F000::/5 |
119
|
|
|
|
|
|
|
'111110' => 'RESERVED', # F800::/6 |
120
|
|
|
|
|
|
|
'1111110' => 'UNIQUE-LOCAL-UNICAST', # FC00::/7 |
121
|
|
|
|
|
|
|
'111111100' => 'RESERVED', # FE00::/9 |
122
|
|
|
|
|
|
|
'1111111010' => 'LINK-LOCAL-UNICAST', # FE80::/10 |
123
|
|
|
|
|
|
|
'1111111011' => 'RESERVED', # FEC0::/10 |
124
|
|
|
|
|
|
|
'11111111' => 'MULTICAST', # FF00::/8 |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Overlap constants |
128
|
|
|
|
|
|
|
$IP_NO_OVERLAP = 0; |
129
|
|
|
|
|
|
|
$IP_PARTIAL_OVERLAP = 1; |
130
|
|
|
|
|
|
|
$IP_A_IN_B_OVERLAP = -1; |
131
|
|
|
|
|
|
|
$IP_B_IN_A_OVERLAP = -2; |
132
|
|
|
|
|
|
|
$IP_IDENTICAL = -3; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# ---------------------------------------------------------- |
135
|
|
|
|
|
|
|
# OVERLOADING |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
use overload ( |
138
|
|
|
|
|
|
|
'+' => 'ip_add_num', |
139
|
72046
|
|
|
72046
|
|
164964
|
'bool' => sub { @_ }, |
140
|
2
|
|
|
2
|
|
13
|
); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
24
|
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
143
|
|
|
|
|
|
|
# Subroutine ip_num_add |
144
|
|
|
|
|
|
|
# Purpose : Add an integer to an IP |
145
|
|
|
|
|
|
|
# Params : Number to add |
146
|
|
|
|
|
|
|
# Returns : New object or undef |
147
|
|
|
|
|
|
|
# Note : Used by overloading - returns undef when |
148
|
|
|
|
|
|
|
# the end of the range is reached |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub ip_add_num { |
151
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
0
|
my ($value) = @_; |
154
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
0
|
my $ip = $self->intip + $value; |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
0
|
my $last = $self->last_int; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Reached the end of the range ? |
160
|
0
|
0
|
|
|
|
0
|
if ($ip > $self->last_int) { |
161
|
0
|
|
|
|
|
0
|
return; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
0
|
my $newb = ip_inttobin($ip, $self->version); |
165
|
0
|
|
|
|
|
0
|
$newb = ip_bintoip($newb, $self->version); |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
0
|
my $newe = ip_inttobin($last, $self->version); |
168
|
0
|
|
|
|
|
0
|
$newe = ip_bintoip($newe, $self->version); |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
0
|
my $new = new Net::IP("$newb - $newe"); |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
0
|
return ($new); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# ----------------------------------------------------------------------------- |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
178
|
|
|
|
|
|
|
# Subroutine new |
179
|
|
|
|
|
|
|
# Purpose : Create an instance of an IP object |
180
|
|
|
|
|
|
|
# Params : Class, IP prefix, IP version |
181
|
|
|
|
|
|
|
# Returns : Object reference or undef |
182
|
|
|
|
|
|
|
# Note : New just allocates a new object - set() does all the work |
183
|
|
|
|
|
|
|
sub new { |
184
|
36021
|
|
|
36021
|
0
|
75587
|
my ($class, $data, $ipversion) = (@_); |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Allocate new object |
187
|
36021
|
|
|
|
|
86264
|
my $self = {}; |
188
|
|
|
|
|
|
|
|
189
|
36021
|
|
|
|
|
100204
|
bless($self, $class); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# Pass everything to set() |
192
|
36021
|
50
|
|
|
|
107636
|
unless ($self->set($data, $ipversion)) { |
193
|
0
|
|
|
|
|
0
|
return; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
36021
|
|
|
|
|
122513
|
return $self; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
200
|
|
|
|
|
|
|
# Subroutine set |
201
|
|
|
|
|
|
|
# Purpose : Set the IP for an IP object |
202
|
|
|
|
|
|
|
# Params : Data, IP type |
203
|
|
|
|
|
|
|
# Returns : 1 (success) or undef (failure) |
204
|
|
|
|
|
|
|
sub set { |
205
|
36039
|
|
|
36039
|
1
|
54261
|
my $self = shift; |
206
|
|
|
|
|
|
|
|
207
|
36039
|
|
|
|
|
85206
|
my ($data, $ipversion) = @_; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Normalize data as received - this should return 2 IPs |
210
|
36039
|
100
|
|
|
|
84125
|
my ($begin, $end) = ip_normalize($data, $ipversion) or do { |
211
|
3
|
|
|
|
|
9
|
$self->{error} = $ERROR; |
212
|
3
|
|
|
|
|
5
|
$self->{errno} = $ERRNO; |
213
|
3
|
|
|
|
|
9
|
return; |
214
|
|
|
|
|
|
|
}; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Those variables are set when the object methods are called |
217
|
|
|
|
|
|
|
# We need to reset everything |
218
|
36036
|
|
|
|
|
88979
|
for ( |
219
|
|
|
|
|
|
|
qw(ipversion errno prefixlen binmask reverse_ip last_ip iptype |
220
|
|
|
|
|
|
|
binip error ip intformat hexformat mask last_bin last_int prefix is_prefix) |
221
|
|
|
|
|
|
|
) |
222
|
|
|
|
|
|
|
{ |
223
|
612612
|
|
|
|
|
747282
|
delete($self->{$_}); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Determine IP version for this object |
227
|
36036
|
50
|
66
|
|
|
118708
|
return unless ($self->{ipversion} = $ipversion || ip_get_version($begin)); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Set begin IP address |
230
|
36036
|
|
|
|
|
94414
|
$self->{ip} = $begin; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# Set Binary IP address |
233
|
|
|
|
|
|
|
return |
234
|
36036
|
50
|
|
|
|
88725
|
unless ($self->{binip} = ip_iptobin($self->ip(), $self->version())); |
235
|
|
|
|
|
|
|
|
236
|
36036
|
|
|
|
|
77605
|
$self->{is_prefix} = 0; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Set end IP address |
239
|
|
|
|
|
|
|
# If single IP: begin and end IPs are identical |
240
|
36036
|
|
66
|
|
|
121311
|
$end ||= $begin; |
241
|
36036
|
|
|
|
|
67031
|
$self->{last_ip} = $end; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# Try to determine the IP version |
244
|
36036
|
|
50
|
|
|
59986
|
my $ver = ip_get_version($end) || return; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# Check if begin and end addresses have the same version |
247
|
36036
|
50
|
|
|
|
94691
|
if ($ver != $self->version()) { |
248
|
0
|
|
|
|
|
0
|
$ERRNO = 201; |
249
|
0
|
|
|
|
|
0
|
$ERROR = |
250
|
|
|
|
|
|
|
"Begin and End addresses have different IP versions - $begin - $end"; |
251
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
252
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
253
|
0
|
|
|
|
|
0
|
return; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Get last binary address |
257
|
|
|
|
|
|
|
return |
258
|
36036
|
50
|
|
|
|
90098
|
unless ($self->{last_bin} = |
259
|
|
|
|
|
|
|
ip_iptobin($self->last_ip(), $self->version())); |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Check that End IP >= Begin IP |
262
|
36036
|
50
|
|
|
|
97464
|
unless (ip_bincomp($self->binip(), 'le', $self->last_bin())) { |
263
|
0
|
|
|
|
|
0
|
$ERRNO = 202; |
264
|
0
|
|
|
|
|
0
|
$ERROR = "Begin address is greater than End address $begin - $end"; |
265
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
266
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
267
|
0
|
|
|
|
|
0
|
return; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Find all prefixes (eg:/24) in the current range |
271
|
36036
|
50
|
|
|
|
109960
|
my @prefixes = $self->find_prefixes() or return; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# If there is only one prefix: |
274
|
36036
|
100
|
|
|
|
91591
|
if (scalar(@prefixes) == 1) { |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# Get length of prefix |
277
|
|
|
|
|
|
|
return |
278
|
36034
|
50
|
|
|
|
99733
|
unless ((undef, $self->{prefixlen}) = ip_splitprefix($prefixes[0])); |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Set prefix boolean var |
281
|
|
|
|
|
|
|
# This value is 1 if the IP range only contains a single /nn prefix |
282
|
36034
|
|
|
|
|
85303
|
$self->{is_prefix} = 1; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# If the range is a single prefix: |
286
|
36036
|
100
|
|
|
|
119047
|
if ($self->{is_prefix}) { |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# Set mask property |
289
|
36034
|
|
|
|
|
133881
|
$self->{binmask} = ip_get_mask($self->prefixlen(), $self->version()); |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Check that the mask is valid |
292
|
36034
|
50
|
|
|
|
112851
|
unless ( |
293
|
|
|
|
|
|
|
ip_check_prefix( |
294
|
|
|
|
|
|
|
$self->binip(), $self->prefixlen(), $self->version() |
295
|
|
|
|
|
|
|
) |
296
|
|
|
|
|
|
|
) |
297
|
|
|
|
|
|
|
{ |
298
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
299
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
300
|
0
|
|
|
|
|
0
|
return; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
36036
|
|
|
|
|
165275
|
return ($self); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub print { |
308
|
36009
|
|
|
36009
|
1
|
154828
|
my $self = shift; |
309
|
|
|
|
|
|
|
|
310
|
36009
|
50
|
|
|
|
98676
|
if ($self->{is_prefix}) { |
311
|
36009
|
|
|
|
|
82733
|
return ($self->short() . '/' . $self->prefixlen()); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
else { |
314
|
0
|
|
|
|
|
0
|
return (sprintf("%s - %s", $self->ip(), $self->last_ip())); |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
319
|
|
|
|
|
|
|
# Subroutine error |
320
|
|
|
|
|
|
|
# Purpose : Return the current error message |
321
|
|
|
|
|
|
|
# Returns : Error string |
322
|
|
|
|
|
|
|
sub error { |
323
|
36058
|
|
|
36058
|
1
|
70445
|
my $self = shift; |
324
|
36058
|
|
|
|
|
160508
|
return $self->{error}; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
328
|
|
|
|
|
|
|
# Subroutine errno |
329
|
|
|
|
|
|
|
# Purpose : Return the current error number |
330
|
|
|
|
|
|
|
# Returns : Error number |
331
|
|
|
|
|
|
|
sub errno { |
332
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
333
|
3
|
|
|
|
|
12
|
return $self->{errno}; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
337
|
|
|
|
|
|
|
# Subroutine binip |
338
|
|
|
|
|
|
|
# Purpose : Return the IP as a binary string |
339
|
|
|
|
|
|
|
# Returns : binary string |
340
|
|
|
|
|
|
|
sub binip { |
341
|
144142
|
|
|
144142
|
1
|
168787
|
my $self = shift; |
342
|
144142
|
|
|
|
|
429957
|
return $self->{binip}; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
346
|
|
|
|
|
|
|
# Subroutine prefixlen |
347
|
|
|
|
|
|
|
# Purpose : Get the IP prefix length |
348
|
|
|
|
|
|
|
# Returns : prefix length |
349
|
|
|
|
|
|
|
sub prefixlen { |
350
|
116086
|
|
|
116086
|
1
|
150359
|
my $self = shift; |
351
|
116086
|
|
|
|
|
490525
|
return $self->{prefixlen}; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
355
|
|
|
|
|
|
|
# Subroutine version |
356
|
|
|
|
|
|
|
# Purpose : Return the IP version |
357
|
|
|
|
|
|
|
# Returns : IP version |
358
|
|
|
|
|
|
|
sub version { |
359
|
316256
|
|
|
316256
|
1
|
439366
|
my $self = shift; |
360
|
316256
|
|
|
|
|
982791
|
return $self->{ipversion}; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
364
|
|
|
|
|
|
|
# Subroutine version |
365
|
|
|
|
|
|
|
# Purpose : Return the IP in quad format |
366
|
|
|
|
|
|
|
# Returns : IP string |
367
|
|
|
|
|
|
|
sub ip { |
368
|
72054
|
|
|
72054
|
1
|
106559
|
my $self = shift; |
369
|
72054
|
|
|
|
|
261552
|
return $self->{ip}; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
373
|
|
|
|
|
|
|
# Subroutine is_prefix |
374
|
|
|
|
|
|
|
# Purpose : Check if range of IPs is a prefix |
375
|
|
|
|
|
|
|
# Returns : boolean |
376
|
|
|
|
|
|
|
sub is_prefix { |
377
|
4
|
|
|
4
|
0
|
7
|
my $self = shift; |
378
|
4
|
|
|
|
|
19
|
return $self->{is_prefix}; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
382
|
|
|
|
|
|
|
# Subroutine binmask |
383
|
|
|
|
|
|
|
# Purpose : Return the binary mask of an IP prefix |
384
|
|
|
|
|
|
|
# Returns : Binary mask (as string) |
385
|
|
|
|
|
|
|
sub binmask { |
386
|
5
|
|
|
5
|
1
|
11
|
my $self = shift; |
387
|
5
|
|
|
|
|
21
|
return $self->{binmask}; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
391
|
|
|
|
|
|
|
# Subroutine size |
392
|
|
|
|
|
|
|
# Purpose : Return the number of addresses contained in an IP object |
393
|
|
|
|
|
|
|
# Returns : Number of addresses |
394
|
|
|
|
|
|
|
sub size { |
395
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
396
|
|
|
|
|
|
|
|
397
|
2
|
|
|
|
|
9
|
my $size = new Math::BigInt($self->last_int); |
398
|
2
|
|
|
|
|
70
|
$size->badd(1); |
399
|
|
|
|
|
|
|
|
400
|
2
|
|
|
|
|
217
|
$size->bsub($self->intip); |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# All the following functions work the same way: the method is just a frontend |
404
|
|
|
|
|
|
|
# to the real function. When the real function is called, the output is cached |
405
|
|
|
|
|
|
|
# so that next time the same function is called,the frontend function directly |
406
|
|
|
|
|
|
|
# returns the result. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
409
|
|
|
|
|
|
|
# Subroutine intip |
410
|
|
|
|
|
|
|
# Purpose : Return the IP in integer format |
411
|
|
|
|
|
|
|
# Returns : Integer |
412
|
|
|
|
|
|
|
sub intip { |
413
|
8
|
|
|
8
|
1
|
51
|
my $self = shift; |
414
|
|
|
|
|
|
|
|
415
|
8
|
100
|
|
|
|
44
|
return ($self->{intformat}) if defined($self->{intformat}); |
416
|
|
|
|
|
|
|
|
417
|
5
|
|
|
|
|
23
|
my $int = ip_bintoint($self->binip()); |
418
|
|
|
|
|
|
|
|
419
|
5
|
50
|
|
|
|
19
|
if (!$int) { |
420
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
421
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
422
|
0
|
|
|
|
|
0
|
return; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
5
|
|
|
|
|
148
|
$self->{intformat} = $int; |
426
|
|
|
|
|
|
|
|
427
|
5
|
|
|
|
|
26
|
return ($int); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
431
|
|
|
|
|
|
|
# Subroutine hexip |
432
|
|
|
|
|
|
|
# Purpose : Return the IP in hex format |
433
|
|
|
|
|
|
|
# Returns : hex string |
434
|
|
|
|
|
|
|
sub hexip { |
435
|
4
|
|
|
4
|
1
|
17
|
my $self = shift; |
436
|
4
|
50
|
|
|
|
15
|
return $self->{'hexformat'} if(defined($self->{'hexformat'})); |
437
|
4
|
|
|
|
|
12
|
$self->{'hexformat'} = $self->intip->as_hex(); |
438
|
4
|
|
|
|
|
628
|
return $self->{'hexformat'}; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
442
|
|
|
|
|
|
|
# Subroutine hexmask |
443
|
|
|
|
|
|
|
# Purpose : Return the mask back in hex |
444
|
|
|
|
|
|
|
# Returns : hex string |
445
|
|
|
|
|
|
|
sub hexmask { |
446
|
2
|
|
|
2
|
1
|
22
|
my $self = shift; |
447
|
|
|
|
|
|
|
|
448
|
2
|
50
|
|
|
|
9
|
return $self->{hexmask} if(defined($self->{hexmask})); |
449
|
|
|
|
|
|
|
|
450
|
2
|
|
|
|
|
10
|
my $intmask = ip_bintoint($self->binmask); |
451
|
|
|
|
|
|
|
|
452
|
2
|
|
|
|
|
10
|
$self->{'hexmask'} = $intmask->as_hex(); |
453
|
|
|
|
|
|
|
|
454
|
2
|
|
|
|
|
442
|
return ($self->{'hexmask'}); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
458
|
|
|
|
|
|
|
# Subroutine prefix |
459
|
|
|
|
|
|
|
# Purpose : Return the Prefix (n.n.n.n/s) |
460
|
|
|
|
|
|
|
# Returns : IP Prefix |
461
|
|
|
|
|
|
|
sub prefix { |
462
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
463
|
|
|
|
|
|
|
|
464
|
0
|
0
|
|
|
|
0
|
if (not $self->is_prefix()) { |
465
|
0
|
|
|
|
|
0
|
$self->{error} = "IP range $self->{ip} is not a Prefix."; |
466
|
0
|
|
|
|
|
0
|
$self->{errno} = 209; |
467
|
0
|
|
|
|
|
0
|
return; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
0
|
0
|
|
|
|
0
|
return ($self->{prefix}) if defined($self->{prefix}); |
471
|
|
|
|
|
|
|
|
472
|
0
|
|
|
|
|
0
|
my $prefix = $self->ip() . '/' . $self->prefixlen(); |
473
|
|
|
|
|
|
|
|
474
|
0
|
0
|
|
|
|
0
|
if (!$prefix) { |
475
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
476
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
477
|
0
|
|
|
|
|
0
|
return; |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
0
|
|
|
|
|
0
|
$self->{prefix} = $prefix; |
481
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
0
|
return ($prefix); |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
486
|
|
|
|
|
|
|
# Subroutine mask |
487
|
|
|
|
|
|
|
# Purpose : Return the IP mask in quad format |
488
|
|
|
|
|
|
|
# Returns : Mask (string) |
489
|
|
|
|
|
|
|
sub mask { |
490
|
2
|
|
|
2
|
1
|
7
|
my $self = shift; |
491
|
|
|
|
|
|
|
|
492
|
2
|
50
|
|
|
|
10
|
if (not $self->is_prefix()) { |
493
|
0
|
|
|
|
|
0
|
$self->{error} = "IP range $self->{ip} is not a Prefix."; |
494
|
0
|
|
|
|
|
0
|
$self->{errno} = 209; |
495
|
0
|
|
|
|
|
0
|
return; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
2
|
50
|
|
|
|
13
|
return ($self->{mask}) if defined($self->{mask}); |
499
|
|
|
|
|
|
|
|
500
|
2
|
|
|
|
|
6
|
my $mask = ip_bintoip($self->binmask(), $self->version()); |
501
|
|
|
|
|
|
|
|
502
|
2
|
50
|
|
|
|
9
|
if (!$mask) { |
503
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
504
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
505
|
0
|
|
|
|
|
0
|
return; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
2
|
|
|
|
|
8
|
$self->{mask} = $mask; |
509
|
|
|
|
|
|
|
|
510
|
2
|
|
|
|
|
10
|
return ($mask); |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
514
|
|
|
|
|
|
|
# Subroutine short |
515
|
|
|
|
|
|
|
# Purpose : Get the short format of an IP address or a Prefix |
516
|
|
|
|
|
|
|
# Returns : short format IP or undef |
517
|
|
|
|
|
|
|
sub short { |
518
|
36011
|
|
|
36011
|
1
|
44255
|
my $self = shift; |
519
|
|
|
|
|
|
|
|
520
|
36011
|
|
|
|
|
41876
|
my $r; |
521
|
|
|
|
|
|
|
|
522
|
36011
|
100
|
|
|
|
62479
|
if ($self->version == 6) { |
523
|
28008
|
|
|
|
|
59446
|
$r = ip_compress_address($self->ip(), $self->version()); |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
else { |
526
|
8003
|
|
|
|
|
14052
|
$r = ip_compress_v4_prefix($self->ip(), $self->prefixlen()); |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
36011
|
50
|
|
|
|
99646
|
if (!defined($r)) { |
530
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
531
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
532
|
0
|
|
|
|
|
0
|
return; |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
36011
|
|
|
|
|
127535
|
return ($r); |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
539
|
|
|
|
|
|
|
# Subroutine iptype |
540
|
|
|
|
|
|
|
# Purpose : Return the type of an IP |
541
|
|
|
|
|
|
|
# Returns : Type or undef (failure) |
542
|
|
|
|
|
|
|
sub iptype { |
543
|
36010
|
|
|
36010
|
1
|
59753
|
my ($self) = shift; |
544
|
|
|
|
|
|
|
|
545
|
36010
|
50
|
|
|
|
100425
|
return ($self->{iptype}) if defined($self->{iptype}); |
546
|
|
|
|
|
|
|
|
547
|
36010
|
|
|
|
|
70090
|
my $type = ip_iptype($self->binip(), $self->version()); |
548
|
|
|
|
|
|
|
|
549
|
36010
|
50
|
|
|
|
157171
|
if (!$type) { |
550
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
551
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
552
|
0
|
|
|
|
|
0
|
return; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
36010
|
|
|
|
|
96256
|
$self->{iptype} = $type; |
556
|
|
|
|
|
|
|
|
557
|
36010
|
|
|
|
|
142378
|
return ($type); |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
561
|
|
|
|
|
|
|
# Subroutine reverse_ip |
562
|
|
|
|
|
|
|
# Purpose : Return the Reverse IP |
563
|
|
|
|
|
|
|
# Returns : Reverse IP or undef(failure) |
564
|
|
|
|
|
|
|
sub reverse_ip { |
565
|
2
|
|
|
2
|
1
|
9
|
my ($self) = shift; |
566
|
|
|
|
|
|
|
|
567
|
2
|
50
|
|
|
|
6
|
if (not $self->is_prefix()) { |
568
|
0
|
|
|
|
|
0
|
$self->{error} = "IP range $self->{ip} is not a Prefix."; |
569
|
0
|
|
|
|
|
0
|
$self->{errno} = 209; |
570
|
0
|
|
|
|
|
0
|
return; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
2
|
50
|
|
|
|
10
|
return ($self->{reverse_ip}) if defined($self->{reverse_ip}); |
574
|
|
|
|
|
|
|
|
575
|
2
|
|
|
|
|
15
|
my $rev = ip_reverse($self->ip(), $self->prefixlen(), $self->version()); |
576
|
|
|
|
|
|
|
|
577
|
2
|
50
|
|
|
|
8
|
if (!$rev) { |
578
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
579
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
580
|
0
|
|
|
|
|
0
|
return; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
2
|
|
|
|
|
11
|
$self->{reverse_ip} = $rev; |
584
|
|
|
|
|
|
|
|
585
|
2
|
|
|
|
|
7
|
return ($rev); |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
589
|
|
|
|
|
|
|
# Subroutine last_bin |
590
|
|
|
|
|
|
|
# Purpose : Get the last IP of a range in binary format |
591
|
|
|
|
|
|
|
# Returns : Last binary IP or undef (failure) |
592
|
|
|
|
|
|
|
sub last_bin { |
593
|
72086
|
|
|
72086
|
1
|
101322
|
my ($self) = shift; |
594
|
|
|
|
|
|
|
|
595
|
72086
|
50
|
|
|
|
302262
|
return ($self->{last_bin}) if defined($self->{last_bin}); |
596
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
0
|
my $last; |
598
|
|
|
|
|
|
|
|
599
|
0
|
0
|
|
|
|
0
|
if ($self->is_prefix()) { |
600
|
0
|
|
|
|
|
0
|
$last = |
601
|
|
|
|
|
|
|
ip_last_address_bin($self->binip(), $self->prefixlen(), |
602
|
|
|
|
|
|
|
$self->version()); |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
else { |
605
|
0
|
|
|
|
|
0
|
$last = ip_iptobin($self->last_ip(), $self->version()); |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
0
|
0
|
|
|
|
0
|
if (!$last) { |
609
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
610
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
611
|
0
|
|
|
|
|
0
|
return; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
0
|
|
|
|
|
0
|
$self->{last_bin} = $last; |
615
|
|
|
|
|
|
|
|
616
|
0
|
|
|
|
|
0
|
return ($last); |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
620
|
|
|
|
|
|
|
# Subroutine last_int |
621
|
|
|
|
|
|
|
# Purpose : Get the last IP of a range in integer format |
622
|
|
|
|
|
|
|
# Returns : Last integer IP or undef (failure) |
623
|
|
|
|
|
|
|
sub last_int { |
624
|
2
|
|
|
2
|
1
|
5
|
my ($self) = shift; |
625
|
|
|
|
|
|
|
|
626
|
2
|
50
|
|
|
|
7
|
return ($self->{last_int}) if defined($self->{last_int}); |
627
|
|
|
|
|
|
|
|
628
|
2
|
50
|
|
|
|
6
|
my $last_bin = $self->last_bin() or return; |
629
|
|
|
|
|
|
|
|
630
|
2
|
50
|
|
|
|
14
|
my $last_int = ip_bintoint($last_bin, $self->version()) or return; |
631
|
|
|
|
|
|
|
|
632
|
2
|
|
|
|
|
82
|
$self->{last_int} = $last_int; |
633
|
|
|
|
|
|
|
|
634
|
2
|
|
|
|
|
9
|
return ($last_int); |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
638
|
|
|
|
|
|
|
# Subroutine last_ip |
639
|
|
|
|
|
|
|
# Purpose : Get the last IP of a prefix in IP format |
640
|
|
|
|
|
|
|
# Returns : IP or undef (failure) |
641
|
|
|
|
|
|
|
sub last_ip { |
642
|
36038
|
|
|
36038
|
1
|
50553
|
my ($self) = shift; |
643
|
|
|
|
|
|
|
|
644
|
36038
|
50
|
|
|
|
147054
|
return ($self->{last_ip}) if defined($self->{last_ip}); |
645
|
|
|
|
|
|
|
|
646
|
0
|
|
|
|
|
0
|
my $last = ip_bintoip($self->last_bin(), $self->version()); |
647
|
|
|
|
|
|
|
|
648
|
0
|
0
|
|
|
|
0
|
if (!$last) { |
649
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
650
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
651
|
0
|
|
|
|
|
0
|
return; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
0
|
$self->{last_ip} = $last; |
655
|
|
|
|
|
|
|
|
656
|
0
|
|
|
|
|
0
|
return ($last); |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
660
|
|
|
|
|
|
|
# Subroutine find_prefixes |
661
|
|
|
|
|
|
|
# Purpose : Get all prefixes in the range defined by two IPs |
662
|
|
|
|
|
|
|
# Params : IP |
663
|
|
|
|
|
|
|
# Returns : List of prefixes or undef (failure) |
664
|
|
|
|
|
|
|
sub find_prefixes { |
665
|
36039
|
|
|
36039
|
1
|
42011
|
my ($self) = @_; |
666
|
|
|
|
|
|
|
|
667
|
36039
|
|
|
|
|
62664
|
my @list = |
668
|
|
|
|
|
|
|
ip_range_to_prefix($self->binip(), $self->last_bin(), $self->version()); |
669
|
|
|
|
|
|
|
|
670
|
36039
|
50
|
|
|
|
119838
|
if (!scalar(@list)) { |
671
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
672
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
673
|
0
|
|
|
|
|
0
|
return; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
36039
|
|
|
|
|
137716
|
return (@list); |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
680
|
|
|
|
|
|
|
# Subroutine bincomp |
681
|
|
|
|
|
|
|
# Purpose : Compare two IPs |
682
|
|
|
|
|
|
|
# Params : Operation, IP to compare |
683
|
|
|
|
|
|
|
# Returns : 1 (True), 0 (False) or undef (problem) |
684
|
|
|
|
|
|
|
# Comments : Operation can be lt, le, gt, ge |
685
|
|
|
|
|
|
|
sub bincomp { |
686
|
2
|
|
|
2
|
1
|
13
|
my ($self, $op, $other) = @_; |
687
|
|
|
|
|
|
|
|
688
|
2
|
|
|
|
|
8
|
my $a = ip_bincomp($self->binip(), $op, $other->binip()); |
689
|
|
|
|
|
|
|
|
690
|
2
|
50
|
|
|
|
11
|
unless (defined $a) { |
691
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
692
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
693
|
0
|
|
|
|
|
0
|
return; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
2
|
|
|
|
|
10
|
return ($a); |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
700
|
|
|
|
|
|
|
# Subroutine binadd |
701
|
|
|
|
|
|
|
# Purpose : Add two IPs |
702
|
|
|
|
|
|
|
# Params : IP to add |
703
|
|
|
|
|
|
|
# Returns : New IP object or undef (failure) |
704
|
|
|
|
|
|
|
sub binadd { |
705
|
2
|
|
|
2
|
1
|
16
|
my ($self, $other) = @_; |
706
|
|
|
|
|
|
|
|
707
|
2
|
|
|
|
|
9
|
my $ip = ip_binadd($self->binip(), $other->binip()); |
708
|
|
|
|
|
|
|
|
709
|
2
|
50
|
|
|
|
11
|
if (!$ip) { |
710
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
711
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
712
|
0
|
|
|
|
|
0
|
return; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
2
|
50
|
|
|
|
10
|
my $new = new Net::IP(ip_bintoip($ip, $self->version())) or return; |
716
|
|
|
|
|
|
|
|
717
|
2
|
|
|
|
|
17
|
return ($new); |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
721
|
|
|
|
|
|
|
# Subroutine aggregate |
722
|
|
|
|
|
|
|
# Purpose : Aggregate (append) two IPs |
723
|
|
|
|
|
|
|
# Params : IP to add |
724
|
|
|
|
|
|
|
# Returns : New IP object or undef (failure) |
725
|
|
|
|
|
|
|
sub aggregate { |
726
|
2
|
|
|
2
|
1
|
11
|
my ($self, $other) = @_; |
727
|
|
|
|
|
|
|
|
728
|
2
|
|
|
|
|
7
|
my $r = ip_aggregate( |
729
|
|
|
|
|
|
|
$self->binip(), $self->last_bin(), |
730
|
|
|
|
|
|
|
$other->binip(), $other->last_bin(), |
731
|
|
|
|
|
|
|
$self->version() |
732
|
|
|
|
|
|
|
); |
733
|
|
|
|
|
|
|
|
734
|
2
|
50
|
|
|
|
10
|
if (!$r) { |
735
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
736
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
737
|
0
|
|
|
|
|
0
|
return; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
2
|
|
|
|
|
10
|
return (new Net::IP($r)); |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
744
|
|
|
|
|
|
|
# Subroutine overlaps |
745
|
|
|
|
|
|
|
# Purpose : Check if two prefixes overlap |
746
|
|
|
|
|
|
|
# Params : Prefix to compare |
747
|
|
|
|
|
|
|
# Returns : $NO_OVERLAP (no overlap) |
748
|
|
|
|
|
|
|
# $IP_PARTIAL_OVERLAP (overlap) |
749
|
|
|
|
|
|
|
# $IP_A_IN_B_OVERLAP (range1 is included in range2) |
750
|
|
|
|
|
|
|
# $IP_B_IN_A_OVERLAP (range2 is included in range1) |
751
|
|
|
|
|
|
|
# $IP_IDENTICAL (range1 == range2) |
752
|
|
|
|
|
|
|
# or undef (problem) |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
sub overlaps { |
755
|
2
|
|
|
2
|
1
|
4
|
my ($self, $other) = @_; |
756
|
|
|
|
|
|
|
|
757
|
2
|
|
|
|
|
7
|
my $r = ip_is_overlap( |
758
|
|
|
|
|
|
|
$self->binip(), $self->last_bin(), |
759
|
|
|
|
|
|
|
$other->binip(), $other->last_bin() |
760
|
|
|
|
|
|
|
); |
761
|
|
|
|
|
|
|
|
762
|
2
|
50
|
|
|
|
10
|
if (!defined($r)) { |
763
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
764
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
765
|
0
|
|
|
|
|
0
|
return; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
2
|
|
|
|
|
9
|
return ($r); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
772
|
|
|
|
|
|
|
# Subroutine auth |
773
|
|
|
|
|
|
|
# Purpose : Return Authority information from IP::Authority |
774
|
|
|
|
|
|
|
# Params : IP object |
775
|
|
|
|
|
|
|
# Returns : Authority Source |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
sub auth { |
778
|
0
|
|
|
0
|
1
|
0
|
my ($self) = shift; |
779
|
|
|
|
|
|
|
|
780
|
0
|
0
|
|
|
|
0
|
return ($self->{auth}) if defined($self->{auth}); |
781
|
|
|
|
|
|
|
|
782
|
0
|
|
|
|
|
0
|
my $auth = ip_auth($self->ip, $self->version); |
783
|
|
|
|
|
|
|
|
784
|
0
|
0
|
|
|
|
0
|
if (!$auth) { |
785
|
0
|
|
|
|
|
0
|
$self->{error} = $ERROR; |
786
|
0
|
|
|
|
|
0
|
$self->{errno} = $ERRNO; |
787
|
0
|
|
|
|
|
0
|
return; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
0
|
|
|
|
|
0
|
$self->{auth} = $auth; |
791
|
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
0
|
return ($self->{auth}); |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
#------------------------------ PROCEDURAL INTERFACE -------------------------- |
796
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
797
|
|
|
|
|
|
|
# Subroutine Error |
798
|
|
|
|
|
|
|
# Purpose : Return the ERROR string |
799
|
|
|
|
|
|
|
# Returns : string |
800
|
|
|
|
|
|
|
sub Error { |
801
|
1
|
|
|
1
|
1
|
5
|
return ($ERROR); |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
805
|
|
|
|
|
|
|
# Subroutine Error |
806
|
|
|
|
|
|
|
# Purpose : Return the ERRNO value |
807
|
|
|
|
|
|
|
# Returns : number |
808
|
|
|
|
|
|
|
sub Errno { |
809
|
1
|
|
|
1
|
1
|
5
|
return ($ERRNO); |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
813
|
|
|
|
|
|
|
# Subroutine ip_iplengths |
814
|
|
|
|
|
|
|
# Purpose : Get the length in bits of an IP from its version |
815
|
|
|
|
|
|
|
# Params : IP version |
816
|
|
|
|
|
|
|
# Returns : Number of bits |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub ip_iplengths { |
819
|
180294
|
|
|
180294
|
0
|
225140
|
my ($version) = @_; |
820
|
|
|
|
|
|
|
|
821
|
180294
|
100
|
|
|
|
450095
|
if ($version == 4) { |
|
|
50
|
|
|
|
|
|
822
|
40166
|
|
|
|
|
88475
|
return (32); |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
elsif ($version == 6) { |
825
|
140128
|
|
|
|
|
366593
|
return (128); |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
else { |
828
|
0
|
|
|
|
|
0
|
return; |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
833
|
|
|
|
|
|
|
# Subroutine ip_iptobin |
834
|
|
|
|
|
|
|
# Purpose : Transform an IP address into a bit string |
835
|
|
|
|
|
|
|
# Params : IP address, IP version |
836
|
|
|
|
|
|
|
# Returns : bit string on success, undef otherwise |
837
|
|
|
|
|
|
|
sub ip_iptobin { |
838
|
72090
|
|
|
72090
|
1
|
141850
|
my ($ip, $ipversion) = @_; |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
# v4 -> return 32-bit array |
841
|
72090
|
100
|
|
|
|
180370
|
if ($ipversion == 4) { |
842
|
16050
|
|
|
|
|
119238
|
return unpack('B32', pack('C4C4C4C4', split(/\./, $ip))); |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
# Strip ':' |
846
|
56040
|
|
|
|
|
184426
|
$ip =~ s/://g; |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
# Check size |
849
|
56040
|
50
|
|
|
|
167041
|
unless (length($ip) == 32) { |
850
|
0
|
|
|
|
|
0
|
$ERROR = "Bad IP address $ip"; |
851
|
0
|
|
|
|
|
0
|
$ERRNO = 102; |
852
|
0
|
|
|
|
|
0
|
return; |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
# v6 -> return 128-bit array |
856
|
56040
|
|
|
|
|
400946
|
return unpack('B128', pack('H32', $ip)); |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
860
|
|
|
|
|
|
|
# Subroutine ip_bintoip |
861
|
|
|
|
|
|
|
# Purpose : Transform a bit string into an IP address |
862
|
|
|
|
|
|
|
# Params : bit string, IP version |
863
|
|
|
|
|
|
|
# Returns : IP address on success, undef otherwise |
864
|
|
|
|
|
|
|
sub ip_bintoip { |
865
|
36076
|
|
|
36076
|
1
|
73409
|
my ($binip, $ip_version) = @_; |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
# Define normal size for address |
868
|
36076
|
|
|
|
|
61250
|
my $len = ip_iplengths($ip_version); |
869
|
|
|
|
|
|
|
|
870
|
36076
|
50
|
|
|
|
95504
|
if ($len < length($binip)) { |
871
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid IP length for binary IP $binip\n"; |
872
|
0
|
|
|
|
|
0
|
$ERRNO = 189; |
873
|
0
|
|
|
|
|
0
|
return; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
# Prepend 0s if address is less than normal size |
877
|
36076
|
|
|
|
|
85057
|
$binip = '0' x ($len - length($binip)) . $binip; |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
# IPv4 |
880
|
36076
|
100
|
|
|
|
93506
|
if ($ip_version == 4) { |
881
|
8043
|
|
|
|
|
54205
|
return join '.', unpack('C4C4C4C4', pack('B32', $binip)); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
# IPv6 |
885
|
28033
|
|
|
|
|
288444
|
return join(':', unpack('H4H4H4H4H4H4H4H4', pack('B128', $binip))); |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
889
|
|
|
|
|
|
|
# Subroutine ip_bintoint |
890
|
|
|
|
|
|
|
# Purpose : Transform a bit string into an Integer |
891
|
|
|
|
|
|
|
# Params : bit string |
892
|
|
|
|
|
|
|
# Returns : BigInt |
893
|
|
|
|
|
|
|
sub ip_bintoint { |
894
|
9
|
|
|
9
|
1
|
15
|
my $binip = shift; |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# $n is the increment, $dec is the returned value |
897
|
9
|
|
|
|
|
47
|
my ($n, $dec) = (Math::BigInt->new(1), Math::BigInt->new(0)); |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
# Reverse the bit string |
901
|
9
|
|
|
|
|
1395
|
foreach (reverse(split '', $binip)) { |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
# If the nth bit is 1, add 2**n to $dec |
904
|
480
|
100
|
|
|
|
52356
|
$_ and $dec += $n; |
905
|
480
|
|
|
|
|
9958
|
$n *= 2; |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
# Strip leading + sign |
909
|
9
|
|
|
|
|
1066
|
$dec =~ s/^\+//; |
910
|
9
|
|
|
|
|
299
|
return $dec; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
914
|
|
|
|
|
|
|
# Subroutine ip_inttobin |
915
|
|
|
|
|
|
|
# Purpose : Transform a BigInt into a bit string |
916
|
|
|
|
|
|
|
# Comments : sets warnings (-w) off. |
917
|
|
|
|
|
|
|
# This is necessary because Math::BigInt is not compliant |
918
|
|
|
|
|
|
|
# Params : BigInt, IP version |
919
|
|
|
|
|
|
|
# Returns : bit string |
920
|
|
|
|
|
|
|
sub ip_inttobin { |
921
|
|
|
|
|
|
|
|
922
|
0
|
|
|
0
|
1
|
0
|
my $dec = Math::BigInt->new(shift); |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
# Find IP version |
925
|
0
|
|
|
|
|
0
|
my $ip_version = shift; |
926
|
|
|
|
|
|
|
|
927
|
0
|
0
|
|
|
|
0
|
unless ($ip_version) { |
928
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version for $dec"; |
929
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
930
|
0
|
|
|
|
|
0
|
return; |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
0
|
|
|
|
|
0
|
my $binip = $dec->as_bin(); |
934
|
0
|
|
|
|
|
0
|
$binip =~ s/^0b//; |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
# Define normal size for address |
937
|
0
|
|
|
|
|
0
|
my $len = ip_iplengths($ip_version); |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
# Prepend 0s if result is less than normal size |
940
|
0
|
|
|
|
|
0
|
$binip = '0' x ($len - length($binip)) . $binip; |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
|
943
|
0
|
|
|
|
|
0
|
return $binip; |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
948
|
|
|
|
|
|
|
# Subroutine ip_get_version |
949
|
|
|
|
|
|
|
# Purpose : Get an IP version |
950
|
|
|
|
|
|
|
# Params : IP address |
951
|
|
|
|
|
|
|
# Returns : 4, 6, 0(don't know) |
952
|
|
|
|
|
|
|
sub ip_get_version { |
953
|
108107
|
|
|
108107
|
1
|
151306
|
my $ip = shift; |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
# If the address does not contain any ':', maybe it's IPv4 |
956
|
108107
|
100
|
66
|
|
|
384855
|
$ip !~ /:/ and ip_is_ipv4($ip) and return '4'; |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
# Is it IPv6 ? |
959
|
84051
|
100
|
|
|
|
151794
|
ip_is_ipv6($ip) and return '6'; |
960
|
|
|
|
|
|
|
|
961
|
1
|
|
|
|
|
6
|
return; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
965
|
|
|
|
|
|
|
# Subroutine ip_is_ipv4 |
966
|
|
|
|
|
|
|
# Purpose : Check if an IP address is version 4 |
967
|
|
|
|
|
|
|
# Params : IP address |
968
|
|
|
|
|
|
|
# Returns : 1 (yes) or 0 (no) |
969
|
|
|
|
|
|
|
sub ip_is_ipv4 { |
970
|
24056
|
|
|
24056
|
1
|
27875
|
my $ip = shift; |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
# Check for invalid chars |
973
|
24056
|
50
|
|
|
|
80676
|
unless ($ip =~ m/^[\d\.]+$/) { |
974
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid chars in IP $ip"; |
975
|
0
|
|
|
|
|
0
|
$ERRNO = 107; |
976
|
0
|
|
|
|
|
0
|
return 0; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
24056
|
50
|
|
|
|
50086
|
if ($ip =~ m/^\./) { |
980
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid IP $ip - starts with a dot"; |
981
|
0
|
|
|
|
|
0
|
$ERRNO = 103; |
982
|
0
|
|
|
|
|
0
|
return 0; |
983
|
|
|
|
|
|
|
} |
984
|
|
|
|
|
|
|
|
985
|
24056
|
50
|
|
|
|
45570
|
if ($ip =~ m/\.$/) { |
986
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid IP $ip - ends with a dot"; |
987
|
0
|
|
|
|
|
0
|
$ERRNO = 104; |
988
|
0
|
|
|
|
|
0
|
return 0; |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
# Single Numbers are considered to be IPv4 |
992
|
24056
|
100
|
66
|
|
|
76839
|
if ($ip =~ m/^(\d+)$/ and $1 < 256) { return 1 } |
|
1
|
|
|
|
|
8
|
|
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
# Count quads |
995
|
24055
|
|
|
|
|
35555
|
my $n = ($ip =~ tr/\./\./); |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# IPv4 must have from 1 to 4 quads |
998
|
24055
|
50
|
33
|
|
|
98607
|
unless ($n >= 0 and $n < 4) { |
999
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid IP address $ip"; |
1000
|
0
|
|
|
|
|
0
|
$ERRNO = 105; |
1001
|
0
|
|
|
|
|
0
|
return 0; |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
# Check for empty quads |
1005
|
24055
|
50
|
|
|
|
51679
|
if ($ip =~ m/\.\./) { |
1006
|
0
|
|
|
|
|
0
|
$ERROR = "Empty quad in IP address $ip"; |
1007
|
0
|
|
|
|
|
0
|
$ERRNO = 106; |
1008
|
0
|
|
|
|
|
0
|
return 0; |
1009
|
|
|
|
|
|
|
} |
1010
|
|
|
|
|
|
|
|
1011
|
24055
|
|
|
|
|
70272
|
foreach (split /\./, $ip) { |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
# Check for invalid quads |
1014
|
96214
|
50
|
33
|
|
|
398225
|
unless ($_ >= 0 and $_ < 256) { |
1015
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid quad in IP address $ip - $_"; |
1016
|
0
|
|
|
|
|
0
|
$ERRNO = 107; |
1017
|
0
|
|
|
|
|
0
|
return 0; |
1018
|
|
|
|
|
|
|
} |
1019
|
|
|
|
|
|
|
} |
1020
|
24055
|
|
|
|
|
165538
|
return 1; |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1024
|
|
|
|
|
|
|
# Subroutine ip_is_ipv6 |
1025
|
|
|
|
|
|
|
# Purpose : Check if an IP address is version 6 |
1026
|
|
|
|
|
|
|
# Params : IP address |
1027
|
|
|
|
|
|
|
# Returns : 1 (yes) or 0 (no) |
1028
|
|
|
|
|
|
|
sub ip_is_ipv6 { |
1029
|
84055
|
|
|
84055
|
1
|
94042
|
my $ip = shift; |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
# Count octets |
1032
|
84055
|
|
|
|
|
132163
|
my $n = ($ip =~ tr/:/:/); |
1033
|
84055
|
50
|
33
|
|
|
378003
|
return 0 unless ($n > 0 and $n < 8); |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
# $k is a counter |
1036
|
84055
|
|
|
|
|
91477
|
my $k; |
1037
|
|
|
|
|
|
|
|
1038
|
84055
|
|
|
|
|
352228
|
foreach (split /:/, $ip) { |
1039
|
672370
|
|
|
|
|
755389
|
$k++; |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
# Empty octet ? |
1042
|
672370
|
100
|
|
|
|
1286121
|
next if ($_ eq ''); |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
# Normal v6 octet ? |
1045
|
672359
|
50
|
|
|
|
1985752
|
next if (/^[a-f\d]{1,4}$/i); |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
# Last octet - is it IPv4 ? |
1048
|
0
|
0
|
0
|
|
|
0
|
if ( ($k == $n + 1) && ip_is_ipv4($_) ) { |
1049
|
0
|
|
|
|
|
0
|
$n++; # ipv4 is two octets |
1050
|
0
|
|
|
|
|
0
|
next; |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
|
1053
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid IP address $ip"; |
1054
|
0
|
|
|
|
|
0
|
$ERRNO = 108; |
1055
|
0
|
|
|
|
|
0
|
return 0; |
1056
|
|
|
|
|
|
|
} |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
# Does the IP address start with : ? |
1059
|
84055
|
100
|
|
|
|
308483
|
if ($ip =~ m/^:[^:]/) { |
1060
|
1
|
|
|
|
|
4
|
$ERROR = "Invalid address $ip (starts with :)"; |
1061
|
1
|
|
|
|
|
1
|
$ERRNO = 109; |
1062
|
1
|
|
|
|
|
4
|
return 0; |
1063
|
|
|
|
|
|
|
} |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
# Does the IP address finish with : ? |
1066
|
84054
|
50
|
|
|
|
221008
|
if ($ip =~ m/[^:]:$/) { |
1067
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid address $ip (ends with :)"; |
1068
|
0
|
|
|
|
|
0
|
$ERRNO = 110; |
1069
|
0
|
|
|
|
|
0
|
return 0; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
# Does the IP address have more than one '::' pattern ? |
1073
|
84054
|
50
|
|
|
|
390357
|
if ($ip =~ s/:(?=:)/:/g > 1) { |
1074
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid address $ip (More than one :: pattern)"; |
1075
|
0
|
|
|
|
|
0
|
$ERRNO = 111; |
1076
|
0
|
|
|
|
|
0
|
return 0; |
1077
|
|
|
|
|
|
|
} |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
# number of octets |
1080
|
84054
|
100
|
100
|
|
|
234129
|
if ($n != 7 && $ip !~ /::/) { |
1081
|
2
|
|
|
|
|
6
|
$ERROR = "Invalid number of octets $ip"; |
1082
|
2
|
|
|
|
|
4
|
$ERRNO = 112; |
1083
|
2
|
|
|
|
|
9
|
return 0; |
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
# valid IPv6 address |
1087
|
84052
|
|
|
|
|
489981
|
return 1; |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1091
|
|
|
|
|
|
|
# Subroutine ip_expand_address |
1092
|
|
|
|
|
|
|
# Purpose : Expand an address from compact notation |
1093
|
|
|
|
|
|
|
# Params : IP address, IP version |
1094
|
|
|
|
|
|
|
# Returns : expanded IP address or undef on failure |
1095
|
|
|
|
|
|
|
sub ip_expand_address { |
1096
|
64055
|
|
|
64055
|
1
|
89466
|
my ($ip, $ip_version) = @_; |
1097
|
|
|
|
|
|
|
|
1098
|
64055
|
50
|
|
|
|
143399
|
unless ($ip_version) { |
1099
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version for $ip"; |
1100
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1101
|
0
|
|
|
|
|
0
|
return; |
1102
|
|
|
|
|
|
|
} |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
# v4 : add .0 for missing quads |
1105
|
64055
|
100
|
|
|
|
160760
|
if ($ip_version == 4) { |
1106
|
8024
|
|
|
|
|
29749
|
my @quads = split /\./, $ip; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
# check number of quads |
1109
|
8024
|
50
|
|
|
|
18716
|
if (scalar(@quads) > 4) { |
1110
|
0
|
|
|
|
|
0
|
$ERROR = "Not a valid IPv address $ip"; |
1111
|
0
|
|
|
|
|
0
|
$ERRNO = 102; |
1112
|
0
|
|
|
|
|
0
|
return; |
1113
|
|
|
|
|
|
|
} |
1114
|
8024
|
|
|
|
|
15141
|
my @clean_quads = (0, 0, 0, 0); |
1115
|
|
|
|
|
|
|
|
1116
|
8024
|
|
|
|
|
11909
|
foreach my $q (reverse @quads) { |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
#check quad data |
1119
|
32084
|
100
|
|
|
|
95361
|
if ($q !~ m/^\d{1,3}$/) { |
1120
|
1
|
|
|
|
|
4
|
$ERROR = "Not a valid IPv4 address $ip"; |
1121
|
1
|
|
|
|
|
1
|
$ERRNO = 102; |
1122
|
1
|
|
|
|
|
7
|
return; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
# build clean ipv4 |
1126
|
32083
|
|
|
|
|
71577
|
unshift(@clean_quads, $q + 1 - 1); |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
|
1129
|
8023
|
|
|
|
|
55972
|
return (join '.', @clean_quads[ 0 .. 3 ]); |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
# Keep track of :: |
1133
|
56031
|
|
|
|
|
107896
|
my $num_of_double_colon = ($ip =~ s/::/:!:/g); |
1134
|
56031
|
100
|
|
|
|
104150
|
if ($num_of_double_colon > 1) { |
1135
|
1
|
|
|
|
|
3
|
$ERROR = "Too many :: in ip"; |
1136
|
1
|
|
|
|
|
3
|
$ERRNO = 102; |
1137
|
1
|
|
|
|
|
5
|
return; |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
# IP as an array |
1141
|
56030
|
|
|
|
|
278833
|
my @ip = split /:/, $ip; |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
# Number of octets |
1144
|
56030
|
|
|
|
|
104791
|
my $num = scalar(@ip); |
1145
|
|
|
|
|
|
|
|
1146
|
56030
|
|
|
|
|
164944
|
foreach (0 .. (scalar(@ip) - 1)) { |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
# Embedded IPv4 |
1149
|
448192
|
50
|
|
|
|
986113
|
if ($ip[$_] =~ /\./) { |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
# Expand Ipv4 address |
1152
|
|
|
|
|
|
|
# Convert into binary |
1153
|
|
|
|
|
|
|
# Convert into hex |
1154
|
|
|
|
|
|
|
# Keep the last two octets |
1155
|
|
|
|
|
|
|
|
1156
|
0
|
|
|
|
|
0
|
$ip[$_] = substr( ip_bintoip( ip_iptobin( ip_expand_address($ip[$_], 4), 4), 6), -9); |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
# Has an error occured here ? |
1159
|
0
|
0
|
|
|
|
0
|
return unless (defined($ip[$_])); |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
# $num++ because we now have one more octet: |
1162
|
|
|
|
|
|
|
# IPv4 address becomes two octets |
1163
|
0
|
|
|
|
|
0
|
$num++; |
1164
|
0
|
|
|
|
|
0
|
next; |
1165
|
|
|
|
|
|
|
} |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
# Add missing trailing 0s |
1168
|
448192
|
|
|
|
|
954321
|
$ip[$_] = ('0' x (4 - length($ip[$_]))) . $ip[$_]; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
# Now deal with '::' ('000!') |
1172
|
56030
|
|
|
|
|
141740
|
foreach (0 .. (scalar(@ip) - 1)) { |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
# Find the pattern |
1175
|
448180
|
100
|
|
|
|
956384
|
next unless ($ip[$_] eq '000!'); |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
# @empty is the IP address 0 |
1178
|
12
|
|
|
|
|
28
|
my @empty = map { $_ = '0' x 4 } (0 .. 7); |
|
96
|
|
|
|
|
224
|
|
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
# Replace :: with $num '0000' octets |
1181
|
12
|
|
|
|
|
70
|
$ip[$_] = join ':', @empty[ 0 .. 8 - $num ]; |
1182
|
12
|
|
|
|
|
32
|
last; |
1183
|
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
|
|
1185
|
56030
|
|
|
|
|
342530
|
return (lc(join ':', @ip)); |
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1189
|
|
|
|
|
|
|
# Subroutine ip_get_mask |
1190
|
|
|
|
|
|
|
# Purpose : Get IP mask from prefix length. |
1191
|
|
|
|
|
|
|
# Params : Prefix length, IP version |
1192
|
|
|
|
|
|
|
# Returns : Binary Mask |
1193
|
|
|
|
|
|
|
sub ip_get_mask { |
1194
|
36034
|
|
|
36034
|
1
|
62135
|
my ($len, $ip_version) = @_; |
1195
|
|
|
|
|
|
|
|
1196
|
36034
|
50
|
|
|
|
73236
|
unless ($ip_version) { |
1197
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version"; |
1198
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1199
|
0
|
|
|
|
|
0
|
return; |
1200
|
|
|
|
|
|
|
} |
1201
|
|
|
|
|
|
|
|
1202
|
36034
|
|
|
|
|
64802
|
my $size = ip_iplengths($ip_version); |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
# mask is $len 1s plus the rest as 0s |
1205
|
36034
|
|
|
|
|
208820
|
return (('1' x $len) . ('0' x ($size - $len))); |
1206
|
|
|
|
|
|
|
} |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1209
|
|
|
|
|
|
|
# Subroutine ip_last_address_bin |
1210
|
|
|
|
|
|
|
# Purpose : Return the last binary address of a range |
1211
|
|
|
|
|
|
|
# Params : First binary IP, prefix length, IP version |
1212
|
|
|
|
|
|
|
# Returns : Binary IP |
1213
|
|
|
|
|
|
|
sub ip_last_address_bin { |
1214
|
17
|
|
|
17
|
1
|
37
|
my ($binip, $len, $ip_version) = @_; |
1215
|
|
|
|
|
|
|
|
1216
|
17
|
50
|
|
|
|
40
|
unless ($ip_version) { |
1217
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version"; |
1218
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1219
|
0
|
|
|
|
|
0
|
return; |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
|
1222
|
17
|
|
|
|
|
32
|
my $size = ip_iplengths($ip_version); |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
# Find the part of the IP address which will not be modified |
1225
|
17
|
|
|
|
|
39
|
$binip = substr($binip, 0, $len); |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
# Fill with 1s the variable part |
1228
|
17
|
|
|
|
|
78
|
return ($binip . ('1' x ($size - length($binip)))); |
1229
|
|
|
|
|
|
|
} |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1232
|
|
|
|
|
|
|
# Subroutine ip_splitprefix |
1233
|
|
|
|
|
|
|
# Purpose : Split a prefix into IP and prefix length |
1234
|
|
|
|
|
|
|
# Comments : If it was passed a simple IP, it just returns it |
1235
|
|
|
|
|
|
|
# Params : Prefix |
1236
|
|
|
|
|
|
|
# Returns : IP, optionnaly length of prefix |
1237
|
|
|
|
|
|
|
sub ip_splitprefix { |
1238
|
36034
|
|
|
36034
|
1
|
49941
|
my $prefix = shift; |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
# Find the '/' |
1241
|
36034
|
50
|
|
|
|
478337
|
return unless ($prefix =~ m!^([^/]+?)(/\d+)?$!); |
1242
|
|
|
|
|
|
|
|
1243
|
36034
|
|
|
|
|
128216
|
my ($ip, $len) = ($1, $2); |
1244
|
|
|
|
|
|
|
|
1245
|
36034
|
50
|
|
|
|
139840
|
defined($len) and $len =~ s!/!!; |
1246
|
|
|
|
|
|
|
|
1247
|
36034
|
|
|
|
|
217165
|
return ($ip, $len); |
1248
|
|
|
|
|
|
|
} |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1251
|
|
|
|
|
|
|
# Subroutine ip_prefix_to_range |
1252
|
|
|
|
|
|
|
# Purpose : Get a range from a prefix |
1253
|
|
|
|
|
|
|
# Params : IP, Prefix length, IP version |
1254
|
|
|
|
|
|
|
# Returns : First IP, last IP |
1255
|
|
|
|
|
|
|
sub ip_prefix_to_range { |
1256
|
0
|
|
|
0
|
1
|
0
|
my ($ip, $len, $ip_version) = @_; |
1257
|
|
|
|
|
|
|
|
1258
|
0
|
0
|
|
|
|
0
|
unless ($ip_version) { |
1259
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version"; |
1260
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1261
|
0
|
|
|
|
|
0
|
return; |
1262
|
|
|
|
|
|
|
} |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
# Expand the first IP address |
1265
|
0
|
|
|
|
|
0
|
$ip = ip_expand_address($ip, $ip_version); |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
# Turn into a binary |
1268
|
|
|
|
|
|
|
# Get last address |
1269
|
|
|
|
|
|
|
# Turn into an IP |
1270
|
0
|
0
|
|
|
|
0
|
my $binip = ip_iptobin($ip, $ip_version) or return; |
1271
|
|
|
|
|
|
|
|
1272
|
0
|
0
|
|
|
|
0
|
return unless (ip_check_prefix($binip, $len, $ip_version)); |
1273
|
|
|
|
|
|
|
|
1274
|
0
|
0
|
|
|
|
0
|
my $lastip = ip_last_address_bin($binip, $len, $ip_version) or return; |
1275
|
0
|
0
|
|
|
|
0
|
return unless ($lastip = ip_bintoip($lastip, $ip_version)); |
1276
|
|
|
|
|
|
|
|
1277
|
0
|
|
|
|
|
0
|
return ($ip, $lastip); |
1278
|
|
|
|
|
|
|
} |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1281
|
|
|
|
|
|
|
# Subroutine ip_is_valid_mask |
1282
|
|
|
|
|
|
|
# Purpose : Check the validity of an IP mask (11110000) |
1283
|
|
|
|
|
|
|
# Params : Mask |
1284
|
|
|
|
|
|
|
# Returns : 1 or undef (invalid) |
1285
|
|
|
|
|
|
|
sub ip_is_valid_mask { |
1286
|
0
|
|
|
0
|
0
|
0
|
my ($mask, $ip_version) = @_; |
1287
|
|
|
|
|
|
|
|
1288
|
0
|
0
|
|
|
|
0
|
unless ($ip_version) { |
1289
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version for $mask"; |
1290
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1291
|
0
|
|
|
|
|
0
|
return; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
0
|
|
|
|
|
0
|
my $len = ip_iplengths($ip_version); |
1295
|
|
|
|
|
|
|
|
1296
|
0
|
0
|
|
|
|
0
|
if (length($mask) != $len) { |
1297
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid mask length for $mask"; |
1298
|
0
|
|
|
|
|
0
|
$ERRNO = 150; |
1299
|
0
|
|
|
|
|
0
|
return; |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
# The mask should be of the form 111110000000 |
1303
|
0
|
0
|
|
|
|
0
|
unless ($mask =~ m/^1*0*$/) { |
1304
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid mask $mask"; |
1305
|
0
|
|
|
|
|
0
|
$ERRNO = 151; |
1306
|
0
|
|
|
|
|
0
|
return; |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
|
1309
|
0
|
|
|
|
|
0
|
return 1; |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1313
|
|
|
|
|
|
|
# Subroutine ip_bincomp |
1314
|
|
|
|
|
|
|
# Purpose : Compare binary Ips with <, >, <=, >= |
1315
|
|
|
|
|
|
|
# Comments : Operators are lt(<), le(<=), gt(>), and ge(>=) |
1316
|
|
|
|
|
|
|
# Params : First binary IP, operator, Last binary Ip |
1317
|
|
|
|
|
|
|
# Returns : 1 (yes), 0 (no), or undef (problem) |
1318
|
|
|
|
|
|
|
sub ip_bincomp { |
1319
|
185423
|
|
|
185423
|
1
|
339418
|
my ($begin, $op, $end) = @_; |
1320
|
|
|
|
|
|
|
|
1321
|
185423
|
|
|
|
|
189582
|
my ($b, $e); |
1322
|
|
|
|
|
|
|
|
1323
|
185423
|
100
|
|
|
|
568569
|
if ($op =~ /^l[te]$/) # Operator is lt or le |
|
|
50
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
{ |
1325
|
185421
|
|
|
|
|
331508
|
($b, $e) = ($end, $begin); |
1326
|
|
|
|
|
|
|
} |
1327
|
|
|
|
|
|
|
elsif ($op =~ /^g[te]$/) # Operator is gt or ge |
1328
|
|
|
|
|
|
|
{ |
1329
|
2
|
|
|
|
|
4
|
($b, $e) = ($begin, $end); |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
else { |
1332
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid Operator $op\n"; |
1333
|
0
|
|
|
|
|
0
|
$ERRNO = 131; |
1334
|
0
|
|
|
|
|
0
|
return; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
# le or ge -> return 1 if IPs are identical |
1338
|
185423
|
100
|
100
|
|
|
1197241
|
return (1) if ($op =~ /e/ and ($begin eq $end)); |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
# Check IP sizes |
1341
|
77342
|
50
|
|
|
|
189234
|
unless (length($b) eq length($e)) { |
1342
|
0
|
|
|
|
|
0
|
$ERROR = "IP addresses of different length\n"; |
1343
|
0
|
|
|
|
|
0
|
$ERRNO = 130; |
1344
|
0
|
|
|
|
|
0
|
return; |
1345
|
|
|
|
|
|
|
} |
1346
|
|
|
|
|
|
|
|
1347
|
77342
|
|
|
|
|
87714
|
my $c; |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
# Foreach bit |
1350
|
77342
|
|
|
|
|
167846
|
for (0 .. length($b) - 1) { |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
# substract the two bits |
1353
|
7924004
|
|
|
|
|
10654004
|
$c = substr($b, $_, 1) - substr($e, $_, 1); |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
# Check the result |
1356
|
7924004
|
100
|
|
|
|
14027917
|
return (1) if ($c == 1); |
1357
|
7923931
|
100
|
|
|
|
15535490
|
return (0) if ($c == -1); |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
# IPs are identical |
1361
|
0
|
|
|
|
|
0
|
return 0; |
1362
|
|
|
|
|
|
|
} |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1365
|
|
|
|
|
|
|
# Subroutine ip_binadd |
1366
|
|
|
|
|
|
|
# Purpose : Add two binary IPs |
1367
|
|
|
|
|
|
|
# Params : First binary IP, Last binary Ip |
1368
|
|
|
|
|
|
|
# Returns : Binary sum or undef (problem) |
1369
|
|
|
|
|
|
|
sub ip_binadd { |
1370
|
36059
|
|
|
36059
|
1
|
64599
|
my ($b, $e) = @_; |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
# Check IP length |
1373
|
36059
|
50
|
|
|
|
91289
|
unless (length($b) eq length($e)) { |
1374
|
0
|
|
|
|
|
0
|
$ERROR = "IP addresses of different length\n"; |
1375
|
0
|
|
|
|
|
0
|
$ERRNO = 130; |
1376
|
0
|
|
|
|
|
0
|
return; |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
# Reverse the two IPs |
1380
|
36059
|
|
|
|
|
60136
|
$b = scalar(reverse $b); |
1381
|
36059
|
|
|
|
|
55931
|
$e = scalar(reverse $e); |
1382
|
|
|
|
|
|
|
|
1383
|
36059
|
|
|
|
|
55598
|
my ($carry, $result, $c) = (0); |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
# Foreach bit (reversed) |
1386
|
36059
|
|
|
|
|
82534
|
for (0 .. length($b) - 1) { |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
# add the two bits plus the carry |
1389
|
3844480
|
|
|
|
|
5556288
|
$c = substr($b, $_, 1) + substr($e, $_, 1) + $carry; |
1390
|
3844480
|
|
|
|
|
3748148
|
$carry = 0; |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
# sum = 0 => $c = 0, $carry = 0 |
1393
|
|
|
|
|
|
|
# sum = 1 => $c = 1, $carry = 0 |
1394
|
|
|
|
|
|
|
# sum = 2 => $c = 0, $carry = 1 |
1395
|
|
|
|
|
|
|
# sum = 3 => $c = 1, $carry = 1 |
1396
|
3844480
|
100
|
|
|
|
6974547
|
if ($c > 1) { |
1397
|
40593
|
|
|
|
|
40943
|
$c -= 2; |
1398
|
40593
|
|
|
|
|
48993
|
$carry = 1; |
1399
|
|
|
|
|
|
|
} |
1400
|
|
|
|
|
|
|
|
1401
|
3844480
|
|
|
|
|
4949633
|
$result .= $c; |
1402
|
|
|
|
|
|
|
} |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
# Reverse result |
1405
|
36059
|
|
|
|
|
112773
|
return scalar(reverse($result)); |
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1409
|
|
|
|
|
|
|
# Subroutine ip_get_prefix_length |
1410
|
|
|
|
|
|
|
# Purpose : Get the prefix length for a given range of IPs |
1411
|
|
|
|
|
|
|
# Params : First binary IP, Last binary IP |
1412
|
|
|
|
|
|
|
# Returns : Length of prefix or undef (problem) |
1413
|
|
|
|
|
|
|
sub ip_get_prefix_length { |
1414
|
36055
|
|
|
36055
|
1
|
70488
|
my ($bin1, $bin2) = @_; |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
# Check length of IPs |
1417
|
36055
|
50
|
|
|
|
126180
|
unless (length($bin1) eq length($bin2)) { |
1418
|
0
|
|
|
|
|
0
|
$ERROR = "IP addresses of different length\n"; |
1419
|
0
|
|
|
|
|
0
|
$ERRNO = 130; |
1420
|
0
|
|
|
|
|
0
|
return; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
# reverse IPs |
1424
|
36055
|
|
|
|
|
64806
|
$bin1 = scalar(reverse $bin1); |
1425
|
36055
|
|
|
|
|
76003
|
$bin2 = scalar(reverse $bin2); |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
# foreach bit |
1428
|
36055
|
|
|
|
|
79028
|
for (0 .. length($bin1) - 1) { |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
# If bits are equal it means we have reached the longest prefix |
1431
|
36577
|
100
|
|
|
|
185378
|
return ("$_") if (substr($bin1, $_, 1) eq substr($bin2, $_, 1)); |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
# Return 32 (IPv4) or 128 (IPv6) |
1436
|
0
|
|
|
|
|
0
|
return length($bin1); |
1437
|
|
|
|
|
|
|
} |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1440
|
|
|
|
|
|
|
# Subroutine ip_range_to_prefix |
1441
|
|
|
|
|
|
|
# Purpose : Return all prefixes between two IPs |
1442
|
|
|
|
|
|
|
# Params : First IP, Last IP, IP version |
1443
|
|
|
|
|
|
|
# Returns : List of Prefixes or undef (problem) |
1444
|
|
|
|
|
|
|
sub ip_range_to_prefix { |
1445
|
36041
|
|
|
36041
|
1
|
60127
|
my ($binip, $endbinip, $ip_version) = @_; |
1446
|
|
|
|
|
|
|
|
1447
|
36041
|
50
|
|
|
|
77516
|
unless ($ip_version) { |
1448
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version"; |
1449
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1450
|
0
|
|
|
|
|
0
|
return; |
1451
|
|
|
|
|
|
|
} |
1452
|
|
|
|
|
|
|
|
1453
|
36041
|
50
|
|
|
|
102327
|
unless (length($binip) eq length($endbinip)) { |
1454
|
0
|
|
|
|
|
0
|
$ERROR = "IP addresses of different length\n"; |
1455
|
0
|
|
|
|
|
0
|
$ERRNO = 130; |
1456
|
0
|
|
|
|
|
0
|
return; |
1457
|
|
|
|
|
|
|
} |
1458
|
|
|
|
|
|
|
|
1459
|
36041
|
|
|
|
|
40820
|
my ($len, $nbits, $current, $add, @prefix); |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
# 1 in binary |
1462
|
36041
|
|
|
|
|
71971
|
my $one = ('0' x (ip_iplengths($ip_version) - 1)) . '1'; |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
# While we have not reached the last IP |
1465
|
36041
|
|
|
|
|
79258
|
while (ip_bincomp($binip, 'le', $endbinip) == 1) { |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
# Find all 0s at the end |
1468
|
36055
|
100
|
|
|
|
405244
|
if ($binip =~ m/(0+)$/) { |
1469
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
# nbits = nb of 0 bits |
1471
|
18041
|
|
|
|
|
40024
|
$nbits = length($1); |
1472
|
|
|
|
|
|
|
} |
1473
|
|
|
|
|
|
|
else { |
1474
|
18014
|
|
|
|
|
28362
|
$nbits = 0; |
1475
|
|
|
|
|
|
|
} |
1476
|
|
|
|
|
|
|
|
1477
|
36055
|
|
|
|
|
42454
|
do { |
1478
|
77283
|
|
|
|
|
123443
|
$current = $binip; |
1479
|
77283
|
|
|
|
|
116125
|
$add = '1' x $nbits; |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
# Replace $nbits 0s with 1s |
1482
|
77283
|
|
|
|
|
1273707
|
$current =~ s/0{$nbits}$/$add/; |
1483
|
77283
|
|
|
|
|
256789
|
$nbits--; |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
# Decrease $nbits if $current >= $endbinip |
1486
|
|
|
|
|
|
|
} while (ip_bincomp($current, 'le', $endbinip) != 1); |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
# Find Prefix length |
1489
|
36055
|
|
|
|
|
78228
|
$len = |
1490
|
|
|
|
|
|
|
(ip_iplengths($ip_version)) - ip_get_prefix_length($binip, $current); |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
# Push prefix in list |
1493
|
36055
|
|
|
|
|
97754
|
push(@prefix, ip_bintoip($binip, $ip_version) . "/$len"); |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
# Add 1 to current IP |
1496
|
36055
|
|
|
|
|
117076
|
$binip = ip_binadd($current, $one); |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
# Exit if IP is 32/128 1s |
1499
|
36055
|
100
|
|
|
|
169505
|
last if ($current =~ m/^1+$/); |
1500
|
|
|
|
|
|
|
} |
1501
|
|
|
|
|
|
|
|
1502
|
36041
|
|
|
|
|
165576
|
return (@prefix); |
1503
|
|
|
|
|
|
|
} |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1506
|
|
|
|
|
|
|
# Subroutine ip_compress_v4_prefix |
1507
|
|
|
|
|
|
|
# Purpose : Compress an IPv4 Prefix |
1508
|
|
|
|
|
|
|
# Params : IP, Prefix length |
1509
|
|
|
|
|
|
|
# Returns : Compressed IP - ie: 194.5 |
1510
|
|
|
|
|
|
|
sub ip_compress_v4_prefix { |
1511
|
8003
|
|
|
8003
|
1
|
11175
|
my ($ip, $len) = @_; |
1512
|
|
|
|
|
|
|
|
1513
|
8003
|
|
|
|
|
28798
|
my @quads = split /\./, $ip; |
1514
|
|
|
|
|
|
|
|
1515
|
8003
|
|
|
|
|
19136
|
my $qlen = int(($len - 1) / 8); |
1516
|
|
|
|
|
|
|
|
1517
|
8003
|
50
|
|
|
|
15902
|
$qlen = 0 if ($qlen < 0); |
1518
|
|
|
|
|
|
|
|
1519
|
8003
|
|
|
|
|
21945
|
my $newip = join '.', @quads[ 0 .. $qlen ]; |
1520
|
|
|
|
|
|
|
|
1521
|
8003
|
|
|
|
|
28552
|
return ($newip); |
1522
|
|
|
|
|
|
|
} |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1525
|
|
|
|
|
|
|
# Subroutine ip_compress_address |
1526
|
|
|
|
|
|
|
# Purpose : Compress an IPv6 address |
1527
|
|
|
|
|
|
|
# Params : IP, IP version |
1528
|
|
|
|
|
|
|
# Returns : Compressed IP or undef (problem) |
1529
|
|
|
|
|
|
|
sub ip_compress_address { |
1530
|
28009
|
|
|
28009
|
1
|
45156
|
my ($ip, $ip_version) = @_; |
1531
|
|
|
|
|
|
|
|
1532
|
28009
|
50
|
|
|
|
75140
|
unless ($ip_version) { |
1533
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version for $ip"; |
1534
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1535
|
0
|
|
|
|
|
0
|
return; |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
# Just return if IP is IPv4 |
1539
|
28009
|
50
|
|
|
|
73327
|
return ($ip) if ($ip_version == 4); |
1540
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
# already compressed addresses must be expanded first |
1542
|
28009
|
|
|
|
|
60136
|
$ip = ip_expand_address( $ip, $ip_version); |
1543
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
# Remove leading 0s: 0034 -> 34; 0000 -> 0 |
1545
|
28009
|
|
|
|
|
390905
|
$ip =~ s/ |
1546
|
|
|
|
|
|
|
(^|:) # Find beginning or ':' -> $1 |
1547
|
|
|
|
|
|
|
0+ # 1 or several 0s |
1548
|
|
|
|
|
|
|
(?= # Look-ahead |
1549
|
|
|
|
|
|
|
[a-fA-F\d]+ # One or several Hexs |
1550
|
|
|
|
|
|
|
(?::|$)) # ':' or end |
1551
|
|
|
|
|
|
|
/$1/gx; |
1552
|
|
|
|
|
|
|
|
1553
|
28009
|
|
|
|
|
46128
|
my $reg = ''; |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
# Find the longuest :0:0: sequence |
1556
|
28009
|
|
|
|
|
100852
|
while ( |
1557
|
|
|
|
|
|
|
$ip =~ m/ |
1558
|
|
|
|
|
|
|
((?:^|:) # Find beginning or ':' -> $1 |
1559
|
|
|
|
|
|
|
0(?::0)+ # 0 followed by 1 or several ':0' |
1560
|
|
|
|
|
|
|
(?::|$)) # ':' or end |
1561
|
|
|
|
|
|
|
/gx |
1562
|
|
|
|
|
|
|
) |
1563
|
|
|
|
|
|
|
{ |
1564
|
2037
|
100
|
|
|
|
10248
|
$reg = $1 if (length($reg) < length($1)); |
1565
|
|
|
|
|
|
|
} |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
# Replace sequence by '::' |
1568
|
28009
|
100
|
|
|
|
86737
|
$ip =~ s/$reg/::/ if ($reg ne ''); |
1569
|
|
|
|
|
|
|
|
1570
|
28009
|
|
|
|
|
72577
|
return $ip; |
1571
|
|
|
|
|
|
|
} |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1574
|
|
|
|
|
|
|
# Subroutine ip_is_overlap |
1575
|
|
|
|
|
|
|
# Purpose : Check if two ranges overlap |
1576
|
|
|
|
|
|
|
# Params : Four binary IPs (begin of range 1,end1,begin2,end2) |
1577
|
|
|
|
|
|
|
# Returns : $NO_OVERLAP (no overlap) |
1578
|
|
|
|
|
|
|
# $IP_PARTIAL_OVERLAP (overlap) |
1579
|
|
|
|
|
|
|
# $IP_A_IN_B_OVERLAP (range1 is included in range2) |
1580
|
|
|
|
|
|
|
# $IP_B_IN_A_OVERLAP (range2 is included in range1) |
1581
|
|
|
|
|
|
|
# $IP_IDENTICAL (range1 == range2) |
1582
|
|
|
|
|
|
|
# or undef (problem) |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
sub ip_is_overlap { |
1585
|
2
|
|
|
2
|
1
|
6
|
my ($b1, $e1, $b2, $e2) = (@_); |
1586
|
|
|
|
|
|
|
|
1587
|
2
|
|
|
|
|
4
|
my $swap; |
1588
|
2
|
|
|
|
|
4
|
$swap = 0; |
1589
|
|
|
|
|
|
|
|
1590
|
2
|
50
|
33
|
|
|
34
|
unless ((length($b1) eq length($e1)) |
|
|
|
33
|
|
|
|
|
1591
|
|
|
|
|
|
|
and (length($b2) eq length($e2)) |
1592
|
|
|
|
|
|
|
and (length($b1) eq length($b2))) |
1593
|
|
|
|
|
|
|
{ |
1594
|
0
|
|
|
|
|
0
|
$ERROR = "IP addresses of different length\n"; |
1595
|
0
|
|
|
|
|
0
|
$ERRNO = 130; |
1596
|
0
|
|
|
|
|
0
|
return; |
1597
|
|
|
|
|
|
|
} |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
# begin1 <= end1 ? |
1600
|
2
|
50
|
|
|
|
21
|
unless (ip_bincomp($b1, 'le', $e1) == 1) { |
1601
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid range $b1 - $e1"; |
1602
|
0
|
|
|
|
|
0
|
$ERRNO = 140; |
1603
|
0
|
|
|
|
|
0
|
return; |
1604
|
|
|
|
|
|
|
} |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
# begin2 <= end2 ? |
1607
|
2
|
50
|
|
|
|
16
|
unless (ip_bincomp($b2, 'le', $e2) == 1) { |
1608
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid range $b2 - $e2"; |
1609
|
0
|
|
|
|
|
0
|
$ERRNO = 140; |
1610
|
0
|
|
|
|
|
0
|
return; |
1611
|
|
|
|
|
|
|
} |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
# b1 == b2 ? |
1614
|
2
|
50
|
|
|
|
10
|
if ($b1 eq $b2) { |
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
# e1 == e2 |
1617
|
0
|
0
|
|
|
|
0
|
return ($IP_IDENTICAL) if ($e1 eq $e2); |
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
# e1 < e2 ? |
1620
|
|
|
|
|
|
|
return ( |
1621
|
0
|
0
|
|
|
|
0
|
ip_bincomp($e1, 'lt', $e2) |
1622
|
|
|
|
|
|
|
? $IP_A_IN_B_OVERLAP |
1623
|
|
|
|
|
|
|
: $IP_B_IN_A_OVERLAP |
1624
|
|
|
|
|
|
|
); |
1625
|
|
|
|
|
|
|
} |
1626
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
# e1 == e2 ? |
1628
|
2
|
50
|
|
|
|
8
|
if ($e1 eq $e2) { |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
# b1 < b2 |
1631
|
|
|
|
|
|
|
return ( |
1632
|
0
|
0
|
|
|
|
0
|
ip_bincomp($b1, 'lt', $b2) |
1633
|
|
|
|
|
|
|
? $IP_B_IN_A_OVERLAP |
1634
|
|
|
|
|
|
|
: $IP_A_IN_B_OVERLAP |
1635
|
|
|
|
|
|
|
); |
1636
|
|
|
|
|
|
|
} |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
# b1 < b2 |
1639
|
2
|
100
|
|
|
|
8
|
if ((ip_bincomp($b1, 'lt', $b2) == 1)) { |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
# e1 < b2 |
1642
|
1
|
50
|
|
|
|
3
|
return ($IP_NO_OVERLAP) if (ip_bincomp($e1, 'lt', $b2) == 1); |
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
# e1 < e2 ? |
1645
|
|
|
|
|
|
|
return ( |
1646
|
1
|
50
|
|
|
|
3
|
ip_bincomp($e1, 'lt', $e2) |
1647
|
|
|
|
|
|
|
? $IP_PARTIAL_OVERLAP |
1648
|
|
|
|
|
|
|
: $IP_B_IN_A_OVERLAP |
1649
|
|
|
|
|
|
|
); |
1650
|
|
|
|
|
|
|
} |
1651
|
|
|
|
|
|
|
else # b1 > b2 |
1652
|
|
|
|
|
|
|
{ |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
# e2 < b1 |
1655
|
1
|
50
|
|
|
|
4
|
return ($IP_NO_OVERLAP) if (ip_bincomp($e2, 'lt', $b1) == 1); |
1656
|
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
# e2 < e1 ? |
1658
|
|
|
|
|
|
|
return ( |
1659
|
0
|
0
|
|
|
|
0
|
ip_bincomp($e2, 'lt', $e1) |
1660
|
|
|
|
|
|
|
? $IP_PARTIAL_OVERLAP |
1661
|
|
|
|
|
|
|
: $IP_A_IN_B_OVERLAP |
1662
|
|
|
|
|
|
|
); |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1667
|
|
|
|
|
|
|
# Subroutine get_embedded_ipv4 |
1668
|
|
|
|
|
|
|
# Purpose : Get an IPv4 embedded in an IPv6 address |
1669
|
|
|
|
|
|
|
# Params : IPv6 |
1670
|
|
|
|
|
|
|
# Returns : IPv4 or undef (not found) |
1671
|
|
|
|
|
|
|
sub ip_get_embedded_ipv4 { |
1672
|
0
|
|
|
0
|
1
|
0
|
my $ipv6 = shift; |
1673
|
|
|
|
|
|
|
|
1674
|
0
|
|
|
|
|
0
|
my @ip = split /:/, $ipv6; |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
# Bugfix by Norbert Koch |
1677
|
0
|
0
|
|
|
|
0
|
return unless (@ip); |
1678
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
# last octet should be ipv4 |
1680
|
0
|
0
|
|
|
|
0
|
return ($ip[-1]) if (ip_is_ipv4($ip[-1])); |
1681
|
|
|
|
|
|
|
|
1682
|
0
|
|
|
|
|
0
|
return; |
1683
|
|
|
|
|
|
|
} |
1684
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1686
|
|
|
|
|
|
|
# Subroutine aggregate |
1687
|
|
|
|
|
|
|
# Purpose : Aggregate 2 ranges |
1688
|
|
|
|
|
|
|
# Params : 1st range (1st IP, Last IP), last range (1st IP, last IP), |
1689
|
|
|
|
|
|
|
# IP version |
1690
|
|
|
|
|
|
|
# Returns : prefix or undef (invalid) |
1691
|
|
|
|
|
|
|
sub ip_aggregate { |
1692
|
2
|
|
|
2
|
1
|
5
|
my ($binbip1, $bineip1, $binbip2, $bineip2, $ip_version) = @_; |
1693
|
|
|
|
|
|
|
|
1694
|
2
|
50
|
|
|
|
16
|
unless ($ip_version) { |
1695
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version for $binbip1"; |
1696
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1697
|
0
|
|
|
|
|
0
|
return; |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
# Bin 1 |
1701
|
2
|
|
|
|
|
19
|
my $one = (('0' x (ip_iplengths($ip_version) - 1)) . '1'); |
1702
|
|
|
|
|
|
|
|
1703
|
|
|
|
|
|
|
# $eip1 + 1 = $bip2 ? |
1704
|
2
|
50
|
|
|
|
7
|
unless (ip_binadd($bineip1, $one) eq $binbip2) { |
1705
|
0
|
|
|
|
|
0
|
$ERROR = "Ranges not contiguous - $bineip1 - $binbip2"; |
1706
|
0
|
|
|
|
|
0
|
$ERRNO = 160; |
1707
|
0
|
|
|
|
|
0
|
return; |
1708
|
|
|
|
|
|
|
} |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
# Get ranges |
1711
|
2
|
|
|
|
|
7
|
my @prefix = ip_range_to_prefix($binbip1, $bineip2, $ip_version); |
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
# There should be only one range |
1714
|
2
|
50
|
|
|
|
12
|
return if scalar(@prefix) < 1; |
1715
|
|
|
|
|
|
|
|
1716
|
2
|
50
|
|
|
|
22
|
if (scalar(@prefix) > 1) { |
1717
|
0
|
|
|
|
|
0
|
$ERROR = "$binbip1 - $bineip2 is not a single prefix"; |
1718
|
0
|
|
|
|
|
0
|
$ERRNO = 161; |
1719
|
0
|
|
|
|
|
0
|
return; |
1720
|
|
|
|
|
|
|
} |
1721
|
2
|
|
|
|
|
10
|
return ($prefix[0]); |
1722
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
} |
1724
|
|
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1726
|
|
|
|
|
|
|
# Subroutine ip_iptype |
1727
|
|
|
|
|
|
|
# Purpose : Return the type of an IP (Public, Private, Reserved) |
1728
|
|
|
|
|
|
|
# Params : IP to test, IP version |
1729
|
|
|
|
|
|
|
# Returns : type or undef (invalid) |
1730
|
|
|
|
|
|
|
sub ip_iptype { |
1731
|
36010
|
|
|
36010
|
1
|
63361
|
my ($ip, $ip_version) = @_; |
1732
|
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
# handle known ip versions |
1734
|
36010
|
100
|
|
|
|
110221
|
return ip_iptypev4($ip) if $ip_version == 4; |
1735
|
28007
|
50
|
|
|
|
88511
|
return ip_iptypev6($ip) if $ip_version == 6; |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
# unsupported ip version |
1738
|
0
|
|
|
|
|
0
|
$ERROR = "IP version $ip not supported"; |
1739
|
0
|
|
|
|
|
0
|
$ERRNO = 180; |
1740
|
0
|
|
|
|
|
0
|
return; |
1741
|
|
|
|
|
|
|
} |
1742
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1744
|
|
|
|
|
|
|
# Subroutine ip_iptypev4 |
1745
|
|
|
|
|
|
|
# Purpose : Return the type of an IP (Public, Private, Reserved) |
1746
|
|
|
|
|
|
|
# Params : IP to test, IP version |
1747
|
|
|
|
|
|
|
# Returns : type or undef (invalid) |
1748
|
|
|
|
|
|
|
sub ip_iptypev4 { |
1749
|
8003
|
|
|
8003
|
1
|
9074
|
my ($ip) = @_; |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
# check ip |
1752
|
8003
|
50
|
|
|
|
25023
|
if ($ip !~ m/^[01]{1,32}$/) { |
1753
|
0
|
|
|
|
|
0
|
$ERROR = "$ip is not a binary IPv4 address $ip"; |
1754
|
0
|
|
|
|
|
0
|
$ERRNO = 180; |
1755
|
0
|
|
|
|
|
0
|
return; |
1756
|
|
|
|
|
|
|
} |
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
# see if IP is listed |
1759
|
8003
|
|
|
|
|
50595
|
foreach (sort { length($b) <=> length($a) } keys %IPv4ranges) { |
|
376141
|
|
|
|
|
406823
|
|
1760
|
117533
|
100
|
|
|
|
1111078
|
return ($IPv4ranges{$_}) if ($ip =~ m/^$_/); |
1761
|
|
|
|
|
|
|
} |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
# not listed means IP is public |
1764
|
3901
|
|
|
|
|
13973
|
return 'PUBLIC'; |
1765
|
|
|
|
|
|
|
} |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1768
|
|
|
|
|
|
|
# Subroutine ip_iptypev6 |
1769
|
|
|
|
|
|
|
# Purpose : Return the type of an IP (Public, Private, Reserved) |
1770
|
|
|
|
|
|
|
# Params : IP to test, IP version |
1771
|
|
|
|
|
|
|
# Returns : type or undef (invalid) |
1772
|
|
|
|
|
|
|
sub ip_iptypev6 { |
1773
|
28007
|
|
|
28007
|
1
|
40258
|
my ($ip) = @_; |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
# check ip |
1776
|
28007
|
50
|
|
|
|
124758
|
if ($ip !~ m/^[01]{1,128}$/) { |
1777
|
0
|
|
|
|
|
0
|
$ERROR = "$ip is not a binary IPv6 address"; |
1778
|
0
|
|
|
|
|
0
|
$ERRNO = 180; |
1779
|
0
|
|
|
|
|
0
|
return; |
1780
|
|
|
|
|
|
|
} |
1781
|
|
|
|
|
|
|
|
1782
|
28007
|
|
|
|
|
7665894
|
foreach (sort { length($b) <=> length($a) } keys %IPv6ranges) { |
|
2968742
|
|
|
|
|
4219408
|
|
1783
|
450035
|
100
|
|
|
|
45913613
|
return ($IPv6ranges{$_}) if ($ip =~ m/^$_/); |
1784
|
|
|
|
|
|
|
} |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
# How did we get here? All IPv6 addresses should match |
1787
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine type for $ip"; |
1788
|
0
|
|
|
|
|
0
|
$ERRNO = 180; |
1789
|
0
|
|
|
|
|
0
|
return; |
1790
|
|
|
|
|
|
|
} |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1793
|
|
|
|
|
|
|
# Subroutine ip_check_prefix |
1794
|
|
|
|
|
|
|
# Purpose : Check the validity of a prefix |
1795
|
|
|
|
|
|
|
# Params : binary IP, length of prefix, IP version |
1796
|
|
|
|
|
|
|
# Returns : 1 or undef (invalid) |
1797
|
|
|
|
|
|
|
sub ip_check_prefix { |
1798
|
36052
|
|
|
36052
|
1
|
86461
|
my ($binip, $len, $ipversion) = (@_); |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
# Check if len is longer than IP |
1801
|
36052
|
50
|
|
|
|
109765
|
if ($len > length($binip)) { |
1802
|
0
|
|
|
|
|
0
|
$ERROR = |
1803
|
|
|
|
|
|
|
"Prefix length $len is longer than IP address (" |
1804
|
|
|
|
|
|
|
. length($binip) . ")"; |
1805
|
0
|
|
|
|
|
0
|
$ERRNO = 170; |
1806
|
0
|
|
|
|
|
0
|
return; |
1807
|
|
|
|
|
|
|
} |
1808
|
|
|
|
|
|
|
|
1809
|
36052
|
|
|
|
|
73138
|
my $rest = substr($binip, $len); |
1810
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
# Check if last part of the IP (len part) has only 0s |
1812
|
36052
|
100
|
|
|
|
158618
|
unless ($rest =~ /^0*$/) { |
1813
|
1
|
|
|
|
|
4
|
$ERROR = "Invalid prefix $binip/$len"; |
1814
|
1
|
|
|
|
|
3
|
$ERRNO = 171; |
1815
|
1
|
|
|
|
|
5
|
return; |
1816
|
|
|
|
|
|
|
} |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
# Check if prefix length is correct |
1819
|
36051
|
50
|
|
|
|
77747
|
unless (length($rest) + $len == ip_iplengths($ipversion)) { |
1820
|
0
|
|
|
|
|
0
|
$ERROR = "Invalid prefix length /$len"; |
1821
|
0
|
|
|
|
|
0
|
$ERRNO = 172; |
1822
|
0
|
|
|
|
|
0
|
return; |
1823
|
|
|
|
|
|
|
} |
1824
|
|
|
|
|
|
|
|
1825
|
36051
|
|
|
|
|
126017
|
return 1; |
1826
|
|
|
|
|
|
|
} |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1829
|
|
|
|
|
|
|
# Subroutine ip_reverse |
1830
|
|
|
|
|
|
|
# Purpose : Get a reverse name from a prefix |
1831
|
|
|
|
|
|
|
# Comments : From Lee's iplib.pm |
1832
|
|
|
|
|
|
|
# Params : IP, length of prefix, IP version |
1833
|
|
|
|
|
|
|
# Returns : Reverse name or undef (error) |
1834
|
|
|
|
|
|
|
sub ip_reverse { |
1835
|
4
|
|
|
4
|
1
|
10
|
my ($ip, $len, $ip_version) = (@_); |
1836
|
|
|
|
|
|
|
|
1837
|
4
|
|
33
|
|
|
13
|
$ip_version ||= ip_get_version($ip); |
1838
|
4
|
50
|
|
|
|
13
|
unless ($ip_version) { |
1839
|
0
|
|
|
|
|
0
|
$ERROR = "Cannot determine IP version for $ip"; |
1840
|
0
|
|
|
|
|
0
|
$ERRNO = 101; |
1841
|
0
|
|
|
|
|
0
|
return; |
1842
|
|
|
|
|
|
|
} |
1843
|
|
|
|
|
|
|
|
1844
|
4
|
100
|
|
|
|
23
|
if ($ip_version == 4) { |
|
|
50
|
|
|
|
|
|
1845
|
1
|
|
|
|
|
11
|
my @quads = split /\./, $ip; |
1846
|
1
|
|
|
|
|
4
|
my $no_quads = ($len / 8); |
1847
|
|
|
|
|
|
|
|
1848
|
1
|
|
|
|
|
4
|
my @reverse_quads = reverse @quads; |
1849
|
|
|
|
|
|
|
|
1850
|
1
|
|
66
|
|
|
10
|
while (@reverse_quads and $reverse_quads[0] == 0) { |
1851
|
1
|
|
|
|
|
5
|
shift(@reverse_quads); |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
|
1854
|
1
|
|
|
|
|
7
|
return join '.', @reverse_quads, 'in-addr', 'arpa.'; |
1855
|
|
|
|
|
|
|
} |
1856
|
|
|
|
|
|
|
elsif ($ip_version == 6) { |
1857
|
3
|
|
|
|
|
17
|
my @rev_groups = reverse split /:/, ip_expand_address($ip, 6); |
1858
|
3
|
|
|
|
|
7
|
my @result; |
1859
|
|
|
|
|
|
|
|
1860
|
3
|
|
|
|
|
9
|
foreach (@rev_groups) { |
1861
|
24
|
|
|
|
|
67
|
my @revhex = reverse split //; |
1862
|
24
|
|
|
|
|
71
|
push @result, @revhex; |
1863
|
|
|
|
|
|
|
} |
1864
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
# This takes the zone above if it's not exactly on a nibble |
1866
|
3
|
50
|
|
|
|
12
|
my $first_nibble_index = $len ? 32 - (int($len / 4)) : 0; |
1867
|
3
|
|
|
|
|
47
|
return join '.', @result[ $first_nibble_index .. $#result ], 'ip6', |
1868
|
|
|
|
|
|
|
'arpa.'; |
1869
|
|
|
|
|
|
|
} |
1870
|
|
|
|
|
|
|
} |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1873
|
|
|
|
|
|
|
# Subroutine ip_normalize |
1874
|
|
|
|
|
|
|
# Purpose : Normalize data to a range of IP addresses |
1875
|
|
|
|
|
|
|
# Params : IP or prefix or range |
1876
|
|
|
|
|
|
|
# Returns : ip1, ip2 (if range) or undef (error) |
1877
|
|
|
|
|
|
|
sub ip_normalize { |
1878
|
36039
|
|
|
36039
|
1
|
63598
|
my ($data) = shift; |
1879
|
|
|
|
|
|
|
|
1880
|
36039
|
|
|
|
|
46468
|
my $ipversion; |
1881
|
|
|
|
|
|
|
|
1882
|
36039
|
|
|
|
|
50238
|
my ($len, $ip, $ip2, $real_len, $first, $last, $curr_bin, $addcst, $clen); |
1883
|
|
|
|
|
|
|
|
1884
|
|
|
|
|
|
|
# Prefix |
1885
|
36039
|
100
|
|
|
|
202820
|
if ($data =~ m!^(\S+?)(/\S+)$!) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1886
|
19
|
|
|
|
|
71
|
($ip, $len) = ($1, $2); |
1887
|
|
|
|
|
|
|
|
1888
|
19
|
100
|
|
|
|
227
|
return unless ($ipversion = ip_get_version($ip)); |
1889
|
18
|
50
|
|
|
|
54
|
return unless ($ip = ip_expand_address($ip, $ipversion)); |
1890
|
18
|
50
|
|
|
|
49
|
return unless ($curr_bin = ip_iptobin($ip, $ipversion)); |
1891
|
|
|
|
|
|
|
|
1892
|
18
|
|
|
|
|
52
|
my $one = '0' x (ip_iplengths($ipversion) - 1) . '1'; |
1893
|
|
|
|
|
|
|
|
1894
|
18
|
|
|
|
|
46
|
while ($len) { |
1895
|
18
|
50
|
|
|
|
97
|
last unless ($len =~ s!^/(\d+)(\,|$)!!); |
1896
|
|
|
|
|
|
|
|
1897
|
18
|
|
|
|
|
48
|
$clen = $1; |
1898
|
18
|
|
|
|
|
40
|
$addcst = length($2) > 0; |
1899
|
|
|
|
|
|
|
|
1900
|
18
|
100
|
|
|
|
51
|
return unless (ip_check_prefix($curr_bin, $clen, $ipversion)); |
1901
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
return |
1903
|
17
|
50
|
|
|
|
51
|
unless ($curr_bin = |
1904
|
|
|
|
|
|
|
ip_last_address_bin($curr_bin, $clen, $ipversion)); |
1905
|
|
|
|
|
|
|
|
1906
|
17
|
50
|
|
|
|
59
|
if ($addcst) { |
1907
|
0
|
0
|
|
|
|
0
|
return unless ($curr_bin = ip_binadd($curr_bin, $one)); |
1908
|
|
|
|
|
|
|
} |
1909
|
|
|
|
|
|
|
} |
1910
|
|
|
|
|
|
|
|
1911
|
17
|
|
|
|
|
38
|
return ($ip, ip_bintoip($curr_bin, $ipversion)); |
1912
|
|
|
|
|
|
|
} |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
# Range |
1915
|
|
|
|
|
|
|
elsif ($data =~ /^(.+?)\s*\-\s*(.+)$/) { |
1916
|
4
|
|
|
|
|
26
|
($ip, $ip2) = ($1, $2); |
1917
|
|
|
|
|
|
|
|
1918
|
4
|
50
|
|
|
|
11
|
return unless ($ipversion = ip_get_version($ip)); |
1919
|
|
|
|
|
|
|
|
1920
|
4
|
50
|
|
|
|
29
|
return unless ($ip = ip_expand_address($ip, $ipversion)); |
1921
|
4
|
100
|
|
|
|
13
|
return unless ($ip2 = ip_expand_address($ip2, $ipversion)); |
1922
|
|
|
|
|
|
|
|
1923
|
3
|
|
|
|
|
16
|
return ($ip, $ip2); |
1924
|
|
|
|
|
|
|
} |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
# IP + Number |
1927
|
|
|
|
|
|
|
elsif ($data =~ /^(.+?)\s+\+\s+(.+)$/) { |
1928
|
0
|
|
|
|
|
0
|
($ip, $len) = ($1, $2); |
1929
|
|
|
|
|
|
|
|
1930
|
0
|
0
|
|
|
|
0
|
return unless ($ipversion = ip_get_version($ip)); |
1931
|
0
|
0
|
|
|
|
0
|
return unless ($ip = ip_expand_address($ip, $ipversion)); |
1932
|
|
|
|
|
|
|
|
1933
|
0
|
|
|
|
|
0
|
my ($bin_ip); |
1934
|
0
|
0
|
|
|
|
0
|
return unless ($bin_ip = ip_iptobin($ip, $ipversion)); |
1935
|
|
|
|
|
|
|
|
1936
|
0
|
0
|
|
|
|
0
|
return unless ($len = ip_inttobin($len, $ipversion)); |
1937
|
|
|
|
|
|
|
|
1938
|
0
|
0
|
|
|
|
0
|
return unless ($ip2 = ip_binadd($bin_ip, $len)); |
1939
|
0
|
0
|
|
|
|
0
|
return unless ($ip2 = ip_bintoip($ip2, $ipversion)); |
1940
|
|
|
|
|
|
|
|
1941
|
0
|
|
|
|
|
0
|
return ($ip, $ip2); |
1942
|
|
|
|
|
|
|
} |
1943
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
# Single IP |
1945
|
|
|
|
|
|
|
else { |
1946
|
36016
|
|
|
|
|
44129
|
$ip = $data; |
1947
|
|
|
|
|
|
|
|
1948
|
36016
|
50
|
|
|
|
83982
|
return unless ($ipversion = ip_get_version($ip)); |
1949
|
|
|
|
|
|
|
|
1950
|
36016
|
50
|
|
|
|
82328
|
return unless ($ip = ip_expand_address($ip, $ipversion)); |
1951
|
|
|
|
|
|
|
|
1952
|
36016
|
|
|
|
|
150288
|
return $ip; |
1953
|
|
|
|
|
|
|
} |
1954
|
|
|
|
|
|
|
} |
1955
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1957
|
|
|
|
|
|
|
# Subroutine normal_range |
1958
|
|
|
|
|
|
|
# Purpose : Return the normalized format of a range |
1959
|
|
|
|
|
|
|
# Params : IP or prefix or range |
1960
|
|
|
|
|
|
|
# Returns : "ip1 - ip2" or undef (error) |
1961
|
|
|
|
|
|
|
sub ip_normal_range { |
1962
|
0
|
|
|
0
|
0
|
|
my ($data) = shift; |
1963
|
|
|
|
|
|
|
|
1964
|
0
|
|
|
|
|
|
my ($ip1, $ip2) = ip_normalize($data); |
1965
|
|
|
|
|
|
|
|
1966
|
0
|
0
|
|
|
|
|
return unless ($ip1); |
1967
|
|
|
|
|
|
|
|
1968
|
0
|
|
0
|
|
|
|
$ip2 ||= $ip1; |
1969
|
|
|
|
|
|
|
|
1970
|
0
|
|
|
|
|
|
return ("$ip1 - $ip2"); |
1971
|
|
|
|
|
|
|
} |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1974
|
|
|
|
|
|
|
# Subroutine ip_auth |
1975
|
|
|
|
|
|
|
# Purpose : Get Authority information from IP::Authority Module |
1976
|
|
|
|
|
|
|
# Comments : Requires IP::Authority |
1977
|
|
|
|
|
|
|
# Params : IP, length of prefix |
1978
|
|
|
|
|
|
|
# Returns : Reverse name or undef (error) |
1979
|
|
|
|
|
|
|
sub ip_auth { |
1980
|
0
|
|
|
0
|
1
|
|
my ($ip, $ip_version) = (@_); |
1981
|
|
|
|
|
|
|
|
1982
|
0
|
0
|
|
|
|
|
unless ($ip_version) { |
1983
|
0
|
|
|
|
|
|
$ERROR = "Cannot determine IP version for $ip"; |
1984
|
0
|
|
|
|
|
|
$ERRNO = 101; |
1985
|
0
|
|
|
|
|
|
die; |
1986
|
0
|
|
|
|
|
|
return; |
1987
|
|
|
|
|
|
|
} |
1988
|
|
|
|
|
|
|
|
1989
|
0
|
0
|
|
|
|
|
if ($ip_version != 4) { |
1990
|
|
|
|
|
|
|
|
1991
|
0
|
|
|
|
|
|
$ERROR = "Cannot get auth information: Not an IPv4 address"; |
1992
|
0
|
|
|
|
|
|
$ERRNO = 308; |
1993
|
0
|
|
|
|
|
|
die; |
1994
|
0
|
|
|
|
|
|
return; |
1995
|
|
|
|
|
|
|
} |
1996
|
|
|
|
|
|
|
|
1997
|
0
|
|
|
|
|
|
require IP::Authority; |
1998
|
|
|
|
|
|
|
|
1999
|
0
|
|
|
|
|
|
my $reg = new IP::Authority; |
2000
|
|
|
|
|
|
|
|
2001
|
0
|
|
|
|
|
|
return ($reg->inet_atoauth($ip)); |
2002
|
|
|
|
|
|
|
} |
2003
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
1; |
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
__END__ |