view release on metacpan or  search on metacpan

lib/Net/CIDR.pm  view on Meta::CPAN

sub _push_ipv6_octets {
    my $ary_ref=shift;
    my $octets=shift;

    if ( ($#{$octets} % 2) == 0)	# Odd number of octets
    {
	foreach (0 .. 255)
	{
	    push @$octets, $_;
	    _push_ipv6_octets($ary_ref, $octets);
	    pop @$octets;
	}
	return;
    }

    my $i;
    my $s="";

    for ($i=0; $i <= $#{$octets}; $i += 2)
    {
	$s .= ":" if $s ne "";
	$s .= sprintf("%02x%02x", $$octets[$i], $$octets[$i+1]);
    }
    push @$ary_ref, $s;
}

=pod

=head2 @cidr_list=Net::CIDR::cidradd($block, @cidr_list);

The cidradd() functions allows a CIDR list to be built one CIDR netblock
at a time, merging adjacent and overlapping ranges.
$block is a single netblock, expressed as either "start-finish", or
"address/prefix".
Example:

    @cidr_list=Net::CIDR::range2cidr("192.168.0.0-192.168.0.255");
    @cidr_list=Net::CIDR::cidradd("10.0.0.0/8", @cidr_list);
    @cidr_list=Net::CIDR::cidradd("192.168.1.0-192.168.1.255", @cidr_list);

The result is a two-element array: ("10.0.0.0/8", "192.168.0.0/23").
IPv6 addresses are handled in an analogous fashion.

=cut

sub cidradd {
    my @cidr=@_;

    my $ip=shift @cidr;

    $ip="$ip-$ip" unless $ip =~ /[-\/]/;

    unshift @cidr, $ip;

    @cidr=cidr2range(@cidr);

    my @a;
    my @b;

    grep {
	croak "Range $_ doesn't look like start-end\n" unless /(.*)-(.*)/;
	push @a, $1;
	push @b, $2;
    } @cidr;

    my $lo=shift @a;
    my $hi=shift @b;

    my $i;

    for ($i=0; $i <= $#a; $i++)
    {
	last if _ipcmp($lo, $hi) > 0;

	next if _ipcmp($b[$i], $lo) < 0;
	next if _ipcmp($hi, $a[$i]) < 0;

	if (_ipcmp($a[$i],$lo) <= 0 && _ipcmp($hi, $b[$i]) <= 0)
	{
	    $lo=_add1($hi);
	    last;
	}

	if (_ipcmp($a[$i],$lo) <= 0)
	{
	    $lo=_add1($b[$i]);
	    next;
	}

	if (_ipcmp($hi, $b[$i]) <= 0)
	{
	    $hi=_sub1($a[$i]);
	    next;
	}

	$a[$i]=undef;
	$b[$i]=undef;
    }

    unless ((! defined $lo) || (! defined $hi) || _ipcmp($lo, $hi) > 0)
    {
	push @a, $lo;
	push @b, $hi;
    }

    @cidr=();

    @a=grep ( (defined $_), @a);
    @b=grep ( (defined $_), @b);

    for ($i=0; $i <= $#a; $i++)
    {
	push @cidr, "$a[$i]-$b[$i]";
    }

    @cidr=sort {
	$a =~ /(.*)-/;

	my $c=$1;

	$b =~ /(.*)-/;

lib/Net/CIDR.pm  view on Meta::CPAN

    }

    return undef if $i < 0;

    $i=join(".", @ip);
    $i=_ipv4to6($i) if $isipv6;
    return $i;

}

sub _sub1 {
    my $n=shift;

    my $isipv6;

    ($isipv6, $n)=_ipv6to4($n);

    my @ip=split(/\./, $n);

    my $i=$#ip;

    while ($i >= 0)
    {
	last if --$ip[$i] >= 0;
	$ip[$i]=255;
	--$i;
    }

    return undef if $i < 0;

    $i=join(".", @ip);
    $i=_ipv4to6($i) if $isipv6;
    return $i;
}

=pod

=head2 $found=Net::CIDR::cidrlookup($ip, @cidr_list);

Search for $ip in @cidr_list.  $ip can be a single IP address, or a
netblock in CIDR or start-finish notation.
lookup() returns 1 if $ip overlaps any netblock in @cidr_list, 0 if not.

=cut

sub cidrlookup {
    my @cidr=@_;

    my $ip=shift @cidr;

    $ip="$ip-$ip" unless $ip =~ /[-\/]/;

    unshift @cidr, $ip;

    @cidr=cidr2range(@cidr);

    my @a;
    my @b;

    grep {
	croak "Range $_ doesn't look like start-end\n" unless /(.*)-(.*)/;
	push @a, $1;
	push @b, $2;
    } @cidr;

    my $lo=shift @a;
    my $hi=shift @b;

    my $i;

    for ($i=0; $i <= $#a; $i++)
    {
	next if _ipcmp($b[$i], $lo) < 0;
	next if _ipcmp($hi, $a[$i]) < 0;
	return 1;
    }

    return 0;
}

=pod

=head2 $ip=Net::CIDR::cidrvalidate($ip);

Validate whether $ip is a valid IPv4 or IPv6 address, or a CIDR.
Returns its validated argument or undef.
Spaces are removed, and IPv6 hexadecimal address are converted to lowercase.

$ip with less than four octets gets filled out with additional octets, and
the modified value gets returned. This turns "192.168/16" into a proper
"192.168.0.0/16".

If $ip contains a "/", it must be a valid CIDR, otherwise it must be a valid
IPv4 or an IPv6 address.

A technically invalid CIDR, such as "192.168.0.1/24" fails validation, returning
undef.

=cut

sub _compress_ipv6 {
    # taken from IPv6::Address on CPAN
    my $str = shift;
    return '::' if($str eq '0:0:0:0:0:0:0:0');
    for(my $i=7;$i>1;$i--) {
            my $zerostr = join(':',split('','0'x$i));
            ###print "DEBUG: $str $zerostr \n";
            if($str =~ /:$zerostr$/) {
                    $str =~ s/:$zerostr$/::/;
                    return $str;
            }
            elsif ($str =~ /:$zerostr:/) {
                    $str =~ s/:$zerostr:/::/;
                    return $str;
            }
            elsif ($str =~ /^$zerostr:/) {
                    $str =~ s/^$zerostr:/::/;
                    return $str;
            }
    }
    return $str;