#!/usr/bin/perl -w
######################################################################
# aggregate.pl                                           Novermber 1999
# Horms                                            horms@vergenet.net.
# Verge Systems International                    http://vergenet.net./
#
# Licenced under the terms of the GNU GPL
#
# Agregate networks 
######################################################################

use strict;
use Socket;

my @bit_lookup;

{
  my $ip1_dec;
  my $ip2_dec;
  my (@net, $net);

  &generate_bit_lookup();

  while(<>){
    print;
    if(m/^\s*(\S+)\s+(-\s+)?(\S+)\s*$/){
      if(
        ($ip1_dec=ip_to_decimal($1))>=0 and 
        ($ip2_dec=ip_to_decimal($3))>=0
      ){
        @net=&cidr_range($ip1_dec, $ip2_dec);
        foreach $net (@net){
          $net=~/^([^\/]+)\/(\d+)/;
          printf(" %s/%s\n", &decimal_to_ip($1), $2);
        }
      }
    }
  }
}


######################################################################
# isip
# Check that a given string is an IP address
# pre: alleged_ip: string representing ip address
# post: 1 if alleged_ip is a valid ip address
#       0 otherwise
######################################################################

sub is_ip {
  my ($alleged_ip)=(@_);

  #If we don't have four, . delimited numbers then we have no hope
  unless($alleged_ip=~m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { return 0; }

  #Each octet mist be >=0 and <=255
  unless(&is_octet($1)){ return 0; }
  unless(&is_octet($2)){ return 0; }
  unless(&is_octet($3)){ return 0; }
  unless(&is_octet($4)){ return 0; }

  return(1);
}


######################################################################
# See if a number is an octet, that is >=0 and <=255
# pre: alleged_octet: the octect to test
# post: 1 if the alleged_octet is an octet
#       0 otherwise
######################################################################

sub is_octet {
  my ($alleged_octet)=(@_);

  if($alleged_octet<0){ return 0; }
  if($alleged_octet>255){ return 0; }

  return(1);
}

######################################################################
# ip_to_decimal
# Turn an IP address given as a dotted quad into a decimal
# pre: ip_address: string representing IP address
# post: -1 if an error occurs
#       decimal representation of IP address otherwise
######################################################################

sub ip_to_decimal {
  my ($ip_address)=(@_);

  unless(&is_ip($ip_address)){ return(-1); }
  unless($ip_address=~m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){ return(-1); }

  return($4+(256*($3+256*($2+256*$1))));
}
  

######################################################################
# decimal_to_ip
# Turn an IP address given as a dotted quad into a decimal
# pre: ip_address: string representing IP address
# post: -1 if an error occurs
#       decimal representation of IP address otherwise
######################################################################

sub decimal_to_ip {
  my ($ip_address)=(@_);

  my $result="";

  return(sprintf(
    "%d.%d.%d.%d",
    ($ip_address>>24)&255,
    ($ip_address>>16)&255,
    ($ip_address>>8)&255,
    $ip_address&255
  ));
}
  

######################################################################
# prefix
# Arghh this is really nasty, I am sure there is a better way to do this
# Get the network prefix (32-number of trailing zeros)
# Works on 32bit numbers
# pre: number: number
# post: number of trailing zeros.
#       32 for zero
#       -1 if number is negative, or not an integer
######################################################################

sub prefix {
  my ($number)=(@_);

  my ($i,$j);

  if($number<0){ return(-1); }
  if(int($number) != $number){ return(-1); }
  
  for($i=32,$j=1;$i>0;$i--,$j<<=1){
    if($number & $j){
      goto leave;
    }
  }
 
  leave:
  return($i);
}


######################################################################
# log_2
# Arghh this is really nasty, I am sure there is a better way to do this
# Get log base 2 of a 32 bit integer, rounded down to the nearest integer
# Works on 32bit numbers
# pre: number: number
# post: number of trailing zeros.
#       32 for zero
#       -1 if number is negative, or not an integer
######################################################################

sub log_2 {
  my ($number)=(@_);

  my ($i,$j);

  if($number<0){ return(-1); }
  if(int($number) != $number){ return(-1); }
  
  for($i=31,$j=1<<31;$i>0;$i--,$j>>=1){
    if($number & $j){
      goto leave;
    }
  }
 
  leave:
  return($i);
}


######################################################################
# cidr_range
# Given a range return a list of aggregated networks.
# Best case will give 1 aggregate
# pre: ip1: first ip in range
#      ip2: last ip in range
# post: list of aggregates in <ip in decimal>/prefix
#       Empty list on error
######################################################################

sub cidr_range {
  my ($ip1, $ip2)=(@_);

  my ($difference, $ip1_prefix, $difference_prefix, @result);

  if(($difference=$ip2-$ip1)<0){ return(); }

  if($difference==0){
    return("$ip1/32");
  }

  @result=();
  while($difference>0){
    my ($prefix);

    $ip1_prefix=&prefix($ip1);
    $difference_prefix=31-&log_2($difference);

    $prefix=($difference_prefix>$ip1_prefix)?$difference_prefix:$ip1_prefix;
    push(@result, "$ip1/$prefix ");

    $ip1+=$bit_lookup[32-$prefix];
    $difference-=$bit_lookup[32-$prefix];
  }

  return(@result);
}
  
    
######################################################################
# generate_bit_lookup
# Generate an array with 33 elements where element n = 2^n
# pre: none
# post: @bit_loookup is seeded (or seedy as the case may be
######################################################################

sub generate_bit_lookup {
  my ($i, $current_seed);
 
  #note bitshift seems to break on >32 bits so I used *=2
  for($i=0,$current_seed=1;$i<33;$i++,$current_seed*=2){
    #print "$i $current_seed\n";
    $bit_lookup[$i]=$current_seed;
  }
}


######################################################################
# log_base
# Find log of a numbner
# pre: number: number to find log of
#      base: base 
# post: log , rounded down to an integer
######################################################################


sub log_base {
  my($number, $base)=(@_);
  return int log($number)/log($base);
}