#!/usr/local/bin/perl -w
# $Id: cidraggr,v 1.6 2006/05/03 20:25:10 dogcow Exp $

# read the prod or corp networks file, removes nested blocks, tries to
# aggregate all possible blocks.

# it is highly recommended having entries for 1918 space superblocks.
use Getopt::Std;
my (%o);
getopts("lv", \%o);

sub dotted_to_long {
  my ($ip) = @_;
  return unpack("N", pack("CCCC", split /\./, $ip));
}

sub long_to_dotted {
  my ($long) = @_;
  return join ".", unpack("CCCC", pack("N", $long));
}

#pregen masks
for my $i (0..32) {
  my $size = (2 ** (32-$i));
  my $mask = ~($size - 1);
#  $mask[$i] = $mask;
  $size[$i] = $size;
#  $revmask{$mask} = $i;
  $revsize{$size} = $i;
}

my @prefixes;
while (<>) {
  s/^\s+//;
  next unless m/^\d/;
  @z = split /\s+/;
  my $poop = "";
  if ($z[0] =~ m!/!) {
    $poop = $z[0];
  } elsif ($z[1] =~ m/\d\d/) {
    $poop = "$z[0]/$z[1]";
    $poop =~ s/\/+/\//;
  }
  if ($poop ne "" && $poop =~ /^[1-9][0-9]+\./) {
    push @prefixes, $poop;
    print "got $poop\n" if defined $o{v};
  }
}
#my $tree = &buildpatrtrie;

my %blocks;
for my $i (@prefixes) {
  my ($host, $len) = split /\//, $i;
  my $l = dotted_to_long($host);
  if ($len !~ /\D/ && $len > 7) {
    my $ll = $size[$len];
    $blocks{"$l-$ll"} = ($l + $ll) . "-$ll";
  }
}

# and now, time for O(n^2)! yay!
# this could be done more efficiently with a tree, but...

#remove nested blocks
my @blo = sort { (split /-/,$b)[1] <=> (split /-/, $a)[1] } keys %blocks;
1;

for my $i (@blo) {
  next if ! defined $blocks{$i};
  my ($min, $len) = split /-/, $i;
  my $max = $min + $len - 1;
  for my $j (@blo) {
    next if $i eq $j;
    my ($k, $m) = split /-/, $j;
    if ($k >= $min && $k <= $max && $m <= $len) {
      print "Dupe: $j is in $i\n" if defined $o{v};
      delete $blocks{$j};
    }
  }
}

$oldlen = 0;
while ($oldlen != scalar keys %blocks) {
  $oldlen = scalar keys %blocks;
  for my $i (keys %blocks) {
    next if ! defined $blocks{$i};
    next if $i =~ m/[13579]-/; # for odd-numbered /32s
    if (defined $blocks{$blocks{$i}}) {
      my ($ho, $len) = split /-/, $i;
      print "aggregating $i and $blocks{$i} => ",
	long_to_dotted($ho), "/", $revsize{$len<<1}, "\n" if defined $o{v};
      delete $blocks{$blocks{$i}};
      delete $blocks{$i};
      $len <<= 1;
      $blocks{"$ho-$len"} = ($ho + $len) . "-$len";
    }
  }
}

for my $i (sort { (split /-/,$a)[0] <=> (split /-/, $b)[0] } keys %blocks) {
  my ($ho, $len) = split /-/, $i;
  if (defined $o{l} && $len > 65536) {
    print "poit! ($len)\n" if defined $o{v};
    for $j (1 .. ($len / 65536)) {
      print long_to_dotted($ho + 65536 * ($j-1)), "/16\n";
    }
    print "narf.\n" if defined $o{v};
  } else {
    print long_to_dotted($ho), "/", $revsize{$len}, "\n";
  }
}

# the following blocks of code do not actually work correctly.
# they are included for amusement value.

sub buildpatrtrie {
  my $ip = [];

# structure of the trie: how many levels down is the bitmask depth
# element 0 is pointer to 0 bit, element 1 is pointer to 1 bit;
# element 2 is the AS number (or whatever).

  for my $i (@prefixes) {
    my ($prefix, $len) = split /\//, $i;
    next if $len <= 7;
    addnode($ip, dotted_to_long($prefix), $len, 1, 1);
  }

# now, walk the tree, depth first,
# and aggregate nodes with two children of the same size.
#  &aggregate($ip, 1);

# and walk the tree, left first.
  &printtree($ip, "");

  exit 0;

}

sub addnode {
  my ($tree, $ip, $len, $as, $kill) = @_;
  my $ptr = $tree;
  my $oldptr;
  for my $depth (0 .. $len) {
    my $bit = (($ip & 0x8000) != 0);
    $ip &= 0x7fff;
    $ip <<= 1;
    if (defined $ptr->[2] && $ptr->[2] eq $as) {
#      print "Encountered less-specific\n";
      return;
    }
    if ($depth == $len) {
      $ptr->[2] = $as;
      if ($kill) {
	if (defined $ptr[0] || defined $ptr[1]) {
#	  print "killing more-specific bit 0\n";
	}
	$ptr[0] = undef;
	$ptr[1] = undef;
      }
      return;
    } else {
      $ptr->[2] = 0; # exists, but doesn't belong to anyone
    }
    $ptr->[$bit] = [ undef, undef, 0 ] if (! defined $ptr->[$bit]);
    $ptr = $ptr->[$bit];
  }
  return;
}

sub aggregate {
  my ($tree, $kill) = @_;
  for my $i (0, 1) {
    if (defined $tree->[$i]) {
      &aggregate($tree->[$i], $kill);
    }
  }
  if (defined $tree->[0] &&
      defined $tree->[1] &&
      $tree->[0]->[2] &&
      $tree->[0]->[2] eq $tree->[1]->[2]) {
    print "aggregating, woo!\n";
    $tree->[2] = $tree->[0]->[2];
    if ($kill) {
      $tree->[0] = undef;
      $tree->[1] = undef;
    } else {
      $tree->[0]->[2] = 0;
      $tree->[1]->[2] = 0;
    }
  }
}

sub printtree {
  my ($tree, $a) = @_;
  if ($tree->[2]) {
    my $y = length($a);
    print
      join ".", (unpack("CCCC", pack("B32", $a . "0" x (32-$y)))),
      "/$y\n";
    return;
  }
  for my $i (0, 1) {
    if (defined $tree->[$i]) {
      &printtree($tree->[$i], $a . $i);
    }
  }
}