File Coverage

blib/lib/NetAddr/IP.pm

Criterion	Covered	Total	%
statement	182	221	82.3
branch	87	120	72.5
condition	17	27	62.9
subroutine	22	27	81.4
pod	13	14	92.8
total	321	409	78.4

#!/usr/bin/perl -w

package NetAddr::IP;

use strict;
#use diagnostics;
use Carp;
use NetAddr::IP::Lite 1.57 qw(Zero Zeros Ones V4mask V4net);
use NetAddr::IP::Util 1.53 qw(
	sub128
	inet_aton
	inet_any2n
	ipv6_aton
	isIPv4
	ipv4to6
	mask4to6
	shiftleft
	addconst
	hasbits
	notcontiguous
);

use AutoLoader qw(AUTOLOAD);

use vars qw(
	@EXPORT_OK
	@EXPORT_FAIL
	@ISA
	$VERSION
	$_netlimit
	$rfc3021
);
require Exporter;

@EXPORT_OK = qw(Compact Coalesce Zero Zeros Ones V4mask V4net netlimit);
@EXPORT_FAIL = qw($_netlimit);

@ISA = qw(Exporter NetAddr::IP::Lite);

$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.79 $ =~ /\d+/g) };

$rfc3021 = 0;

=pod

=encoding UTF-8

=head1 NAME

NetAddr::IP - Manages IPv4 and IPv6 addresses and subnets

=head1 SYNOPSIS

  use NetAddr::IP qw(
	Compact
	Coalesce
	Zeros
	Ones
	V4mask
	V4net
	netlimit
	:aton		DEPRECATED
	:lower
	:upper
	:old_storable
	:old_nth
	:rfc3021
	:nofqdn
  );

  NOTE: NetAddr::IP::Util has a full complement of network address
	utilities to convert back and forth between binary and text.

	inet_aton, inet_ntoa, ipv6_aton, ipv6_ntoa
	ipv6_n2x, ipv6_n2d inet_any2d, inet_n2dx,
	inet_n2ad, inetanyto6, ipv6to4

See L


  my $ip = new NetAddr::IP '127.0.0.1';
	 or if you prefer
  my $ip = NetAddr::IP->new('127.0.0.1);
	or from a packed IPv4 address
  my $ip = new_from_aton NetAddr::IP (inet_aton('127.0.0.1'));
	or from an octal filtered IPv4 address
  my $ip = new_no NetAddr::IP '127.012.0.0';

  print "The address is ", $ip->addr, " with mask ", $ip->mask, "\n" ;

  if ($ip->within(new NetAddr::IP "127.0.0.0", "255.0.0.0")) {
      print "Is a loopback address\n";
  }

				# This prints 127.0.0.1/32
  print "You can also say $ip...\n";

* The following four functions return ipV6 representations of:

  ::                                       = Zeros();
  FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF  = Ones();
  FFFF:FFFF:FFFF:FFFF:FFFF:FFFF::          = V4mask();
  ::FFFF:FFFF                              = V4net();

  Will also return an ipV4 or ipV6 representation of a
  resolvable Fully Qualified Domanin Name (FQDN).

###### DEPRECATED, will be remove in version 5 ############

  * To accept addresses in the format as returned by
  inet_aton, invoke the module as:

  use NetAddr::IP qw(:aton);

###### USE new_from_aton instead ##########################

* To enable usage of legacy data files containing NetAddr::IP
objects stored using the L module.

  use NetAddr::IP qw(:old_storable);

* To compact many smaller subnets (see: C<$me-Ecompact($addr1,$addr2,...)>

  @compacted_object_list = Compact(@object_list)

* Return a reference to list of C subnets of
C<$masklen> mask length, when C<$number> or more addresses from
C<@list_of_subnets> are found to be contained in said subnet.

  $arrayref = Coalesce($masklen, $number, @list_of_subnets)

* By default B functions and methods return string IPv6
addresses in uppercase.  To change that to lowercase:

NOTE: the AUGUST 2010 RFC5952 states:

    4.3. Lowercase

      The characters "a", "b", "c", "d", "e", and "f" in an IPv6
      address MUST be represented in lowercase.

It is recommended that all NEW applications using NetAddr::IP be
invoked as shown on the next line.

  use NetAddr::IP qw(:lower);

* To ensure the current IPv6 string case behavior even if the default changes:

  use NetAddr::IP qw(:upper);

* To set a limit on the size of B processed or returned by NetAddr::IP.

Set the maximum number of nets beyond which NetAddr::IP will return
an error as a power of 2 (default 16 or 65536 nets). Each 2**16
consumes approximately 4 megs of memory. A 2**20 consumes 64 megs of
memory, A 2**24 consumes 1 gigabyte of memory.

  use NetAddr::IP qw(netlimit);
  netlimit 20;

The maximum B allowed is 2**24. Attempts to set limits below
the default of 16 or above the maximum of 24 are ignored.

Returns true on success, otherwise C.

=cut

$_netlimit = 2 ** 16;			# default

sub netlimit($) {
  return undef unless $_[0];
  return undef if $_[0] =~ /\D/;
  return undef if $_[0] < 16;
  return undef if $_[0] > 24;
  $_netlimit = 2 ** $_[0];
};

=head1 INSTALLATION

Un-tar the distribution in an appropriate directory and type:

	perl Makefile.PL
	make
	make test
	make install

B depends on B which installs by
default with its primary functions compiled using Perl's XS extensions
to build a C library. If you do not have a C complier available or
would like the slower Pure Perl version for some other reason, then
type:

	perl Makefile.PL -noxs
	make
	make test
	make install

=head1 DESCRIPTION

This module provides an object-oriented abstraction on top of IP
addresses or IP subnets that allows for easy manipulations.  Version
4.xx of NetAddr::IP will work with older versions of Perl and is
compatible with Math::BigInt.

The internal representation of all IP objects is in 128 bit IPv6 notation.
IPv4 and IPv6 objects may be freely mixed.

=head2 Overloaded Operators

Many operators have been overloaded, as described below:

=cut

				#############################################
				# These are the overload methods, placed here
				# for convenience.
				#############################################

use overload

    '@{}'	=> sub {
	return [ $_[0]->hostenum ];
    };

=pod

=over

=item B)>

Has been optimized to copy one NetAddr::IP object to another very quickly.

=item Bcopy()>>

The B)> operation is only put in to operation when the
copied object is further mutated by another overloaded operation. See
L B for details.

Bcopy()>> actually creates a new object when called.

=item B

An object can be used just as a string. For instance, the following code

	my $ip = new NetAddr::IP '192.168.1.123';
	print "$ip\n";

Will print the string 192.168.1.123/32.

=item B

You can test for equality with either C or C<==>. C allows
comparison with arbitrary strings as well as NetAddr::IP objects. The
following example:

    if (NetAddr::IP->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8')
       { print "Yes\n"; }

will print out "Yes".

Comparison with C<==> requires both operands to be NetAddr::IP objects.

In both cases, a true value is returned if the CIDR representation of
the operands is equal.

=item B, E, E=, E=, E=E and C>

Internally, all network objects are represented in 128 bit format.
The numeric representation of the network is compared through the
corresponding operation. Comparisons are tried first on the address portion
of the object and if that is equal then the NUMERIC cidr portion of the
masks are compared. This leads to the counterintuitive result that

	/24 > /16

Comparison should not be done on netaddr objects with different CIDR as
this may produce indeterminate - unexpected results,
rather the determination of which netblock is larger or smaller should be
done by comparing

	$ip1->masklen <=> $ip2->masklen

=item B)>

Add a 32 bit signed constant to the address part of a NetAddr object.
This operation changes the address part to point so many hosts above the
current objects start address. For instance, this code:

    print NetAddr::IP->new('127.0.0.1/8') + 5;

will output 127.0.0.6/8. The address will wrap around at the broadcast
back to the network address. This code:

    print NetAddr::IP->new('10.0.0.1/24') + 255;

    outputs 10.0.0.0/24.

Returns the the unchanged object when the constant is missing or out of
range.

    2147483647 <= constant >= -2147483648

=item B)>

The complement of the addition of a constant.

=item B)>

Returns the difference between the address parts of two NetAddr::IP
objects address parts as a 32 bit signed number.

Returns B if the difference is out of range.

(See range restrictions on Addition above)

=item B

Auto-incrementing a NetAddr::IP object causes the address part to be
adjusted to the next host address within the subnet. It will wrap at
the broadcast address and start again from the network address.

=item B

Auto-decrementing a NetAddr::IP object performs exactly the opposite
of auto-incrementing it, as you would expect.

=cut

				#############################################
				# End of the overload methods.
				#############################################


# Preloaded methods go here.

=pod

=back

=head2 Serializing and Deserializing

This module defines hooks to collaborate with L for
serializing C objects, through compact and human readable
strings. You can revert to the old format by invoking this module as

  use NetAddr::IP ':old_storable';

You must do this if you have legacy data files containing NetAddr::IP
objects stored using the L module.

=cut

my $full_format = "%04X:%04X:%04X:%04X:%04X:%04X:%D.%D.%D.%D";
my $full6_format = "%04X:%04X:%04X:%04X:%04X:%04X:%04X:%04X";

sub import
{
    if (grep { $_ eq ':old_storable' } @_) {
	@_ = grep { $_ ne ':old_storable' } @_;
    } else {
	*{STORABLE_freeze} = sub
	{
	    my $self = shift;
	    return $self->cidr();	# use stringification
	};
	*{STORABLE_thaw} = sub
	{
	    my $self	= shift;
	    my $cloning	= shift;	# Not used
	    my $serial	= shift;

	    my $ip = new NetAddr::IP $serial;
	    $self->{addr} = $ip->{addr};
	    $self->{mask} = $ip->{mask};
	    $self->{isv6} = $ip->{isv6};
	    return;
	};
    }

    if (grep { $_ eq ':aton' } @_)
    {
	$NetAddr::IP::Lite::Accept_Binary_IP = 1;
	@_ = grep { $_ ne ':aton' } @_;
    }
    if (grep { $_ eq ':old_nth' } @_)
    {
	$NetAddr::IP::Lite::Old_nth = 1;
	@_ = grep { $_ ne ':old_nth' } @_;
    }
    if (grep { $_ eq ':nofqdn'} @_)
    {
	$NetAddr::IP::NetAddr::IP::Lite::NoFQDN = 1;
	@_ = grep { $_ ne ':nofqdn' } @_;
    }
    if (grep { $_ eq ':lower' } @_)
    {
        $full_format = lc($full_format);
        $full6_format = lc($full6_format);
        NetAddr::IP::Util::lower();
	@_ = grep { $_ ne ':lower' } @_;
    }
    if (grep { $_ eq ':upper' } @_)
    {
        $full_format = uc($full_format);
        $full6_format = uc($full6_format);
        NetAddr::IP::Util::upper();
	@_ = grep { $_ ne ':upper' } @_;
    }
    if (grep { $_ eq ':rfc3021' } @_)
    {
	$rfc3021 = 1;
        @_ = grep { $_ ne ':rfc3021' } @_;
    }
    NetAddr::IP->export_to_level(1, @_);
}

sub compact {
    return (ref $_[0] eq 'ARRAY')
	? compactref($_[0])	# Compact(\@list)
	: @{compactref(\@_)};	# Compact(@list)  or ->compact(@list)
}

*Compact = \&compact;

sub Coalesce {
  return &coalesce;
}

sub hostenumref($) {
  my $r = _splitref(0,$_[0]);
  unless ((notcontiguous($_[0]->{mask}))[1] == 128 ||
	  ($rfc3021 && $_[0]->masklen == 31) ) {
    splice(@$r, 0, 1);
    splice(@$r, scalar @$r - 1, 1);
  }
  return $r;
}

sub splitref {
  unshift @_, 0;	# mark as no reverse
# perl 5.8.4 fails with this operation. see perl bug [ 23429]
#  goto &_splitref;
  &_splitref;
}

sub rsplitref {
  unshift @_, 1;	# mark as reversed
# perl 5.8.4 fails with this operation. see perl bug [ 23429]
#  goto &_splitref;
  &_splitref;
}

sub split {
  unshift @_, 0;	# mark as no reverse
  my $rv = &_splitref;
  return $rv ? @$rv : ();
}

sub rsplit {
  unshift @_, 1;	# mark as reversed
  my $rv = &_splitref;
  return $rv ? @$rv : ();
}

sub full($) {
  if (! $_[0]->{isv6} && isIPv4($_[0]->{addr})) {
    my @hex = (unpack("n8",$_[0]->{addr}));
    $hex[9] = $hex[7] & 0xff;
    $hex[8] = $hex[7] >> 8;
    $hex[7] = $hex[6] & 0xff;
    $hex[6] >>= 8;
    return sprintf($full_format,@hex);
  } else {
    &full6;
  }
}

sub full6($) {
  my @hex = (unpack("n8",$_[0]->{addr}));
  return sprintf($full6_format,@hex);
}

sub full6m($) {
  my @hex = (unpack("n8",$_[0]->{mask}));
  return sprintf($full6_format,@hex);
}

sub DESTROY {};

1;
__END__