# IPaddr.pm
# John Simpson <jms1@jms1.net> 2001-08-03
#
# routines for working with IP address objects. the "object" is actually a
# reference to a hash containing the binary IP address and the binary netmask.
#
# 2001-08-21 jms1 - adding block stuff (first, last, size, etc.)
#
# 2001-09-27 jms1 - adding interator (next)
#
# 2001-10-04 jms1 - next() now supports an optional "jump size" parameter
#   for counting by class-c blocks, etc.
#
# 2002-05-17 jms1 - adding tcprules-format extractor tcpr()
#
# 2007-11-11 jms1 - adding GPLv2/3 notice, no other code change.
#
###############################################################################
#
# Copyright (C) 2001,2002,2004,2007 John Simpson.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 or version 3 of the
# license, at your option.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
###############################################################################

package IPaddr ;
require 5.003 ;
use strict ;

###############################################################################
#
# startup stuff

BEGIN
{
        use Exporter ;
        use vars qw ( $VERSION @ISA @EXPORT @EXPORT_OK ) ;

        $VERSION        = 1.0 ;
        @ISA            = qw ( Exporter ) ;
        @EXPORT         = qw ( ) ;
        @EXPORT_OK      = qw ( ) ;
}

###############################################################################
#
# netmask constants

my @nm = qw
(
	0x00000000 0x80000000 0xC0000000 0xE0000000
	0xF0000000 0xF8000000 0xFC000000 0xFE000000
	0xFF000000 0xFF800000 0xFFC00000 0xFFE00000
	0xFFF00000 0xFFF80000 0xFFFC0000 0xFFFE0000
	0xFFFF0000 0xFFFF8000 0xFFFFC000 0xFFFFE000
	0xFFFFF000 0xFFFFF800 0xFFFFFC00 0xFFFFFE00
	0xFFFFFF00 0xFFFFFF80 0xFFFFFFC0 0xFFFFFFE0
	0xFFFFFFF0 0xFFFFFFF8 0xFFFFFFFC 0xFFFFFFFE
	0xFFFFFFFF
) ;

###############################################################################
#
# constructor. recognizes ip addresses in the following formats:
# $			reference to another IPaddr object (copy object)
# A.B.C.D/E.F.G.H	dotted-quad IP and dotted quad netmask
# A.B.C.D/M		dotted-quad IP and CIDR netmask
# A.B.C.D		dotted-quad IP (assume /32 netmask)
# bI/bM			binary IP and binary netmask
# bI			binary IP (assume /32 netmask)

sub new($$)
{
	my $type = shift ;
	my $input = shift ;
	my ( %obj , $robj ) ;

	if ( ref ( $input ) eq "IPaddr" )
	{
		$obj{"ip"} = $$input{"ip"} ;
		$obj{"mask"} = $$input{"mask"} ;
		$robj = \%obj ;
		return bless ( $robj , $type ) ;
	}
	elsif ( ref ( $input ) )
	{
		die ( "IPaddr::new(): input is a reference to a {"
			. ref ( $input ) . "} object.\n" ) ;
	}

	if ( $input =~ m|^\s*(\d+)\.(\d+)\.(\d+)\.(\d+)/(\d+)\.(\d+)\.(\d+)\.(\d+)\s*| )
	{
		my ( $a , $b , $c , $d , $e , $f , $g , $h ) =
		   ( $1 , $2 , $3 , $4 , $5 , $6 , $7 , $8 ) ;
		$obj{"ip"}   = ( $a << 24 ) | ( $b << 16 ) | ( $c << 8 ) | $d ;
		$obj{"mask"} = ( $e << 24 ) | ( $f << 16 ) | ( $g << 8 ) | $h ;
		$robj = \%obj ;
		return bless ( $robj , $type ) ;
	}

	if ( $input =~ m|^\s*(\d+)\.(\d+)\.(\d+)\.(\d+)/(\d+)\s*| )
	{
		my ( $a , $b , $c , $d , $m ) = ( $1 , $2 , $3 , $4 , $5 ) ;
		$obj{"ip"}   = ( $a << 24 ) | ( $b << 16 ) | ( $c << 8 ) | $d ;
		$obj{"mask"} = oct $nm[$m] ;
		$robj = \%obj ;
		return bless ( $robj , $type ) ;
	}

	if ( $input =~ m|^\s*(\d+)\.(\d+)\.(\d+)\.(\d+)\s*$| )
	{
		my ( $a , $b , $c , $d ) = ( $1 , $2 , $3 , $4 ) ;
		$obj{"ip"} = ( $a << 24 ) | ( $b << 16 ) | ( $c << 8 ) | $d ;
		$obj{"mask"} = 0xFFFFFFFF ;
		$robj = \%obj ;
		return bless ( $robj , $type ) ;
	}

	if ( $input =~ m|^\s*(\d+)/(\d+)\s*$| )
	{
		$obj{"ip"} = $1 ;
		$obj{"mask"} = $2 ;
		$robj = \%obj ;
		return bless ( $robj , $type ) ;
	}

	if ( $input =~ m|^\s*(\d+)\s*$| )
	{
		$obj{"ip"} = $1 ;
		$obj{"mask"} = 0xFFFFFFFF ;
		$robj = \%obj ;
		return bless ( $robj , $type ) ;
	}

	return undef ;
}

###############################################################################
#
# extractors for ip address portion

sub ip_a($)
{
	return ( ${$_[0]}{"ip"} & 0xFF000000 ) >> 24 ;
}

sub ip_b($)
{
	return ( ${$_[0]}{"ip"} & 0xFF0000 ) >> 16 ;
}

sub ip_c($)
{
	return ( ${$_[0]}{"ip"} & 0xFF00 ) >> 8 ;
}

sub ip_d($)
{
	return ( ${$_[0]}{"ip"} & 0xFF ) ;
}

sub ip_bin($)
{
	return ${$_[0]}{"ip"} ;
}

sub ip_dq($)
{
	my $ip = ${$_[0]}{"ip"} ;
	my $a = ( $ip & 0xFF000000 ) >> 24 ;
	my $b = ( $ip &   0xFF0000 ) >> 16 ;
	my $c = ( $ip &     0xFF00 ) >>  8 ;
	my $d = ( $ip &       0xFF )       ;

	return sprintf ( "%d.%d.%d.%d" , $a , $b , $c , $d ) ;
}

sub ip_fdq($)
{
	my $ip = ${$_[0]}{"ip"} ;
	my $a = ( $ip & 0xFF000000 ) >> 24 ;
	my $b = ( $ip &   0xFF0000 ) >> 16 ;
	my $c = ( $ip &     0xFF00 ) >>  8 ;
	my $d = ( $ip &       0xFF )       ;

	return sprintf ( "%03d.%03d.%03d.%03d" , $a , $b , $c , $d ) ;
}

sub ip_hex($)
{
	return sprintf ( "%08X" , ${$_[0]}{"ip"} ) ;
}

###############################################################################
#
# extractors for netmask portion

sub mask_a($)
{
	return ( ${$_[0]}{"mask"} & 0xFF000000 ) >> 24 ;
}

sub mask_b($)
{
	return ( ${$_[0]}{"mask"} & 0xFF0000 ) >> 16 ;
}

sub mask_c($)
{
	return ( ${$_[0]}{"mask"} & 0xFF00 ) >> 8 ;
}

sub mask_d($)
{
	return ( ${$_[0]}{"mask"} & 0xFF ) ;
}

sub mask_bin($)
{
	return ${$_[0]}{"mask"} ;
}

sub mask_dq($)
{
	my $mask = ${$_[0]}{"mask"} ;
	my $a = ( $mask & 0xFF000000 ) >> 24 ;
	my $b = ( $mask &   0xFF0000 ) >> 16 ;
	my $c = ( $mask &     0xFF00 ) >>  8 ;
	my $d = ( $mask &       0xFF )       ;

	return sprintf ( "%d.%d.%d.%d" , $a , $b , $c , $d ) ;
}

sub mask_fdq($)
{
	my $mask = ${$_[0]}{"mask"} ;
	my $a = ( $mask & 0xFF000000 ) >> 24 ;
	my $b = ( $mask &   0xFF0000 ) >> 16 ;
	my $c = ( $mask &     0xFF00 ) >>  8 ;
	my $d = ( $mask &       0xFF )       ;

	return sprintf ( "%03d.%03d.%03d.%03d" , $a , $b , $c , $d ) ;
}

sub mask_hex($)
{
	return sprintf ( "%08X" , ${$_[0]}{"mask"} ) ;
}

sub mask_cidr($)
{
	my $mask = sprintf ( "0x%08X" , ${$_[0]}{"mask"} ) ;
	my $n ;

	for $n ( 0 .. $#nm )
	{
#		print "{mask=[$mask] nm[$n]=[$nm[$n]]}\n" ;

		if ( $mask eq $nm[$n] )
		{
			return $n ;
		}
	}

	return $_[0]->mask_dq ;
}

sub mask_size($)
{
	return ( ( ~ ( ${$_[0]}{"mask"} ) ) + 1 ) ;
}

###############################################################################
#
# combined extractor

sub ip_dqc($)
{
	return $_[0]->ip_dq . "/" . $_[0]->mask_cidr ;
}

###############################################################################
#
# extract REVERSED ip (i.e. "1.2.3.4" returns "4.3.2.1")

sub rvip_dq($)
{
	my $ip = $_[0]->{"ip"} ;
	my $a = ( $ip & 0xFF000000 ) >> 24 ;
	my $b = ( $ip &   0xFF0000 ) >> 16 ;
	my $c = ( $ip &     0xFF00 ) >>  8 ;
	my $d = ( $ip &       0xFF )       ;

	return sprintf ( "%d.%d.%d.%d" , $d , $c , $b , $a ) ;
}

###############################################################################
#
# see if a block contains another block

sub contains($$)
{
	my $me	= $_[0] ;
	my $tg	= $_[1] ;

	my ( $mi , $mm , $ti , $tm ) ;

	$mi = $me->ip_bin ;
	$mm = $me->mask_bin ;

	unless ( ( ref $tg ) eq "IPaddr" )
	{
		my $n = new IPaddr ( $tg ) ;
		$tg = $n ;
	}

	$ti = $tg->ip_bin ;
	$tm = $tg->mask_bin ;

	if ( $tm < $mm )
	{
#		print "Target block is larger than my block\n" ;
		return 0 ;
	}

	return ( ( $mi & $mm ) == ( $ti & $mm ) ) ? 1 : 0 ;
}

###############################################################################
#
# return the first address in a given block

sub first($)
{
	my $a = $_[0]->{"ip"} ;
	my $m = $_[0]->{"mask"} ;

	$a &= $m ;
	return new IPaddr ( "$a/$m" ) ;
}

###############################################################################
#
# return the last address in a given block

sub last($)
{
	my $a = $_[0]->{"ip"} ;
	my $m = $_[0]->{"mask"} ;

	$a |= ( ~ $m ) ;
	return new IPaddr ( "$a/$m" ) ;
}

###############################################################################
#
# return the "next" address within a given block.
# returns undef if the next value would go past the end of the block.
#
# optional parameter tells how much to add. defaults to one if not specified.
# useful for counting by a given block size.

sub next($;$)
{
	my $a = $_[0]->{"ip"} ;
	my $m = $_[0]->{"mask"} ;

	my $n =	$a + ( $_[1] || 1 ) ;

	if ( ( $a & $m ) == ( $n & $m ) )
	{
		return new IPaddr ( "$n/$m" ) ;
	}

	return undef ;
}

###############################################################################
#
# tcprules extractor

sub tcpr($)
{
	my $fip = $_[0]->first()->{"ip"} ;
	my $fa = ( $fip & 0xFF000000 ) >> 24 ;
	my $fb = ( $fip &   0xFF0000 ) >> 16 ;
	my $fc = ( $fip &     0xFF00 ) >>  8 ;
	my $fd = ( $fip &       0xFF )       ;

	my $lip = $_[0]->last()->{"ip"} ;
	my $la = ( $lip & 0xFF000000 ) >> 24 ;
	my $lb = ( $lip &   0xFF0000 ) >> 16 ;
	my $lc = ( $lip &     0xFF00 ) >>  8 ;
	my $ld = ( $lip &       0xFF )       ;

	my $cidr = $_[0]->mask_cidr() ;

	( $cidr > 31 ) && ( return "$fa.$fb.$fc.$fd"     ) ;
	( $cidr > 24 ) && ( return "$fa.$fb.$fc.$fd-$ld" ) ;

	( $cidr > 23 ) && ( return "$fa.$fb.$fc."     ) ;
	( $cidr > 16 ) && ( return "$fa.$fb.$fc-$lc." ) ;

	( $cidr > 15 ) && ( return "$fa.$fb."     ) ;
	( $cidr >  8 ) && ( return "$fa.$fb-$lb." ) ;

	( $cidr >  7 ) && ( return "$fa."     ) ;
	( $cidr >  0 ) && ( return "$fa-$la." ) ;

	return "" ;
}

###############################################################################
#
# outta here

1 ;