require 5.000;
@ISA = qw(Exporter);
%EXPORT_TAGS = ( 'all' => [ qw( range2cidr
cidr2range
cidr2octets
cidradd
cidrlookup
cidrvalidate
addr2cidr
addrandmask2cidr
) ] );
@EXPORT_OK = ( qw( range2cidr
cidr2range
cidr2octets
cidradd
cidrlookup
cidrvalidate
addr2cidr
addrandmask2cidr
));
@EXPORT = qw(
);
$VERSION = "0.23";
1;
sub cidr2range {
my @cidr=@_;
my @r;
while ($#cidr >= 0)
{
my $cidr=shift @cidr;
$cidr =~ s/\s//g;
unless ($cidr =~ /(.*)\/(.*)/)
{
push @r, $cidr;
next;
}
my ($ip, $pfix)=($1, $2);
my $isipv6;
my @ips=_iptoipa($ip);
$isipv6=shift @ips;
croak "$pfix, as in '$cidr', does not make sense"
unless $pfix >= 0 && $pfix <= ($#ips+1) * 8 && $pfix =~ /^[0-9]+$/;
my @rr=_cidr2iprange($pfix, @ips);
while ($#rr >= 0)
{
my $a=shift @rr;
my $b=shift @rr;
$a =~ s/\.$//;
$b =~ s/\.$//;
if ($isipv6)
{
$a=_ipv4to6($a);
$b=_ipv4to6($b);
}
push @r, "$a-$b";
}
}
return @r;
}
sub _ipv6to4 {
my $ipv6=shift;
return (undef, $ipv6) unless $ipv6 =~ /:/;
croak "Syntax error: $ipv6"
unless $ipv6 =~ /^[a-fA-F0-9:\.]+$/;
my $ip4_suffix="";
($ipv6, $ip4_suffix)=($1, $2)
if $ipv6 =~ /^(.*:)([0-9]+\.[0-9\.]+)$/;
$ipv6 =~ s/([a-fA-F0-9]+)/_h62d($1)/ge;
my $ipv6_suffix="";
if ($ipv6 =~ /(.*)::(.*)/)
{
($ipv6, $ipv6_suffix)=($1, $2);
$ipv6_suffix .= ".$ip4_suffix";
}
else
{
$ipv6 .= ".$ip4_suffix";
}
my @p=grep (/./, split (/[^0-9]+/, $ipv6));
my @s=grep (/./, split (/[^0-9]+/, $ipv6_suffix));
push @p, 0 while $#p + $#s < 14;
my $n=join(".", @p, @s);
return (1, $n);
}
sub _ipv4to6 {
my @octets=split(/[^0-9]+/, shift);
croak "Internal error in _ipv4to6"
unless $#octets == 15;
my @dummy=@octets;
return ("::ffff:" . join(".", $octets[12], $octets[13], $octets[14], $octets[15]))
if join(".", splice(@dummy, 0, 12)) eq "0.0.0.0.0.0.0.0.0.0.255.255";
my @words;
my $i;
for ($i=0; $i < 8; $i++)
{
$words[$i]=sprintf("%x", $octets[$i*2] * 256 + $octets[$i*2+1]);
}
my $ind= -1;
my $indlen= -1;
for ($i=0; $i < 8; $i++)
{
next unless $words[$i] eq "0";
my $j;
for ($j=$i; $j < 8; $j++)
{
last if $words[$j] ne "0";
}
if ($j - $i > $indlen)
{
$indlen= $j-$i;
$ind=$i;
$i=$j-1;
}
}
return "::" if $indlen == 8;
return join(":", @words) if $ind < 0;
my @s=splice (@words, $ind+$indlen);
return join(":", splice (@words, 0, $ind)) . "::"
. join(":", @s);
}
sub _iptoipa {
my $iparg=shift;
my $isipv6;
my $ip;
($isipv6, $ip)=_ipv6to4($iparg);
my @ips= split (/\.+/, $ip);
grep {
croak "$_, in $iparg, is not a byte" unless $_ >= 0 && $_ <= 255 && $_ =~ /^[0-9]+$/;
} @ips;
return ($isipv6, @ips);
}
sub _h62d {
my $h=shift;
$h=hex("0x$h");
return ( int($h / 256) . "." . ($h % 256));
}
sub _cidr2iprange {
my @ips=@_;
my $pfix=shift @ips;
if ($pfix == 0)
{
grep { $_=0 } @ips;
my @ips2=@ips;
grep { $_=255 } @ips2;
return ( join(".", @ips), join(".", @ips2));
}
if ($pfix >= 8)
{
my $octet=shift @ips;
@ips=_cidr2iprange($pfix - 8, @ips);
grep { $_="$octet.$_"; } @ips;
return @ips;
}
my $octet=shift @ips;
grep { $_=0 } @ips;
my @ips2=@ips;
grep { $_=255 } @ips2;
my @r= _cidr2range8(($octet, $pfix));
$r[0] = join (".", ($r[0], @ips));
$r[1] = join (".", ($r[1], @ips2));
return @r;
}
sub addr2cidr {
my @ips=_iptoipa(shift);
my $isipv6=shift @ips;
my $nbits;
if ($isipv6)
{
croak "An IPv6 address is 16 bytes long" unless $#ips == 15;
$nbits=128;
}
else
{
croak "An IPv4 address is 4 bytes long" unless $#ips == 3;
$nbits=32;
}
my @blocks;
foreach my $bits (reverse 0..$nbits)
{
my @ipcpy=@ips;
my $n=$bits;
while ($n < $nbits)
{
@ipcpy[$n / 8] &= (0xFF00 >> ($n % 8));
$n += 8;
$n &= 0xF8;
}
my $s=join(".", @ipcpy);
push @blocks, ($isipv6 ? _ipv4to6($s):$s) . "/$bits";
}
return @blocks;
}
sub addrandmask2cidr {
my $address = shift;
my($a_isIPv6) = _ipv6to4($address);
my($n_isIPv6, $netmask) = _ipv6to4(shift);
die("Both address and netmask must be the same type")
if( defined($a_isIPv6) && defined($n_isIPv6) && $a_isIPv6 != $n_isIPv6);
my $bitsInNetmask = 0;
my $previousNMoctet = 255;
foreach my $octet (split/\./, $netmask) {
die("Invalid netmask") if($previousNMoctet != 255 && $octet != 0);
$previousNMoctet = $octet;
$bitsInNetmask +=
($octet == 255) ? 8 :
($octet == 254) ? 7 :
($octet == 252) ? 6 :
($octet == 248) ? 5 :
($octet == 240) ? 4 :
($octet == 224) ? 3 :
($octet == 192) ? 2 :
($octet == 128) ? 1 :
($octet == 0) ? 0 :
die("Invalid netmask");
}
return (grep { /\/$bitsInNetmask$/ } addr2cidr($address))[0];
}
sub range2cidr {
my @r=@_;
my $i;
my @c;
for ($i=0; $i <= $#r; $i++)
{
$r[$i] =~ s/\s//g;
if ($r[$i] =~ /\//)
{
push @c, $r[$i];
next;
}
$r[$i]="$r[$i]-$r[$i]" unless $r[$i] =~ /(.*)-(.*)/;
$r[$i] =~ /(.*)-(.*)/;
my ($a,$b)=($1,$2);
my $isipv6_1;
my $isipv6_2;
($isipv6_1, $a)=_ipv6to4($a);
($isipv6_2, $b)=_ipv6to4($b);
if ($isipv6_1 || $isipv6_2)
{
croak "Invalid netblock range: $r[$i]"
unless $isipv6_1 && $isipv6_2;
}
my @a=split(/\.+/, $a);
my @b=split(/\.+/, $b);
croak unless $#a == $#b;
my @cc=_range2cidr(\@a, \@b);
while ($#cc >= 0)
{
$a=shift @cc;
$b=shift @cc;
$a=_ipv4to6($a) if $isipv6_1;
push @c, "$a/$b";
}
}
return @c unless(1==@r && 1==@c && !wantarray());
return $c[0];
}
sub _range2cidr {
my $a=shift;
my $b=shift;
my @a=@$a;
my @b=@$b;
$a=shift @a;
$b=shift @b;
return _range2cidr8($a, $b) if $#a < 0; # Least significant octet pair.
croak "Bad starting address\n" unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/;
croak "Bad ending address\n" unless $b >= 0 && $b <= 255 && $b =~ /^[0-9]+$/ && $b >= $a;
my @c;
if ($a == $b)
{
my @cc= _range2cidr(\@a, \@b);
while ($#cc >= 0)
{
my $c=shift @cc;
push @c, "$a.$c";
$c=shift @cc;
push @c, $c+8;
}
return @c;
}
my $start0=1;
my $end255=1;
grep { $start0=0 unless $_ == 0; } @a;
grep { $end255=0 unless $_ == 255; } @b;
if ( ! $start0 )
{
my @bcopy=@b;
grep { $_=255 } @bcopy;
my @cc= _range2cidr(\@a, \@bcopy);
while ($#cc >= 0)
{
my $c=shift @cc;
push @c, "$a.$c";
$c=shift @cc;
push @c, $c + 8;
}
++$a;
}
if ( ! $end255 )
{
my @acopy=@a;
grep { $_=0 } @acopy;
my @cc= _range2cidr(\@acopy, \@b);
while ($#cc >= 0)
{
my $c=shift @cc;
push @c, "$b.$c";
$c=shift @cc;
push @c, $c + 8;
}
--$b;
}
if ($a <= $b)
{
grep { $_=0 } @a;
my $pfix=join(".", @a);
my @cc= _range2cidr8($a, $b);
while ($#cc >= 0)
{
my $c=shift @cc;
push @c, "$c.$pfix";
$c=shift @cc;
push @c, $c;
}
}
return @c;
}
sub _range2cidr8 {
my @c;
my @r=@_;
while ($#r >= 0)
{
my $a=shift @r;
my $b=shift @r;
croak "Bad starting address\n" unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/;
croak "Bad ending address\n" unless $b >= 0 && $b <= 255 && $b =~ /^[0-9]+$/ && $b >= $a;
++$b;
while ($a < $b)
{
my $i=0;
my $n=1;
while ( ($n & $a) == 0)
{
++$i;
$n <<= 1;
last if $i >= 8;
}
while ($i && $n + $a > $b)
{
--$i;
$n >>= 1;
}
push @c, $a;
push @c, 8-$i;
$a += $n;
}
}
return @c;
}
sub _cidr2range8 {
my @c=@_;
my @r;
while ($#c >= 0)
{
my $a=shift @c;
my $b=shift @c;
croak "Bad starting address" unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/;
croak "Bad ending address" unless $b >= 0 && $b <= 8 && $b =~ /^[0-9]+$/;
my $n= 1 << (8-$b);
$a &= ($n-1) ^ 255;
push @r, $a;
push @r, $a + ($n-1);
}
return @r;
}
sub _ipcmp {
my $aa=shift;
my $bb=shift;
my $isipv6_1;
my $isipv6_2;
($isipv6_1, $aa)=_ipv6to4($aa);
($isipv6_2, $bb)=_ipv6to4($bb);
my @a=split (/\./, $aa);
my @b=split (/\./, $bb);
unshift @a, (0,0,0,0,0,0,0,0,0,0,255,255)
unless $isipv6_1;
unshift @b, (0,0,0,0,0,0,0,0,0,0,255,255)
unless $isipv6_2;
croak "Different number of octets in IP addresses" unless $#a == $#b;
while ($#a >= 0 && $a[0] == $b[0])
{
shift @a;
shift @b;
}
return 0 if $#a < 0;
return $a[0] <=> $b[0];
}
sub cidr2octets {
my @cidr=@_;
my @r;
while ($#cidr >= 0)
{
my $cidr=shift @cidr;
$cidr =~ s/\s//g;
croak "CIDR \"$cidr\" doesn't look like a CIDR\n" unless ($cidr =~ /(.*)\/(.*)/);
my ($ip, $pfix)=($1, $2);
my $isipv6;
my @ips=_iptoipa($ip);
$isipv6=shift @ips;
croak "$pfix, as in '$cidr', does not make sense"
unless $pfix >= 0 && $pfix <= ($#ips+1) * 8 && $pfix =~ /^[0-9]+$/;
my $i;
for ($i=0; $i <= $#ips; $i++)
{
last if $pfix - $i * 8 < 8;
}
my @msb=splice @ips, 0, $i;
my $bitsleft= $pfix - $i * 8;
if ($#ips < 0 || $bitsleft == 0)
{
if ($pfix == 0 && $bitsleft == 0)
{
foreach (0..255)
{
my @n=($_);
if ($isipv6)
{
_push_ipv6_octets(\@r, \@n);
}
else
{
push @r, $n[0];
}
}
}
elsif ($isipv6)
{
_push_ipv6_octets(\@r, \@msb);
}
else
{
push @r, join(".", @msb);
}
next;
}
my @rr=_cidr2range8(($ips[0], $bitsleft));
while ($#rr >= 0)
{
my $a=shift @rr;
my $b=shift @rr;
grep {
if ($isipv6)
{
push @msb, $_;
_push_ipv6_octets(\@r, \@msb);
pop @msb;
}
else
{
push @r, join(".", (@msb, $_));
}
} ($a .. $b);
}
}
return @r;
}
sub _push_ipv6_octets {
my $ary_ref=shift;
my $octets=shift;
if ( ($
{
foreach (0 .. 255)
{
push @$octets, $_;
_push_ipv6_octets($ary_ref, $octets);
pop @$octets;
}
return;
}
my $i;
my $s="";
for ($i=0; $i <= $
{
$s .= ":" if $s ne "";
$s .= sprintf("%02x%02x", $$octets[$i], $$octets[$i+1]);
}
push @$ary_ref, $s;
}
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 =~ /(.*)-/;
my $d=$1;
my $e=_ipcmp($c, $d);
return $e;
} @cidr;
$i=0;
while ($i < $#cidr)
{
$cidr[$i] =~ /(.*)-(.*)/;
my ($k, $l)=($1, $2);
$cidr[$i+1] =~ /(.*)-(.*)/;
my ($m, $n)=($1, $2);
if (_ipcmp( _add1($l), $m) == 0)
{
splice @cidr, $i, 2, "$k-$n";
next;
}
++$i;
}
return range2cidr(@cidr);
}
sub _add1 {
my $n=shift;
my $isipv6;
($isipv6, $n)=_ipv6to4($n);
my @ip=split(/\./, $n);
my $i=$#ip;
while ($i >= 0)
{
last if ++$ip[$i] < 256;
$ip[$i]=0;
--$i;
}
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;
}
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;
}
sub _compress_ipv6 {
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));
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;
}
sub cidrvalidate {
my $v=shift;
$v =~ s/\s//g;
$v=lc($v);
my $suffix;
($v, $suffix)=($1, $2) if $v =~ m@(.*)/(.*)@;
if (defined $suffix)
{
return undef unless $suffix =~ /^\d+$/ &&
($suffix eq "0" || $suffix =~ /^[123456789]/);
}
if ($v =~ /^([0-9\.]+)$/ || $v =~ /^::ffff:([0-9\.]+)$/ ||
$v =~ /^:([0-9\.]+)$/)
{
my $n=$1;
return undef if $n =~ /^\./ || $n =~ /\.$/ || $n =~ /\.\./;
my @o= split(/\./, $n);
while ($#o < 3)
{
push @o, "0";
}
$n=join(".", @o);
return undef if $#o != 3;
foreach (@o)
{
return undef if /^0./;
return undef if $_ < 0 || $_ > 255;
}
if ($v =~ /^::ffff/)
{
$suffix=128 unless defined $suffix;
return undef if $suffix < 128-32;
$suffix -= 128-32;
}
else
{
$suffix=32 unless defined $suffix;
}
foreach (addr2cidr($n))
{
return $_ if $_ eq "$n/$suffix";
}
return undef;
}
return undef unless $v =~ /^[0-9a-f:]+$/;
return undef if $v =~ /:::/ || $v =~ /^:[^:]/ || $v =~ /[^:]:$/
|| $v =~ /::.*::/;
my @o=grep (/./, split(/:/, $v));
return undef if ($#o >= 8 || ($#o<7 && $v !~ /::/));
foreach (@o)
{
return undef if length ($_) > 4;
}
$suffix=128 unless defined $suffix;
$v =~ s/([0-9A-Fa-f]+)/_triml0($1)/ge;
my $compressed = _compress_ipv6($v);
foreach (addr2cidr($v))
{
return $_ if $_ eq "$compressed/$suffix";
}
return undef;
}
sub _triml0 {
my ($a) = @_;
$a =~ s/^0+//g;
$a = "0" if $a eq '';
return $a
}