|
Packit |
0b51a0 |
#!/usr/bin/perl -w
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
package NetAddr::IP;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use strict;
|
|
Packit |
0b51a0 |
#use diagnostics;
|
|
Packit |
0b51a0 |
use Carp;
|
|
Packit |
0b51a0 |
use NetAddr::IP::Lite 1.57 qw(Zero Zeros Ones V4mask V4net);
|
|
Packit |
0b51a0 |
use NetAddr::IP::Util 1.53 qw(
|
|
Packit |
0b51a0 |
sub128
|
|
Packit |
0b51a0 |
inet_aton
|
|
Packit |
0b51a0 |
inet_any2n
|
|
Packit |
0b51a0 |
ipv6_aton
|
|
Packit |
0b51a0 |
isIPv4
|
|
Packit |
0b51a0 |
ipv4to6
|
|
Packit |
0b51a0 |
mask4to6
|
|
Packit |
0b51a0 |
shiftleft
|
|
Packit |
0b51a0 |
addconst
|
|
Packit |
0b51a0 |
hasbits
|
|
Packit |
0b51a0 |
notcontiguous
|
|
Packit |
0b51a0 |
);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use AutoLoader qw(AUTOLOAD);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use vars qw(
|
|
Packit |
0b51a0 |
@EXPORT_OK
|
|
Packit |
0b51a0 |
@EXPORT_FAIL
|
|
Packit |
0b51a0 |
@ISA
|
|
Packit |
0b51a0 |
$VERSION
|
|
Packit |
0b51a0 |
$_netlimit
|
|
Packit |
0b51a0 |
$rfc3021
|
|
Packit |
0b51a0 |
);
|
|
Packit |
0b51a0 |
require Exporter;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
@EXPORT_OK = qw(Compact Coalesce Zero Zeros Ones V4mask V4net netlimit);
|
|
Packit |
0b51a0 |
@EXPORT_FAIL = qw($_netlimit);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
@ISA = qw(Exporter NetAddr::IP::Lite);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.79 $ =~ /\d+/g) };
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
$rfc3021 = 0;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=encoding UTF-8
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 NAME
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NetAddr::IP - Manages IPv4 and IPv6 addresses and subnets
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 SYNOPSIS
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(
|
|
Packit |
0b51a0 |
Compact
|
|
Packit |
0b51a0 |
Coalesce
|
|
Packit |
0b51a0 |
Zeros
|
|
Packit |
0b51a0 |
Ones
|
|
Packit |
0b51a0 |
V4mask
|
|
Packit |
0b51a0 |
V4net
|
|
Packit |
0b51a0 |
netlimit
|
|
Packit |
0b51a0 |
:aton DEPRECATED
|
|
Packit |
0b51a0 |
:lower
|
|
Packit |
0b51a0 |
:upper
|
|
Packit |
0b51a0 |
:old_storable
|
|
Packit |
0b51a0 |
:old_nth
|
|
Packit |
0b51a0 |
:rfc3021
|
|
Packit |
0b51a0 |
:nofqdn
|
|
Packit |
0b51a0 |
);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NOTE: NetAddr::IP::Util has a full complement of network address
|
|
Packit |
0b51a0 |
utilities to convert back and forth between binary and text.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
inet_aton, inet_ntoa, ipv6_aton, ipv6_ntoa
|
|
Packit |
0b51a0 |
ipv6_n2x, ipv6_n2d inet_any2d, inet_n2dx,
|
|
Packit |
0b51a0 |
inet_n2ad, inetanyto6, ipv6to4
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
See L<NetAddr::IP::Util>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $ip = new NetAddr::IP '127.0.0.1';
|
|
Packit |
0b51a0 |
or if you prefer
|
|
Packit |
0b51a0 |
my $ip = NetAddr::IP->new('127.0.0.1);
|
|
Packit |
0b51a0 |
or from a packed IPv4 address
|
|
Packit |
0b51a0 |
my $ip = new_from_aton NetAddr::IP (inet_aton('127.0.0.1'));
|
|
Packit |
0b51a0 |
or from an octal filtered IPv4 address
|
|
Packit |
0b51a0 |
my $ip = new_no NetAddr::IP '127.012.0.0';
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) {
|
|
Packit |
0b51a0 |
print "Is a loopback address\n";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# This prints 127.0.0.1/32
|
|
Packit |
0b51a0 |
print "You can also say $ip...\n";
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* The following four functions return ipV6 representations of:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
:: = Zeros();
|
|
Packit |
0b51a0 |
FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF = Ones();
|
|
Packit |
0b51a0 |
FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:: = V4mask();
|
|
Packit |
0b51a0 |
::FFFF:FFFF = V4net();
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Will also return an ipV4 or ipV6 representation of a
|
|
Packit |
0b51a0 |
resolvable Fully Qualified Domanin Name (FQDN).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
###### DEPRECATED, will be remove in version 5 ############
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* To accept addresses in the format as returned by
|
|
Packit |
0b51a0 |
inet_aton, invoke the module as:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(:aton);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
###### USE new_from_aton instead ##########################
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* To enable usage of legacy data files containing NetAddr::IP
|
|
Packit |
0b51a0 |
objects stored using the L<Storable> module.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(:old_storable);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* To compact many smaller subnets (see: C<$me-E<gt>compact($addr1,$addr2,...)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
@compacted_object_list = Compact(@object_list)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* Return a reference to list of C<NetAddr::IP> subnets of
|
|
Packit |
0b51a0 |
C<$masklen> mask length, when C<$number> or more addresses from
|
|
Packit |
0b51a0 |
C<@list_of_subnets> are found to be contained in said subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
$arrayref = Coalesce($masklen, $number, @list_of_subnets)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* By default B<NetAddr::IP> functions and methods return string IPv6
|
|
Packit |
0b51a0 |
addresses in uppercase. To change that to lowercase:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NOTE: the AUGUST 2010 RFC5952 states:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
4.3. Lowercase
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The characters "a", "b", "c", "d", "e", and "f" in an IPv6
|
|
Packit |
0b51a0 |
address MUST be represented in lowercase.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
It is recommended that all NEW applications using NetAddr::IP be
|
|
Packit |
0b51a0 |
invoked as shown on the next line.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(:lower);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* To ensure the current IPv6 string case behavior even if the default changes:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(:upper);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
* To set a limit on the size of B<nets> processed or returned by NetAddr::IP.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Set the maximum number of nets beyond which NetAddr::IP will return
|
|
Packit |
0b51a0 |
an error as a power of 2 (default 16 or 65536 nets). Each 2**16
|
|
Packit |
0b51a0 |
consumes approximately 4 megs of memory. A 2**20 consumes 64 megs of
|
|
Packit |
0b51a0 |
memory, A 2**24 consumes 1 gigabyte of memory.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(netlimit);
|
|
Packit |
0b51a0 |
netlimit 20;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The maximum B<netlimit> allowed is 2**24. Attempts to set limits below
|
|
Packit |
0b51a0 |
the default of 16 or above the maximum of 24 are ignored.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns true on success, otherwise C<undef>.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
$_netlimit = 2 ** 16; # default
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub netlimit($) {
|
|
Packit |
0b51a0 |
return undef unless $_[0];
|
|
Packit |
0b51a0 |
return undef if $_[0] =~ /\D/;
|
|
Packit |
0b51a0 |
return undef if $_[0] < 16;
|
|
Packit |
0b51a0 |
return undef if $_[0] > 24;
|
|
Packit |
0b51a0 |
$_netlimit = 2 ** $_[0];
|
|
Packit |
0b51a0 |
};
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 INSTALLATION
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Un-tar the distribution in an appropriate directory and type:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
perl Makefile.PL
|
|
Packit |
0b51a0 |
make
|
|
Packit |
0b51a0 |
make test
|
|
Packit |
0b51a0 |
make install
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
B<NetAddr::IP> depends on B<NetAddr::IP::Util> which installs by
|
|
Packit |
0b51a0 |
default with its primary functions compiled using Perl's XS extensions
|
|
Packit |
0b51a0 |
to build a C library. If you do not have a C complier available or
|
|
Packit |
0b51a0 |
would like the slower Pure Perl version for some other reason, then
|
|
Packit |
0b51a0 |
type:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
perl Makefile.PL -noxs
|
|
Packit |
0b51a0 |
make
|
|
Packit |
0b51a0 |
make test
|
|
Packit |
0b51a0 |
make install
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 DESCRIPTION
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This module provides an object-oriented abstraction on top of IP
|
|
Packit |
0b51a0 |
addresses or IP subnets that allows for easy manipulations. Version
|
|
Packit |
0b51a0 |
4.xx of NetAddr::IP will work with older versions of Perl and is
|
|
Packit |
0b51a0 |
compatible with Math::BigInt.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The internal representation of all IP objects is in 128 bit IPv6 notation.
|
|
Packit |
0b51a0 |
IPv4 and IPv6 objects may be freely mixed.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head2 Overloaded Operators
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Many operators have been overloaded, as described below:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
#############################################
|
|
Packit |
0b51a0 |
# These are the overload methods, placed here
|
|
Packit |
0b51a0 |
# for convenience.
|
|
Packit |
0b51a0 |
#############################################
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use overload
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
'@{}' => sub {
|
|
Packit |
0b51a0 |
return [ $_[0]->hostenum ];
|
|
Packit |
0b51a0 |
};
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=over
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Assignment (C<=>)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Has been optimized to copy one NetAddr::IP object to another very quickly.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<C<-E<gt>copy()>>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The B<assignment (C<=>)> operation is only put in to operation when the
|
|
Packit |
0b51a0 |
copied object is further mutated by another overloaded operation. See
|
|
Packit |
0b51a0 |
L<overload> B<SPECIAL SYMBOLS FOR "use overload"> for details.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
B<C<-E<gt>copy()>> actually creates a new object when called.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Stringification>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
An object can be used just as a string. For instance, the following code
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $ip = new NetAddr::IP '192.168.1.123';
|
|
Packit |
0b51a0 |
print "$ip\n";
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Will print the string 192.168.1.123/32.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Equality>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
You can test for equality with either C<eq> or C<==>. C<eq> allows
|
|
Packit |
0b51a0 |
comparison with arbitrary strings as well as NetAddr::IP objects. The
|
|
Packit |
0b51a0 |
following example:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
if (NetAddr::IP->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8')
|
|
Packit |
0b51a0 |
{ print "Yes\n"; }
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
will print out "Yes".
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Comparison with C<==> requires both operands to be NetAddr::IP objects.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
In both cases, a true value is returned if the CIDR representation of
|
|
Packit |
0b51a0 |
the operands is equal.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Comparison via E<gt>, E<lt>, E<gt>=, E<lt>=, E<lt>=E<gt> and C<cmp>>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Internally, all network objects are represented in 128 bit format.
|
|
Packit |
0b51a0 |
The numeric representation of the network is compared through the
|
|
Packit |
0b51a0 |
corresponding operation. Comparisons are tried first on the address portion
|
|
Packit |
0b51a0 |
of the object and if that is equal then the NUMERIC cidr portion of the
|
|
Packit |
0b51a0 |
masks are compared. This leads to the counterintuitive result that
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
/24 > /16
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Comparison should not be done on netaddr objects with different CIDR as
|
|
Packit |
0b51a0 |
this may produce indeterminate - unexpected results,
|
|
Packit |
0b51a0 |
rather the determination of which netblock is larger or smaller should be
|
|
Packit |
0b51a0 |
done by comparing
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
$ip1->masklen <=> $ip2->masklen
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Addition of a constant (C<+>)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Add a 32 bit signed constant to the address part of a NetAddr object.
|
|
Packit |
0b51a0 |
This operation changes the address part to point so many hosts above the
|
|
Packit |
0b51a0 |
current objects start address. For instance, this code:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
print NetAddr::IP->new('127.0.0.1/8') + 5;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
will output 127.0.0.6/8. The address will wrap around at the broadcast
|
|
Packit |
0b51a0 |
back to the network address. This code:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
print NetAddr::IP->new('10.0.0.1/24') + 255;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
outputs 10.0.0.0/24.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the the unchanged object when the constant is missing or out of
|
|
Packit |
0b51a0 |
range.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
2147483647 <= constant >= -2147483648
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Subtraction of a constant (C<->)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The complement of the addition of a constant.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Difference (C<->)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the difference between the address parts of two NetAddr::IP
|
|
Packit |
0b51a0 |
objects address parts as a 32 bit signed number.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns B<undef> if the difference is out of range.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
(See range restrictions on Addition above)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Auto-increment>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Auto-incrementing a NetAddr::IP object causes the address part to be
|
|
Packit |
0b51a0 |
adjusted to the next host address within the subnet. It will wrap at
|
|
Packit |
0b51a0 |
the broadcast address and start again from the network address.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item B<Auto-decrement>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Auto-decrementing a NetAddr::IP object performs exactly the opposite
|
|
Packit |
0b51a0 |
of auto-incrementing it, as you would expect.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
#############################################
|
|
Packit |
0b51a0 |
# End of the overload methods.
|
|
Packit |
0b51a0 |
#############################################
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# Preloaded methods go here.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=back
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head2 Serializing and Deserializing
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This module defines hooks to collaborate with L<Storable> for
|
|
Packit |
0b51a0 |
serializing C<NetAddr::IP> objects, through compact and human readable
|
|
Packit |
0b51a0 |
strings. You can revert to the old format by invoking this module as
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP ':old_storable';
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
You must do this if you have legacy data files containing NetAddr::IP
|
|
Packit |
0b51a0 |
objects stored using the L<Storable> module.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $full_format = "%04X:%04X:%04X:%04X:%04X:%04X:%D.%D.%D.%D";
|
|
Packit |
0b51a0 |
my $full6_format = "%04X:%04X:%04X:%04X:%04X:%04X:%04X:%04X";
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub import
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':old_storable' } @_) {
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':old_storable' } @_;
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
*{STORABLE_freeze} = sub
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
my $self = shift;
|
|
Packit |
0b51a0 |
return $self->cidr(); # use stringification
|
|
Packit |
0b51a0 |
};
|
|
Packit |
0b51a0 |
*{STORABLE_thaw} = sub
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
my $self = shift;
|
|
Packit |
0b51a0 |
my $cloning = shift; # Not used
|
|
Packit |
0b51a0 |
my $serial = shift;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $ip = new NetAddr::IP $serial;
|
|
Packit |
0b51a0 |
$self->{addr} = $ip->{addr};
|
|
Packit |
0b51a0 |
$self->{mask} = $ip->{mask};
|
|
Packit |
0b51a0 |
$self->{isv6} = $ip->{isv6};
|
|
Packit |
0b51a0 |
return;
|
|
Packit |
0b51a0 |
};
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':aton' } @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$NetAddr::IP::Lite::Accept_Binary_IP = 1;
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':aton' } @_;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':old_nth' } @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$NetAddr::IP::Lite::Old_nth = 1;
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':old_nth' } @_;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':nofqdn'} @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$NetAddr::IP::NetAddr::IP::Lite::NoFQDN = 1;
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':nofqdn' } @_;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':lower' } @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$full_format = lc($full_format);
|
|
Packit |
0b51a0 |
$full6_format = lc($full6_format);
|
|
Packit |
0b51a0 |
NetAddr::IP::Util::lower();
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':lower' } @_;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':upper' } @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$full_format = uc($full_format);
|
|
Packit |
0b51a0 |
$full6_format = uc($full6_format);
|
|
Packit |
0b51a0 |
NetAddr::IP::Util::upper();
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':upper' } @_;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if (grep { $_ eq ':rfc3021' } @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$rfc3021 = 1;
|
|
Packit |
0b51a0 |
@_ = grep { $_ ne ':rfc3021' } @_;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
NetAddr::IP->export_to_level(1, @_);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub compact {
|
|
Packit |
0b51a0 |
return (ref $_[0] eq 'ARRAY')
|
|
Packit |
0b51a0 |
? compactref($_[0]) # Compact(\@list)
|
|
Packit |
0b51a0 |
: @{compactref(\@_)}; # Compact(@list) or ->compact(@list)
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
*Compact = \&compact;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub Coalesce {
|
|
Packit |
0b51a0 |
return &coalesce;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub hostenumref($) {
|
|
Packit |
0b51a0 |
my $r = _splitref(0,$_[0]);
|
|
Packit |
0b51a0 |
unless ((notcontiguous($_[0]->{mask}))[1] == 128 ||
|
|
Packit |
0b51a0 |
($rfc3021 && $_[0]->masklen == 31) ) {
|
|
Packit |
0b51a0 |
splice(@$r, 0, 1);
|
|
Packit |
0b51a0 |
splice(@$r, scalar @$r - 1, 1);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
return $r;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub splitref {
|
|
Packit |
0b51a0 |
unshift @_, 0; # mark as no reverse
|
|
Packit |
0b51a0 |
# perl 5.8.4 fails with this operation. see perl bug [ 23429]
|
|
Packit |
0b51a0 |
# goto &_splitref;
|
|
Packit |
0b51a0 |
&_splitref;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub rsplitref {
|
|
Packit |
0b51a0 |
unshift @_, 1; # mark as reversed
|
|
Packit |
0b51a0 |
# perl 5.8.4 fails with this operation. see perl bug [ 23429]
|
|
Packit |
0b51a0 |
# goto &_splitref;
|
|
Packit |
0b51a0 |
&_splitref;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub split {
|
|
Packit |
0b51a0 |
unshift @_, 0; # mark as no reverse
|
|
Packit |
0b51a0 |
my $rv = &_splitref;
|
|
Packit |
0b51a0 |
return $rv ? @$rv : ();
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub rsplit {
|
|
Packit |
0b51a0 |
unshift @_, 1; # mark as reversed
|
|
Packit |
0b51a0 |
my $rv = &_splitref;
|
|
Packit |
0b51a0 |
return $rv ? @$rv : ();
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub full($) {
|
|
Packit |
0b51a0 |
if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
|
|
Packit |
0b51a0 |
my @hex = (unpack("n8",$_[0]->{addr}));
|
|
Packit |
0b51a0 |
$hex[9] = $hex[7] & 0xff;
|
|
Packit |
0b51a0 |
$hex[8] = $hex[7] >> 8;
|
|
Packit |
0b51a0 |
$hex[7] = $hex[6] & 0xff;
|
|
Packit |
0b51a0 |
$hex[6] >>= 8;
|
|
Packit |
0b51a0 |
return sprintf($full_format,@hex);
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
&full6;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub full6($) {
|
|
Packit |
0b51a0 |
my @hex = (unpack("n8",$_[0]->{addr}));
|
|
Packit |
0b51a0 |
return sprintf($full6_format,@hex);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub full6m($) {
|
|
Packit |
0b51a0 |
my @hex = (unpack("n8",$_[0]->{mask}));
|
|
Packit |
0b51a0 |
return sprintf($full6_format,@hex);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub DESTROY {};
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
1;
|
|
Packit |
0b51a0 |
__END__
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub do_prefix ($$$) {
|
|
Packit |
0b51a0 |
my $mask = shift;
|
|
Packit |
0b51a0 |
my $faddr = shift;
|
|
Packit |
0b51a0 |
my $laddr = shift;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
if ($mask > 24) {
|
|
Packit |
0b51a0 |
return "$faddr->[0].$faddr->[1].$faddr->[2].$faddr->[3]-$laddr->[3]";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($mask == 24) {
|
|
Packit |
0b51a0 |
return "$faddr->[0].$faddr->[1].$faddr->[2].";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($mask > 16) {
|
|
Packit |
0b51a0 |
return "$faddr->[0].$faddr->[1].$faddr->[2]-$laddr->[2].";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($mask == 16) {
|
|
Packit |
0b51a0 |
return "$faddr->[0].$faddr->[1].";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($mask > 8) {
|
|
Packit |
0b51a0 |
return "$faddr->[0].$faddr->[1]-$laddr->[1].";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($mask == 8) {
|
|
Packit |
0b51a0 |
return "$faddr->[0].";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else {
|
|
Packit |
0b51a0 |
return "$faddr->[0]-$laddr->[0]";
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head2 Methods
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=over
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>new([$addr, [ $mask|IPv6 ]])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>new6([$addr, [ $mask]])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>new_no([$addr, [ $mask]])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>new_from_aton($netaddr)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item new_cis and new_cis6 are DEPRECATED
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>new_cis("$addr $mask)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>new_cis6("$addr $mask)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The first two methods create a new address with the supplied address in
|
|
Packit |
0b51a0 |
C<$addr> and an optional netmask C<$mask>, which can be omitted to get
|
|
Packit |
0b51a0 |
a /32 or /128 netmask for IPv4 / IPv6 addresses respectively.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The third method C<new_no> is exclusively for IPv4 addresses and filters
|
|
Packit |
0b51a0 |
improperly formatted
|
|
Packit |
0b51a0 |
dot quad strings for leading 0's that would normally be interpreted as octal
|
|
Packit |
0b51a0 |
format by NetAddr per the specifications for inet_aton.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
B<new_from_aton> takes a packed IPv4 address and assumes a /32 mask. This
|
|
Packit |
0b51a0 |
function replaces the DEPRECATED :aton functionality which is fundamentally
|
|
Packit |
0b51a0 |
broken.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The last two methods B<new_cis> and B<new_cis6> differ from B<new> and
|
|
Packit |
0b51a0 |
B<new6> only in that they except the common Cisco address notation for
|
|
Packit |
0b51a0 |
address/mask pairs with a B<space> as a separator instead of a slash (/)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
These methods are DEPRECATED because the functionality is now included
|
|
Packit |
0b51a0 |
in the other "new" methods
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
i.e. ->new_cis('1.2.3.0 24')
|
|
Packit |
0b51a0 |
or
|
|
Packit |
0b51a0 |
->new_cis6('::1.2.3.0 120')
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
C<-E<gt>new6> and
|
|
Packit |
0b51a0 |
C<-E<gt>new_cis6> mark the address as being in ipV6 address space even
|
|
Packit |
0b51a0 |
if the format would suggest otherwise.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
i.e. ->new6('1.2.3.4') will result in ::102:304
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
addresses submitted to ->new in ipV6 notation will
|
|
Packit |
0b51a0 |
remain in that notation permanently. i.e.
|
|
Packit |
0b51a0 |
->new('::1.2.3.4') will result in ::102:304
|
|
Packit |
0b51a0 |
whereas new('1.2.3.4') would print out as 1.2.3.4
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
See "STRINGIFICATION" below.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
C<$addr> can be almost anything that can be resolved to an IP address
|
|
Packit |
0b51a0 |
in all the notations I have seen over time. It can optionally contain
|
|
Packit |
0b51a0 |
the mask in CIDR notation.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
B<prefix> notation is understood, with the limitation that the range
|
|
Packit |
0b51a0 |
specified by the prefix must match with a valid subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Addresses in the same format returned by C<inet_aton> or
|
|
Packit |
0b51a0 |
C<gethostbyname> can also be understood, although no mask can be
|
|
Packit |
0b51a0 |
specified for them. The default is to not attempt to recognize this
|
|
Packit |
0b51a0 |
format, as it seems to be seldom used.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
To accept addresses in that format, invoke the module as in
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP ':aton'
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
If called with no arguments, 'default' is assumed.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
If called with an empty string as the argument, returns 'undef'
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
C<$addr> can be any of the following and possibly more...
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
n.n
|
|
Packit |
0b51a0 |
n.n/mm
|
|
Packit |
0b51a0 |
n.n.n
|
|
Packit |
0b51a0 |
n.n.n/mm
|
|
Packit |
0b51a0 |
n.n.n.n
|
|
Packit |
0b51a0 |
n.n.n.n/mm 32 bit cidr notation
|
|
Packit |
0b51a0 |
n.n.n.n/m.m.m.m
|
|
Packit |
0b51a0 |
loopback, localhost, broadcast, any, default
|
|
Packit |
0b51a0 |
x.x.x.x/host
|
|
Packit |
0b51a0 |
0xABCDEF, 0b111111000101011110, (a bcd number)
|
|
Packit |
0b51a0 |
a netaddr as returned by 'inet_aton'
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Any RFC1884 notation
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
::n.n.n.n
|
|
Packit |
0b51a0 |
::n.n.n.n/mmm 128 bit cidr notation
|
|
Packit |
0b51a0 |
::n.n.n.n/::m.m.m.m
|
|
Packit |
0b51a0 |
::x:x
|
|
Packit |
0b51a0 |
::x:x/mmm
|
|
Packit |
0b51a0 |
x:x:x:x:x:x:x:x
|
|
Packit |
0b51a0 |
x:x:x:x:x:x:x:x/mmm
|
|
Packit |
0b51a0 |
x:x:x:x:x:x:x:x/m:m:m:m:m:m:m:m any RFC1884 notation
|
|
Packit |
0b51a0 |
loopback, localhost, unspecified, any, default
|
|
Packit |
0b51a0 |
::x:x/host
|
|
Packit |
0b51a0 |
0xABCDEF, 0b111111000101011110 within the limits
|
|
Packit |
0b51a0 |
of perl's number resolution
|
|
Packit |
0b51a0 |
123456789012 a 'big' bcd number (bigger than perl likes)
|
|
Packit |
0b51a0 |
and Math::BigInt
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
A Fully Qualified Domain Name which returns an ipV4 address or an ipV6
|
|
Packit |
0b51a0 |
address, embodied in that order. This previously undocumented feature
|
|
Packit |
0b51a0 |
may be disabled with:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP::Lite ':nofqdn';
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
If called with no arguments, 'default' is assumed.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
If called with an empty string as the argument, returns 'undef'
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>broadcast()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a new object referring to the broadcast address of a given
|
|
Packit |
0b51a0 |
subnet. The broadcast address has all ones in all the bit positions
|
|
Packit |
0b51a0 |
where the netmask has zero bits. This is normally used to address all
|
|
Packit |
0b51a0 |
the hosts in a given subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>network()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a new object referring to the network address of a given
|
|
Packit |
0b51a0 |
subnet. A network address has all zero bits where the bits of the
|
|
Packit |
0b51a0 |
netmask are zero. Normally this is used to refer to a subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>addr()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a scalar with the address part of the object as an IPv4 or IPv6 text
|
|
Packit |
0b51a0 |
string as appropriate. This is useful for printing or for passing the
|
|
Packit |
0b51a0 |
address part of the NetAddr::IP object to other components that expect an IP
|
|
Packit |
0b51a0 |
address. If the object is an ipV6 address or was created using ->new6($ip)
|
|
Packit |
0b51a0 |
it will be reported in ipV6 hex format otherwise it will be reported in dot
|
|
Packit |
0b51a0 |
quad format only if it resides in ipV4 address space.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>mask()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a scalar with the mask as an IPv4 or IPv6 text string as
|
|
Packit |
0b51a0 |
described above.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>masklen()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a scalar the number of one bits in the mask.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>bits()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the width of the address in bits. Normally 32 for v4 and 128 for v6.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>version()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the version of the address or subnet. Currently this can be
|
|
Packit |
0b51a0 |
either 4 or 6.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>cidr()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a scalar with the address and mask in CIDR notation. A
|
|
Packit |
0b51a0 |
NetAddr::IP object I<stringifies> to the result of this function.
|
|
Packit |
0b51a0 |
(see comments about ->new6() and ->addr() for output formats)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>aton()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the address part of the NetAddr::IP object in the same format
|
|
Packit |
0b51a0 |
as the C<inet_aton()> or C<ipv6_aton> function respectively. If the object
|
|
Packit |
0b51a0 |
was created using ->new6($ip), the address returned will always be in ipV6
|
|
Packit |
0b51a0 |
format, even for addresses in ipV4 address space.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>range()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a scalar with the base address and the broadcast address
|
|
Packit |
0b51a0 |
separated by a dash and spaces. This is called range notation.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>prefix()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a scalar with the address and mask in ipV4 prefix
|
|
Packit |
0b51a0 |
representation. This is useful for some programs, which expect its
|
|
Packit |
0b51a0 |
input to be in this format. This method will include the broadcast
|
|
Packit |
0b51a0 |
address in the encoding.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# only applicable to ipV4
|
|
Packit |
0b51a0 |
sub prefix($) {
|
|
Packit |
0b51a0 |
return undef if $_[0]->{isv6};
|
|
Packit |
0b51a0 |
my $mask = (notcontiguous($_[0]->{mask}))[1];
|
|
Packit |
0b51a0 |
return $_[0]->addr if $mask == 128;
|
|
Packit |
0b51a0 |
$mask -= 96;
|
|
Packit |
0b51a0 |
my @faddr = split (/\./, $_[0]->first->addr);
|
|
Packit |
0b51a0 |
my @laddr = split (/\./, $_[0]->broadcast->addr);
|
|
Packit |
0b51a0 |
return do_prefix $mask, \@faddr, \@laddr;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>nprefix()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Just as C<-E<gt>prefix()>, but does not include the broadcast address.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# only applicable to ipV4
|
|
Packit |
0b51a0 |
sub nprefix($) {
|
|
Packit |
0b51a0 |
return undef if $_[0]->{isv6};
|
|
Packit |
0b51a0 |
my $mask = (notcontiguous($_[0]->{mask}))[1];
|
|
Packit |
0b51a0 |
return $_[0]->addr if $mask == 128;
|
|
Packit |
0b51a0 |
$mask -= 96;
|
|
Packit |
0b51a0 |
my @faddr = split (/\./, $_[0]->first->addr);
|
|
Packit |
0b51a0 |
my @laddr = split (/\./, $_[0]->last->addr);
|
|
Packit |
0b51a0 |
return do_prefix $mask, \@faddr, \@laddr;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>numeric()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
When called in a scalar context, will return a numeric representation
|
|
Packit |
0b51a0 |
of the address part of the IP address. When called in an array
|
|
Packit |
0b51a0 |
contest, it returns a list of two elements. The first element is as
|
|
Packit |
0b51a0 |
described, the second element is the numeric representation of the
|
|
Packit |
0b51a0 |
netmask.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This method is essential for serializing the representation of a
|
|
Packit |
0b51a0 |
subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>bigint()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
When called in scalar context, will return a Math::BigInt
|
|
Packit |
0b51a0 |
representation of the address part of the IP address. When called in
|
|
Packit |
0b51a0 |
an array context, it returns a list of two elements, The first
|
|
Packit |
0b51a0 |
element is as described, the second element is the Math::BigInt
|
|
Packit |
0b51a0 |
representation of the netmask.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>wildcard()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
When called in a scalar context, returns the wildcard bits
|
|
Packit |
0b51a0 |
corresponding to the mask, in dotted-quad or ipV6 format as applicable.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
When called in an array context, returns a two-element array. The
|
|
Packit |
0b51a0 |
first element, is the address part. The second element, is the
|
|
Packit |
0b51a0 |
wildcard translation of the mask.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub wildcard($) {
|
|
Packit |
0b51a0 |
my $copy = $_[0]->copy;
|
|
Packit |
0b51a0 |
$copy->{addr} = ~ $copy->{mask};
|
|
Packit |
0b51a0 |
$copy->{addr} &= V4net unless $copy->{isv6};
|
|
Packit |
0b51a0 |
if (wantarray) {
|
|
Packit |
0b51a0 |
return ($_[0]->addr, $copy->addr);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
return $copy->addr;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>short()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the address part in a short or compact notation.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
(ie, 127.0.0.1 becomes 127.1).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Works with both, V4 and V6.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub _compact_v6 ($) {
|
|
Packit |
0b51a0 |
my $addr = shift;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my @o = split /:/, $addr;
|
|
Packit |
0b51a0 |
return $addr unless @o and grep { $_ =~ m/^0+$/ } @o;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my @candidates = ();
|
|
Packit |
0b51a0 |
my $start = undef;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
for my $i (0 .. $#o)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
if (defined $start)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
if ($o[$i] !~ m/^0+$/)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
push @candidates, [ $start, $i - $start ];
|
|
Packit |
0b51a0 |
$start = undef;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$start = $i if $o[$i] =~ m/^0+$/;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
push @candidates, [$start, 8 - $start] if defined $start;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $l = (sort { $b->[1] <=> $a->[1] } @candidates)[0];
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
return $addr unless defined $l;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
$addr = $l->[0] == 0 ? '' : join ':', @o[0 .. $l->[0] - 1];
|
|
Packit |
0b51a0 |
$addr .= '::';
|
|
Packit |
0b51a0 |
$addr .= join ':', @o[$l->[0] + $l->[1] .. $#o];
|
|
Packit |
0b51a0 |
$addr =~ s/(^|:)0{1,3}/$1/g;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
return $addr;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
#sub _old_compV6 {
|
|
Packit |
0b51a0 |
# my @addr = split(':',shift);
|
|
Packit |
0b51a0 |
# my $found = 0;
|
|
Packit |
0b51a0 |
# my $v;
|
|
Packit |
0b51a0 |
# foreach(0..$#addr) {
|
|
Packit |
0b51a0 |
# ($v = $addr[$_]) =~ s/^0+//;
|
|
Packit |
0b51a0 |
# $addr[$_] = $v || 0;
|
|
Packit |
0b51a0 |
# }
|
|
Packit |
0b51a0 |
# @_ = reverse(1..$#addr);
|
|
Packit |
0b51a0 |
# foreach(@_) {
|
|
Packit |
0b51a0 |
# if ($addr[$_] || $addr[$_ -1]) {
|
|
Packit |
0b51a0 |
# last if $found;
|
|
Packit |
0b51a0 |
# next;
|
|
Packit |
0b51a0 |
# }
|
|
Packit |
0b51a0 |
# $addr[$_] = $addr[$_ -1] = '';
|
|
Packit |
0b51a0 |
# $found = '1';
|
|
Packit |
0b51a0 |
# }
|
|
Packit |
0b51a0 |
# (my $rv = join(':',@addr)) =~ s/:+:/::/;
|
|
Packit |
0b51a0 |
# return $rv;
|
|
Packit |
0b51a0 |
#}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# thanks to Rob Riepel <riepel@networking.Stanford.EDU>
|
|
Packit |
0b51a0 |
# for this faster and more compact solution 11-17-08
|
|
Packit |
0b51a0 |
sub _compV6 ($) {
|
|
Packit |
0b51a0 |
my $ip = shift;
|
|
Packit |
0b51a0 |
return $ip unless my @candidates = $ip =~ /((?:^|:)0(?::0)+(?::|$))/g;
|
|
Packit |
0b51a0 |
my $longest = (sort { length($b) <=> length($a) } @candidates)[0];
|
|
Packit |
0b51a0 |
$ip =~ s/$longest/::/;
|
|
Packit |
0b51a0 |
return $ip;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub short($) {
|
|
Packit |
0b51a0 |
my $addr = $_[0]->addr;
|
|
Packit |
0b51a0 |
if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
|
|
Packit |
0b51a0 |
my @o = split(/\./, $addr, 4);
|
|
Packit |
0b51a0 |
splice(@o, 1, 2) if $o[1] == 0 and $o[2] == 0;
|
|
Packit |
0b51a0 |
return join '.', @o;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
return _compV6($addr);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>canon()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the address part in canonical notation as a string. For
|
|
Packit |
0b51a0 |
ipV4, this is dotted quad, and is the same as the return value from
|
|
Packit |
0b51a0 |
"->addr()". For ipV6 it is as per RFC5952, and is the same as the LOWER CASE value
|
|
Packit |
0b51a0 |
returned by "->short()".
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub canon($) {
|
|
Packit |
0b51a0 |
my $addr = $_[0]->addr;
|
|
Packit |
0b51a0 |
return $_[0]->{isv6} ? lc _compV6($addr) : $addr;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>full()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the address part in FULL notation for
|
|
Packit |
0b51a0 |
ipV4 and ipV6 respectively.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
i.e. for ipV4
|
|
Packit |
0b51a0 |
0000:0000:0000:0000:0000:0000:127.0.0.1
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
for ipV6
|
|
Packit |
0b51a0 |
0000:0000:0000:0000:0000:0000:0000:0000
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
To force ipV4 addresses into full ipV6 format use:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>full6()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the address part in FULL ipV6 notation
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>full6m()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the mask part in FULL ipV6 notation
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$me-E<gt>contains($other)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns true when C<$me> completely contains C<$other>. False is
|
|
Packit |
0b51a0 |
returned otherwise and C<undef> is returned if C<$me> and C<$other>
|
|
Packit |
0b51a0 |
are not both C<NetAddr::IP> objects.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$me-E<gt>within($other)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
The complement of C<-E<gt>contains()>. Returns true when C<$me> is
|
|
Packit |
0b51a0 |
completely contained within C<$other>.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Note that C<$me> and C<$other> must be C<NetAddr::IP> objects.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C-E<gt>is_rfc1918()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns true when C<$me> is an RFC 1918 address.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
10.0.0.0 - 10.255.255.255 (10/8 prefix)
|
|
Packit |
0b51a0 |
172.16.0.0 - 172.31.255.255 (172.16/12 prefix)
|
|
Packit |
0b51a0 |
192.168.0.0 - 192.168.255.255 (192.168/16 prefix)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>is_local()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns true when C<$me> is a local network address.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
i.e. ipV4 127.0.0.0 - 127.255.255.255
|
|
Packit |
0b51a0 |
or ipV6 === ::1
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>splitref($bits,[optional $bits1,$bits2,...])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a reference to a list of objects, representing subnets of C<bits> mask
|
|
Packit |
0b51a0 |
produced by splitting the original object, which is left
|
|
Packit |
0b51a0 |
unchanged. Note that C<$bits> must be longer than the original
|
|
Packit |
0b51a0 |
mask in order for it to be splittable.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
ERROR conditions:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
->splitref will DIE with the message 'netlimit exceeded'
|
|
Packit |
0b51a0 |
if the number of return objects exceeds 'netlimit'.
|
|
Packit |
0b51a0 |
See function 'netlimit' above (default 2**16 or 65536 nets).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
->splitref returns undef when C<bits> or the (bits list)
|
|
Packit |
0b51a0 |
will not fit within the original object.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
->splitref returns undef if a supplied ipV4, ipV6, or NetAddr
|
|
Packit |
0b51a0 |
mask in inappropriately formatted,
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
B<bits> may be a CIDR mask, a dot quad or ipV6 string or a NetAddr::IP object.
|
|
Packit |
0b51a0 |
If C<bits> is missing, the object is split for into all available addresses
|
|
Packit |
0b51a0 |
within the ipV4 or ipV6 object ( auto-mask of CIDR 32, 128 respectively ).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
With optional additional C<bits> list, the original object is split into
|
|
Packit |
0b51a0 |
parts sized based on the list. NOTE: a short list will replicate the last
|
|
Packit |
0b51a0 |
item. If the last item is too large to for what remains of the object after
|
|
Packit |
0b51a0 |
splitting off the first parts of the list, a "best fits" list of remaining
|
|
Packit |
0b51a0 |
objects will be returned based on an increasing sort of the CIDR values of
|
|
Packit |
0b51a0 |
the C<bits> list.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
i.e. my $ip = new NetAddr::IP('192.168.0.0/24');
|
|
Packit |
0b51a0 |
my $objptr = $ip->split(28, 29, 28, 29, 26);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
has split plan 28 29 28 29 26 26 26 28
|
|
Packit |
0b51a0 |
and returns this list of objects
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
192.168.0.0/28
|
|
Packit |
0b51a0 |
192.168.0.16/29
|
|
Packit |
0b51a0 |
192.168.0.24/28
|
|
Packit |
0b51a0 |
192.168.0.40/29
|
|
Packit |
0b51a0 |
192.168.0.48/26
|
|
Packit |
0b51a0 |
192.168.0.112/26
|
|
Packit |
0b51a0 |
192.168.0.176/26
|
|
Packit |
0b51a0 |
192.168.0.240/28
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NOTE: that /26 replicates twice beyond the original request and /28 fills
|
|
Packit |
0b51a0 |
the remaining return object requirement.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>rsplitref($bits,[optional $bits1,$bits2,...])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
C<-E<gt>rsplitref> is the same as C<-E<gt>splitref> above except that the split plan is
|
|
Packit |
0b51a0 |
applied to the original object in reverse order.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
i.e. my $ip = new NetAddr::IP('192.168.0.0/24');
|
|
Packit |
0b51a0 |
my @objects = $ip->split(28, 29, 28, 29, 26);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
has split plan 28 26 26 26 29 28 29 28
|
|
Packit |
0b51a0 |
and returns this list of objects
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
192.168.0.0/28
|
|
Packit |
0b51a0 |
192.168.0.16/26
|
|
Packit |
0b51a0 |
192.168.0.80/26
|
|
Packit |
0b51a0 |
192.168.0.144/26
|
|
Packit |
0b51a0 |
192.168.0.208/29
|
|
Packit |
0b51a0 |
192.168.0.216/28
|
|
Packit |
0b51a0 |
192.168.0.232/29
|
|
Packit |
0b51a0 |
192.168.0.240/28
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>split($bits,[optional $bits1,$bits2,...])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Similar to C<-E<gt>splitref> above but returns the list rather than a list
|
|
Packit |
0b51a0 |
reference. You may not want to use this if a large number of objects is
|
|
Packit |
0b51a0 |
expected.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>rsplit($bits,[optional $bits1,$bits2,...])>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Similar to C<-E<gt>rsplitref> above but returns the list rather than a list
|
|
Packit |
0b51a0 |
reference. You may not want to use this if a large number of objects is
|
|
Packit |
0b51a0 |
expected.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# input: $naip,
|
|
Packit |
0b51a0 |
# @bits, list of masks for splits
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
# returns: empty array request will not fit in submitted net
|
|
Packit |
0b51a0 |
# (\@bits,undef) if there is just one plan item i.e. return original net
|
|
Packit |
0b51a0 |
# (\@bits,\%masks) for a real plan
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
sub _splitplan {
|
|
Packit |
0b51a0 |
my($ip,@bits) = @_;
|
|
Packit |
0b51a0 |
my $addr = $ip->addr();
|
|
Packit |
0b51a0 |
my $isV6 = $ip->{isv6};
|
|
Packit |
0b51a0 |
unless (@bits) {
|
|
Packit |
0b51a0 |
$bits[0] = $isV6 ? 128 : 32;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
my $basem = $ip->masklen();
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my(%nets,$dif);
|
|
Packit |
0b51a0 |
my $denom = 0;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my($x,$maddr);
|
|
Packit |
0b51a0 |
foreach(@bits) {
|
|
Packit |
0b51a0 |
if (ref $_) { # is a NetAddr::IP
|
|
Packit |
0b51a0 |
$x = $_->{isv6} ? $_->{addr} : $_->{addr} | V4mask;
|
|
Packit |
0b51a0 |
($x,$maddr) = notcontiguous($x);
|
|
Packit |
0b51a0 |
return () if $x; # spurious bits
|
|
Packit |
0b51a0 |
$_ = $isV6 ? $maddr : $maddr - 96;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ( $_ =~ /^d+$/ ) { # is a negative number of the form -nnnn
|
|
Packit |
0b51a0 |
;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($_ = NetAddr::IP->new($addr,$_,$isV6)) { # will be undefined if bad mask and will fall into oops!
|
|
Packit |
0b51a0 |
$_ = $_->masklen();
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else {
|
|
Packit |
0b51a0 |
return (); # oops!
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
$dif = $_ - $basem; # for normalization
|
|
Packit |
0b51a0 |
return () if $dif < 0; # overange nets not allowed
|
|
Packit |
0b51a0 |
return (\@bits,undef) unless ($dif || $#bits); # return if original net = mask alone
|
|
Packit |
0b51a0 |
$denom = $dif if $dif > $denom;
|
|
Packit |
0b51a0 |
next if exists $nets{$_};
|
|
Packit |
0b51a0 |
$nets{$_} = $_ - $basem; # for normalization
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# $denom is the normalization denominator, since these are all exponents
|
|
Packit |
0b51a0 |
# normalization can use add/subtract to accomplish normalization
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
# keys of %nets are the masks used by this split
|
|
Packit |
0b51a0 |
# values of %nets are the normalized weighting for
|
|
Packit |
0b51a0 |
# calculating when the split is "full" or complete
|
|
Packit |
0b51a0 |
# %masks values contain the actual masks for each split subnet
|
|
Packit |
0b51a0 |
# @bits contains the masks in the order the user actually wants them
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
my %masks; # calculate masks
|
|
Packit |
0b51a0 |
my $maskbase = $isV6 ? 128 : 32;
|
|
Packit |
0b51a0 |
foreach( keys %nets ) {
|
|
Packit |
0b51a0 |
$nets{$_} = 2 ** ($denom - $nets{$_});
|
|
Packit |
0b51a0 |
$masks{$_} = shiftleft(Ones, $maskbase - $_);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my @plan;
|
|
Packit |
0b51a0 |
my $idx = 0;
|
|
Packit |
0b51a0 |
$denom = 2 ** $denom;
|
|
Packit |
0b51a0 |
PLAN:
|
|
Packit |
0b51a0 |
while ($denom > 0) { # make a net plan
|
|
Packit |
0b51a0 |
my $nexmask = ($idx < $#bits) ? $bits[$idx] : $bits[$#bits];
|
|
Packit |
0b51a0 |
++$idx;
|
|
Packit |
0b51a0 |
unless (($denom -= $nets{$nexmask}) < 0) {
|
|
Packit |
0b51a0 |
return () if (push @plan, $nexmask) > $_netlimit;
|
|
Packit |
0b51a0 |
next;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
# a fractional net is needed that is not in the mask list or the replicant
|
|
Packit |
0b51a0 |
$denom += $nets{$nexmask}; # restore mistake
|
|
Packit |
0b51a0 |
TRY:
|
|
Packit |
0b51a0 |
foreach (sort { $a <=> $b } keys %nets) {
|
|
Packit |
0b51a0 |
next TRY if $nexmask > $_;
|
|
Packit |
0b51a0 |
do {
|
|
Packit |
0b51a0 |
next TRY if $denom - $nets{$_} < 0;
|
|
Packit |
0b51a0 |
return () if (push @plan, $_) > $_netlimit;
|
|
Packit |
0b51a0 |
$denom -= $nets{$_};
|
|
Packit |
0b51a0 |
} while $denom;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
die 'ERROR: miscalculated weights' if $denom;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
return () if $idx < @bits; # overrange original subnet request
|
|
Packit |
0b51a0 |
return (\@plan,\%masks);
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# input: $rev, # t/f
|
|
Packit |
0b51a0 |
# $naip,
|
|
Packit |
0b51a0 |
# @bits # list of masks for split
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
sub _splitref {
|
|
Packit |
0b51a0 |
my $rev = shift;
|
|
Packit |
0b51a0 |
my($plan,$masks) = &_splitplan;
|
|
Packit |
0b51a0 |
# bug report 82719
|
|
Packit |
0b51a0 |
croak("netmask error: overrange or spurious bits") unless defined $plan;
|
|
Packit |
0b51a0 |
# return undef unless $plan;
|
|
Packit |
0b51a0 |
my $net = $_[0]->network();
|
|
Packit |
0b51a0 |
return [$net] unless $masks;
|
|
Packit |
0b51a0 |
my $addr = $net->{addr};
|
|
Packit |
0b51a0 |
my $isV6 = $net->{isv6};
|
|
Packit |
0b51a0 |
my @plan = $rev ? reverse @$plan : @$plan;
|
|
Packit |
0b51a0 |
# print "plan @plan\n";
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# create splits
|
|
Packit |
0b51a0 |
my @ret;
|
|
Packit |
0b51a0 |
while ($_ = shift @plan) {
|
|
Packit |
0b51a0 |
my $mask = $masks->{$_};
|
|
Packit |
0b51a0 |
push @ret, $net->_new($addr,$mask,$isV6);
|
|
Packit |
0b51a0 |
last unless @plan;
|
|
Packit |
0b51a0 |
$addr = (sub128($addr,$mask))[1];
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
return \@ret;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>hostenum()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns the list of hosts within a subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
ERROR conditions:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
->hostenum will DIE with the message 'netlimit exceeded'
|
|
Packit |
0b51a0 |
if the number of return objects exceeds 'netlimit'.
|
|
Packit |
0b51a0 |
See function 'netlimit' above (default 2**16 or 65536 nets).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub hostenum ($) {
|
|
Packit |
0b51a0 |
return @{$_[0]->hostenumref};
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>hostenumref()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Faster version of C<-E<gt>hostenum()>, returning a reference to a list.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NOTE: hostenum and hostenumref report zero (0) useable hosts in a /31
|
|
Packit |
0b51a0 |
network. This is the behavior expected prior to RFC 3021. To report 2
|
|
Packit |
0b51a0 |
useable hosts for use in point-to-point networks, use B<:rfc3021> tag.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP qw(:rfc3021);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This will cause hostenum and hostenumref to return two (2) useable hosts in
|
|
Packit |
0b51a0 |
a /31 network.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$me-E<gt>compact($addr1, $addr2, ...)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<@compacted_object_list = Compact(@object_list)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Given a list of objects (including C<$me>), this method will compact
|
|
Packit |
0b51a0 |
all the addresses and subnets into the largest (ie, least specific)
|
|
Packit |
0b51a0 |
subnets possible that contain exactly all of the given objects.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Note that in versions prior to 3.02, if fed with the same IP subnets
|
|
Packit |
0b51a0 |
multiple times, these subnets would be returned. From 3.02 on, a more
|
|
Packit |
0b51a0 |
"correct" approach has been adopted and only one address would be
|
|
Packit |
0b51a0 |
returned.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Note that C<$me> and all C<$addr>'s must be C<NetAddr::IP> objects.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$me-E<gt>compactref(\@list)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$compacted_object_list = Compact(\@list)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
As usual, a faster version of C<-E<gt>compact()> that returns a
|
|
Packit |
0b51a0 |
reference to a list. Note that this method takes a reference to a list
|
|
Packit |
0b51a0 |
instead.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Note that C<$me> must be a C<NetAddr::IP> object.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub compactref($) {
|
|
Packit |
0b51a0 |
# my @r = sort { NetAddr::IP::Lite::comp_addr_mask($a,$b) } @{$_[0]} # use overload 'cmp' function
|
|
Packit |
0b51a0 |
# or return [];
|
|
Packit |
0b51a0 |
# return [] unless @r;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my @r;
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
my $unr = [];
|
|
Packit |
0b51a0 |
my $args = $_[0];
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
if (ref $_[0] eq __PACKAGE__ and ref $_[1] eq 'ARRAY') {
|
|
Packit |
0b51a0 |
# ->compactref(\@list)
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
$unr = [$_[0], @{$_[1]}]; # keeping structures intact
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else {
|
|
Packit |
0b51a0 |
# Compact(@list) or ->compact(@list) or Compact(\@list)
|
|
Packit |
0b51a0 |
#
|
|
Packit |
0b51a0 |
$unr = $args;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
return [] unless @$unr;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
foreach(@$unr) {
|
|
Packit |
0b51a0 |
$_->{addr} = $_->network->{addr};
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
@r = sort @$unr;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $changed;
|
|
Packit |
0b51a0 |
do {
|
|
Packit |
0b51a0 |
$changed = 0;
|
|
Packit |
0b51a0 |
for(my $i=0; $i <= $#r -1;$i++) {
|
|
Packit |
0b51a0 |
if ($r[$i]->contains($r[$i +1])) {
|
|
Packit |
0b51a0 |
splice(@r,$i +1,1);
|
|
Packit |
0b51a0 |
++$changed;
|
|
Packit |
0b51a0 |
--$i;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ((notcontiguous($r[$i]->{mask}))[1] == (notcontiguous($r[$i +1]->{mask}))[1]) { # masks the same
|
|
Packit |
0b51a0 |
if (hasbits($r[$i]->{addr} ^ $r[$i +1]->{addr})) { # if not the same netblock
|
|
Packit |
0b51a0 |
my $upnet = $r[$i]->copy;
|
|
Packit |
0b51a0 |
$upnet->{mask} = shiftleft($upnet->{mask},1);
|
|
Packit |
0b51a0 |
if ($upnet->contains($r[$i +1])) { # adjacent nets in next net up
|
|
Packit |
0b51a0 |
$r[$i] = $upnet;
|
|
Packit |
0b51a0 |
splice(@r,$i +1,1);
|
|
Packit |
0b51a0 |
++$changed;
|
|
Packit |
0b51a0 |
--$i;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
} else { # identical nets
|
|
Packit |
0b51a0 |
splice(@r,$i +1,1);
|
|
Packit |
0b51a0 |
++$changed;
|
|
Packit |
0b51a0 |
--$i;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
} while $changed;
|
|
Packit |
0b51a0 |
return \@r;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$me-E<gt>coalesce($masklen, $number, @list_of_subnets)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<$arrayref = Coalesce($masklen,$number,@list_of_subnets)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Will return a reference to list of C<NetAddr::IP> subnets of
|
|
Packit |
0b51a0 |
C<$masklen> mask length, when C<$number> or more addresses from
|
|
Packit |
0b51a0 |
C<@list_of_subnets> are found to be contained in said subnet.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Subnets from C<@list_of_subnets> with a mask shorter than C<$masklen>
|
|
Packit |
0b51a0 |
are passed "as is" to the return list.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Subnets from C<@list_of_subnets> with a mask longer than C<$masklen>
|
|
Packit |
0b51a0 |
will be counted (actually, the number of IP addresses is counted)
|
|
Packit |
0b51a0 |
towards C<$number>.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Called as a method, the array will include C<$me>.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
WARNING: the list of subnet must be the same type. i.e ipV4 or ipV6
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub coalesce
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
my $masklen = shift;
|
|
Packit |
0b51a0 |
if (ref $masklen && ref $masklen eq __PACKAGE__ ) { # if called as a method
|
|
Packit |
0b51a0 |
push @_,$masklen;
|
|
Packit |
0b51a0 |
$masklen = shift;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $number = shift;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# Addresses are at @_
|
|
Packit |
0b51a0 |
return [] unless @_;
|
|
Packit |
0b51a0 |
my %ret = ();
|
|
Packit |
0b51a0 |
my $type = $_[0]->{isv6};
|
|
Packit |
0b51a0 |
return [] unless defined $type;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
for my $ip (@_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
return [] unless $ip->{isv6} == $type;
|
|
Packit |
0b51a0 |
$type = $ip->{isv6};
|
|
Packit |
0b51a0 |
my $n = NetAddr::IP->new($ip->addr . '/' . $masklen)->network;
|
|
Packit |
0b51a0 |
if ($ip->masklen > $masklen)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$ret{$n} += $ip->num + $NetAddr::IP::Lite::Old_nth;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my @ret = ();
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# Add to @ret any arguments with netmasks longer than our argument
|
|
Packit |
0b51a0 |
for my $c (sort { $a->masklen <=> $b->masklen }
|
|
Packit |
0b51a0 |
grep { $_->masklen <= $masklen } @_)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
next if grep { $_->contains($c) } @ret;
|
|
Packit |
0b51a0 |
push @ret, $c->network;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# Now add to @ret all the subnets with more than $number hits
|
|
Packit |
0b51a0 |
for my $c (map { new NetAddr::IP $_ }
|
|
Packit |
0b51a0 |
grep { $ret{$_} >= $number }
|
|
Packit |
0b51a0 |
keys %ret)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
next if grep { $_->contains($c) } @ret;
|
|
Packit |
0b51a0 |
push @ret, $c;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
return \@ret;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>first()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a new object representing the first usable IP address within
|
|
Packit |
0b51a0 |
the subnet (ie, the first host address).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>last()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a new object representing the last usable IP address within
|
|
Packit |
0b51a0 |
the subnet (ie, one less than the broadcast address).
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>nth($index)>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a new object representing the I<n>-th usable IP address within
|
|
Packit |
0b51a0 |
the subnet (ie, the I<n>-th host address). If no address is available
|
|
Packit |
0b51a0 |
(for example, when the network is too small for C<$index> hosts),
|
|
Packit |
0b51a0 |
C<undef> is returned.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite implements
|
|
Packit |
0b51a0 |
C<-E<gt>nth($index)> and C<-E<gt>num()> exactly as the documentation states.
|
|
Packit |
0b51a0 |
Previous versions behaved slightly differently and not in a consistent
|
|
Packit |
0b51a0 |
manner. See the README file for details.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP::Lite qw(:old_nth);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
old behavior:
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/32')->nth(0) == undef
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/32')->nth(1) == undef
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/31')->nth(0) == undef
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(0) == undef
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(1) == 10.0.0.1/30
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(2) == 10.0.0.2/30
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(3) == 10.0.0.3/30
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Note that in each case, the broadcast address is represented in the
|
|
Packit |
0b51a0 |
output set and that the 'zero'th index is alway undef except for
|
|
Packit |
0b51a0 |
a point-to-point /31 or /127 network where there are exactly two
|
|
Packit |
0b51a0 |
addresses in the network.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
new behavior:
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/32')->nth(0) == 10.0.0.0/32
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10.1/32'->nth(0) == 10.0.0.1/32
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/31')->nth(0) == 10.0.0.0/31
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/31')->nth(1) == 10.0.0.1/31
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(0) == 10.0.0.1/30
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(1) == 10.0.0.2/30
|
|
Packit |
0b51a0 |
NetAddr::IP->new('10/30')->nth(2) == undef
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Note that a /32 net always has 1 usable address while a /31 has exactly
|
|
Packit |
0b51a0 |
two usable addresses for point-to-point addressing. The first
|
|
Packit |
0b51a0 |
index (0) returns the address immediately following the network address
|
|
Packit |
0b51a0 |
except for a /31 or /127 when it return the network address.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>num()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
As of version 4.42 of NetAddr::IP and version 1.27 of NetAddr::IP::Lite
|
|
Packit |
0b51a0 |
a /31 and /127 with return a net B<num> value of 2 instead of 0 (zero)
|
|
Packit |
0b51a0 |
for point-to-point networks.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Version 4.00 of NetAddr::IP and version 1.00 of NetAddr::IP::Lite
|
|
Packit |
0b51a0 |
return the number of usable IP addresses within the subnet,
|
|
Packit |
0b51a0 |
not counting the broadcast or network address.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Previous versions worked only for ipV4 addresses, returned a
|
|
Packit |
0b51a0 |
maximum span of 2**32 and returned the number of IP addresses
|
|
Packit |
0b51a0 |
not counting the broadcast address.
|
|
Packit |
0b51a0 |
(one greater than the new behavior)
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
To use the old behavior for C<-E<gt>nth($index)> and C<-E<gt>num()>:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
use NetAddr::IP::Lite qw(:old_nth);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
WARNING:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NetAddr::IP will calculate and return a numeric string for network
|
|
Packit |
0b51a0 |
ranges as large as 2**128. These values are TEXT strings and perl
|
|
Packit |
0b51a0 |
can treat them as integers for numeric calculations.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Perl on 32 bit platforms only handles integer numbers up to 2**32
|
|
Packit |
0b51a0 |
and on 64 bit platforms to 2**64.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
If you wish to manipulate numeric strings returned by NetAddr::IP
|
|
Packit |
0b51a0 |
that are larger than 2**32 or 2**64, respectively, you must load
|
|
Packit |
0b51a0 |
additional modules such as Math::BigInt, bignum or some similar
|
|
Packit |
0b51a0 |
package to do the integer math.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>re()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a Perl regular expression that will match an IP address within
|
|
Packit |
0b51a0 |
the given subnet. Defaults to ipV4 notation. Will return an ipV6 regex
|
|
Packit |
0b51a0 |
if the address in not in ipV4 space.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub re ($)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
return &re6 unless isIPv4($_[0]->{addr});
|
|
Packit |
0b51a0 |
my $self = shift->network; # Insure a "zero" host part
|
|
Packit |
0b51a0 |
my ($addr, $mlen) = ($self->addr, $self->masklen);
|
|
Packit |
0b51a0 |
my @o = split('\.', $addr, 4);
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my $octet= '(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])';
|
|
Packit |
0b51a0 |
my @r = @o;
|
|
Packit |
0b51a0 |
my $d;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
# for my $i (0 .. $#o)
|
|
Packit |
0b51a0 |
# {
|
|
Packit |
0b51a0 |
# warn "# $self: $r[$i] == $o[$i]\n";
|
|
Packit |
0b51a0 |
# }
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
if ($mlen != 32)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
if ($mlen > 24)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$d = 2 ** (32 - $mlen) - 1;
|
|
Packit |
0b51a0 |
$r[3] = '(?:' . join('|', ($o[3]..$o[3] + $d)) . ')';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$r[3] = $octet;
|
|
Packit |
0b51a0 |
if ($mlen > 16)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$d = 2 ** (24 - $mlen) - 1;
|
|
Packit |
0b51a0 |
$r[2] = '(?:' . join('|', ($o[2]..$o[2] + $d)) . ')';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$r[2] = $octet;
|
|
Packit |
0b51a0 |
if ($mlen > 8)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$d = 2 ** (16 - $mlen) - 1;
|
|
Packit |
0b51a0 |
$r[1] = '(?:' . join('|', ($o[1]..$o[1] + $d)) . ')';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$r[1] = $octet;
|
|
Packit |
0b51a0 |
if ($mlen > 0)
|
|
Packit |
0b51a0 |
{
|
|
Packit |
0b51a0 |
$d = 2 ** (8 - $mlen) - 1;
|
|
Packit |
0b51a0 |
$r[0] = '(?:' . join('|', ($o[0] .. $o[0] + $d)) . ')';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
else { $r[0] = $octet; }
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
### no digit before nor after (look-behind, look-ahead)
|
|
Packit |
0b51a0 |
return "(?:(?
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=item C<-E<gt>re6()>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Returns a Perl regular expression that will match an IP address within
|
|
Packit |
0b51a0 |
the given subnet. Always returns an ipV6 regex.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub re6($) {
|
|
Packit |
0b51a0 |
my @net = split('',sprintf("%04X%04X%04X%04X%04X%04X%04X%04X",unpack('n8',$_[0]->network->{addr})));
|
|
Packit |
0b51a0 |
my @brd = split('',sprintf("%04X%04X%04X%04X%04X%04X%04X%04X",unpack('n8',$_[0]->broadcast->{addr})));
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
my @dig;
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
foreach(0..$#net) {
|
|
Packit |
0b51a0 |
my $n = $net[$_];
|
|
Packit |
0b51a0 |
my $b = $brd[$_];
|
|
Packit |
0b51a0 |
my $m;
|
|
Packit |
0b51a0 |
if ($n.'' eq $b.'') {
|
|
Packit |
0b51a0 |
if ($n =~ /\d/) {
|
|
Packit |
0b51a0 |
push @dig, $n;
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
push @dig, '['.(lc $n).$n.']';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
my $n = $net[$_];
|
|
Packit |
0b51a0 |
my $b = $brd[$_];
|
|
Packit |
0b51a0 |
if ($n.'' eq 0 && $b =~ /F/) {
|
|
Packit |
0b51a0 |
push @dig, 'x';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($n =~ /\d/ && $b =~ /\d/) {
|
|
Packit |
0b51a0 |
push @dig, '['.$n.'-'.$b.']';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($n =~ /[A-F]/ && $b =~ /[A-F]/) {
|
|
Packit |
0b51a0 |
$n .= '-'.$b;
|
|
Packit |
0b51a0 |
push @dig, '['.(lc $n).$n.']';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($n =~ /\d/ && $b =~ /[A-F]/) {
|
|
Packit |
0b51a0 |
$m = ($n == 9) ? 9 : $n .'-9';
|
|
Packit |
0b51a0 |
if ($b =~ /A/) {
|
|
Packit |
0b51a0 |
$m .= 'aA';
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
$b = 'A-'. $b;
|
|
Packit |
0b51a0 |
$m .= (lc $b). $b;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
push @dig, '['.$m.']';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
elsif ($n =~ /[A-F]/ && $b =~ /\d/) {
|
|
Packit |
0b51a0 |
if ($n =~ /A/) {
|
|
Packit |
0b51a0 |
$m = 'aA';
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
$n .= '-F';
|
|
Packit |
0b51a0 |
$m = (lc $n).$n;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if ($b == 9) {
|
|
Packit |
0b51a0 |
$m .= 9;
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
$m .= $b .'-9';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
push @dig, '['.$m.']';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
my @grp;
|
|
Packit |
0b51a0 |
do {
|
|
Packit |
0b51a0 |
my $grp = join('',splice(@dig,0,4));
|
|
Packit |
0b51a0 |
if ($grp =~ /^(0+)/) {
|
|
Packit |
0b51a0 |
my $l = length($1);
|
|
Packit |
0b51a0 |
if ($l == 4) {
|
|
Packit |
0b51a0 |
$grp = '0{1,4}';
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
$grp =~ s/^${1}/0\{0,$l\}/;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
if ($grp =~ /(x+)$/) {
|
|
Packit |
0b51a0 |
my $l = length($1);
|
|
Packit |
0b51a0 |
if ($l == 4) {
|
|
Packit |
0b51a0 |
$grp = '[0-9a-fA-F]{1,4}';
|
|
Packit |
0b51a0 |
} else {
|
|
Packit |
0b51a0 |
$grp =~ s/x+/\[0\-9a\-fA\-F\]\{$l\}/;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
push @grp, $grp;
|
|
Packit |
0b51a0 |
} while @dig > 0;
|
|
Packit |
0b51a0 |
return '('. join(':',@grp) .')';
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
sub mod_version {
|
|
Packit |
0b51a0 |
return $VERSION;
|
|
Packit |
0b51a0 |
&Compact; # suppress warnings about these symbols
|
|
Packit |
0b51a0 |
&Coalesce;
|
|
Packit |
0b51a0 |
&STORABLE_freeze;
|
|
Packit |
0b51a0 |
&STORABLE_thaw;
|
|
Packit |
0b51a0 |
}
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=pod
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=back
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 EXPORT_OK
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Compact
|
|
Packit |
0b51a0 |
Coalesce
|
|
Packit |
0b51a0 |
Zeros
|
|
Packit |
0b51a0 |
Ones
|
|
Packit |
0b51a0 |
V4mask
|
|
Packit |
0b51a0 |
V4net
|
|
Packit |
0b51a0 |
netlimit
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 NOTES / BUGS ... FEATURES
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
NetAddr::IP only runs in Pure Perl mode on Windows boxes because I don't
|
|
Packit |
0b51a0 |
have the resources or know how to get the "configure" stuff working in the
|
|
Packit |
0b51a0 |
Windows environment. Volunteers WELCOME to port the "C" portion of this
|
|
Packit |
0b51a0 |
module to Windows.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 HISTORY
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=over 4
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
See the Changes file
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=back
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 AUTHORS
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Luis E. Muñoz E<lt>luismunoz@cpan.orgE<gt>,
|
|
Packit |
0b51a0 |
Michael Robinton E<lt>michael@bizsystems.comE<gt>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 WARRANTY
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This software comes with the same warranty as Perl itself (ie, none),
|
|
Packit |
0b51a0 |
so by using it you accept any and all the liability.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 COPYRIGHT
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This software is (c) Luis E. Muñoz, 1999 - 2007, and (c) Michael
|
|
Packit |
0b51a0 |
Robinton, 2006 - 2014.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
All rights reserved.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This program is free software; you can redistribute it and/or modify
|
|
Packit |
0b51a0 |
it under the terms of either:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
a) the GNU General Public License as published by the Free
|
|
Packit |
0b51a0 |
Software Foundation; either version 2, or (at your option) any
|
|
Packit |
0b51a0 |
later version, or
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
b) the "Artistic License" which comes with this distribution.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
This program is distributed in the hope that it will be useful,
|
|
Packit |
0b51a0 |
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
0b51a0 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
|
|
Packit |
0b51a0 |
the GNU General Public License or the Artistic License for more details.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
You should have received a copy of the Artistic License with this
|
|
Packit |
0b51a0 |
distribution, in the file named "Artistic". If not, I'll be glad to provide
|
|
Packit |
0b51a0 |
one.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
You should also have received a copy of the GNU General Public License
|
|
Packit |
0b51a0 |
along with this program in the file named "Copying". If not, write to the
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
Free Software Foundation, Inc.
|
|
Packit |
0b51a0 |
51 Franklin Street, Fifth Floor
|
|
Packit |
0b51a0 |
Boston, MA 02110-1301 USA.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
or visit their web page on the internet at:
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
http://www.gnu.org/copyleft/gpl.html.
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=head1 SEE ALSO
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
perl(1) L<NetAddr::IP::Lite>, L<NetAddr::IP::Util>,
|
|
Packit |
0b51a0 |
L<NetAddr::IP::InetBase>
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
=cut
|
|
Packit |
0b51a0 |
|
|
Packit |
0b51a0 |
1;
|