#!/usr/bin/perl -w
# by tzz@lifelogs.com
use strict;

use Net::Netmask;
use Net::IP;
use Regexp::Common;
use Data::Dumper;
use AppConfig qw/:argcount/;

my $config = AppConfig->new();

$config->define(
		'DEBUG'       =>
		{ ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'D' },

		'PROCMAIL'    =>
		{ ARGCOUNT => ARGCOUNT_NONE, DEFAULT => 0, ALIAS => 'P' },

	       );


$config->args();

my $ip = shift @ARGV;

if ($config->PROCMAIL())
{
 $ip = '10.10.10.10'
  unless defined $ip;
}
elsif (not defined $ip)
{
 die "You must give an IP address or use -procmail";
};

foreach my $line (<DATA>)
{
 # we assume IPv4
 my @ips = ($line =~ m/$RE{net}{IPv4}{-keep}/g);
 my $start = $ips[0];
 # @ips contains the digits of $start in slots 1 through 4
 my $end = $ips[5];

 next unless defined $end;		  # we need valid input

 next unless $start =~ m/$RE{net}{IPv4}/; # we need a valid IP
 next unless $end =~ m/$RE{net}{IPv4}/;	  # we need a valid IP

 my @blocks = range2cidrlist($start, $end);
 foreach my $block (@blocks) 
 {
  if ($config->PROCMAIL())
  {
   my $nip = Net::IP->new($block->desc())
    or die (Net::IP::Error());
   
   my $regex = procmail_ip_regex($nip);
   print "* \$ $regex\n";
   if ($config->DEBUG())
   {
    print "match! $ip =~ $regex\n" if $ip =~ m/$regex/;
    print "Net::Netmask match ($ip)!\n" if $block->match($ip);
   }
   print "#--\n";
  }
  elsif ($block->match($ip))
  {
   printf "Matched block %s to IP %s\n", $block->desc(), $ip;
   exit 1;
  }
 }
}

exit 0;

sub procmail_ip_regex
{
 my $nip = shift @_;

 my $start = $nip->ip();
 my $end = $nip->last_ip(); 
 
 my $regex = get_ip_range_regex($start, $end);
 return "^${regex}\$";
}

sub get_ip_range_regex
{
 my $start = shift @_;
 my $end = shift @_;

 my ($start_digit, $start_rest) = split '\.', $start, 2;
 my ($end_digit, $end_rest) = split '\.', $end, 2;

 my $rest = '';
 if (defined $start_rest && length $start_rest)
 {
  $rest = '\.' . get_ip_range_regex($start_rest, $end_rest);
 }

 my $digit_regex = get_ip_digit_regex($start_digit, $end_digit);
 return $digit_regex . $rest;
}

sub get_ip_digit_regex
{
 my $d1 = shift @_;
 my $d2 = shift @_;

 print "Working on $d1 to $d2\n"
  if $config->DEBUG();
 my @range;
 foreach ($d1 .. $d2)
 {
  push @range, $_;
  push @range, "0$_"
   if $_ < 100;
  push @range, "00$_"
   if $_ < 10;
 }

 @range = sort @range;
 
 @range = simplify_numeric_alternatives_regex(@range);
 @range = grep { length $_ } @range;

 return '(' . join('|',@range) . ')';
}

sub simplify_numeric_alternatives_regex
{
 my @range = @_;
 my @n1 = grep { length == 1 } @range;
 my @n2 = grep { length == 2 } @range;
 my @n3 = grep { length == 3 } @range;

 my $n1 = simplify_n1(@n1);
 @n2 = simplify_n2(@n2);
 @n3 = simplify_n3(@n3);
 
 @range = ($n1, @n2, @n3);
 return @range;
}

sub simplify_n1
{
 my @args = @_;
 return '' unless scalar @args;
 return $args[0] if scalar @args == 1;
 my $divisor = (scalar @args == 2) ? '' : '-';
 my $out = sprintf '[%d%s%d]', $args[0], $divisor, $args[-1];
 print "n1: Transformed @args into $out\n"
  if $config->DEBUG();
 return $out;
}

sub simplify_n2
{
 my @args = @_;
 return () unless scalar @args;
 return @args if scalar @args == 1;
 my %results;
 my @results;
 my @full_tens;

 foreach my $ten (0..9)
 {
  my @group;
  foreach my $arg (@args)
  {
   die "n2: saw weird argument [$arg]" unless length $arg == 2;
   if (index($arg, $ten) == 0 )
   {
    push @group, $arg % 10;
   }
  }
  next unless scalar @group;

  # optimize treatment of [0-9]

  if (compare_list_shallow(\@group, [0..9]))
  {
   push @full_tens, $ten;
  }
  else
  {
   $results{$ten} = simplify_n1(@group);
  }
 }

 push @results, simplify_n1(@full_tens) . '[0-9]'
  if scalar @full_tens;
 
 foreach my $ten (sort keys %results)
 {
  push @results, "${ten}$results{$ten}";
 }

 print "n2: Transformed @args into @results\n"
  if $config->DEBUG();
 return @results;
}

sub simplify_n3
{
 my @args = @_;
 return () unless scalar @args;
 return @args if scalar @args == 1;
 my @results;
 my %results;
 my @full_hundreds;
 my @hundred = sprintf ('%02d', $_) foreach [0..99];
 my $hundred_regex = '[0-9][0-9]';
 foreach my $hun (0..2)
 {
  my @group;
  foreach my $arg (@args)
  {
   die "n3: saw weird argument [$arg]" unless length $arg == 3;
   if (index($arg, $hun) == 0 )
   {
    print "n3: saw hundreds $hun in $arg\n"
     if $config->DEBUG();
    push @group, sprintf('%02d', $arg % 100);
   }
  }
  next unless scalar @group;
  # optimize treatment of [0-9][0-9]

  if (compare_list_shallow(\@group, \@hundred))
  {
   push @full_hundreds, $hun;
  }
  else
  {
   my @results_simplified = simplify_n2(@group);
   $results{$hun} = \@results_simplified;
  }
 }

 push @results, simplify_n1(@full_hundreds) . $hundred_regex
  if scalar @full_hundreds;
 
 foreach my $hun (sort keys %results)
 {
  foreach my $result (sort @{$results{$hun}})
  {
   push @results, "${hun}$result";
  }
 }

 print "n3: Transformed @args into @results\n"
  if $config->DEBUG();
 return @results;
}

sub compare_list_shallow
{
 my $l1 = shift @_;
 my $l2 = shift @_;

 return undef unless (ref $l1 eq 'ARRAY' && ref $l2 eq 'ARRAY');
 
 return 0 unless scalar @$l1 == scalar @$l2;

 foreach my $i (0..scalar @$l1-1)
 {
  return 0 if $l1->[$i] ne $l2->[$i];
 }

 return 1;
}

__DATA__
10.10.10.0 - 10.10.10.1
10.10.10.1 - 10.10.10.2
10.10.10.0 - 10.10.10.255
10.10.10.10 - 10.10.10.80
10.10.10.3 - 10.10.10.8
10.10.0.0 - 10.10.5.9
