#!/usr/local/bin/perl

# Make a list of non-North American IP addresses
# Copyright Jeremy Kister 2010.10.25
# Released under Perl's Artistic License

# creates an /etc/non-na.tcprules with -t
# creates an /etc/non-na.cidr with -c

use strict;
use Getopt::Std;
use LWP::UserAgent;
use XML::Simple;
use NetAddr::IP qw/Compact/;

my %opt;
getopts('Dct:', \%opt);
# Debug
# cidr
# tcprules

unless( $opt{c} || $opt{t} ){ $opt{c} = $opt{t} = 1 };

my $xs   = XML::Simple->new;
my $ua   = LWP::UserAgent->new;
$ua->timeout(10);

my $r = $ua->get('http://www.iana.org/assignments/ipv4-address-space/ipv4-address-space.xml');

my %allow = ( map { $_ => 1 } qw/10 192 172/ );

if( $r->is_success ){
    warn "is_success\n" if $opt{D};
	my $ref = $xs->XMLin( $r->decoded_content );

	for my $href (@{ $ref->{record} }){
		# prefix, designation, date, status, xref
		next if( $href->{status} eq 'UNALLOCATED' || $href->{status} eq 'RESERVED' );
	
		my ($octet) = $href->{prefix} =~ /^0{0,2}(\d+)/;

                warn "see octet $octet\n" if $opt{D};
		next if( $octet == 43 );

		if( (($href->{status} eq 'LEGACY') && (! $href->{whois})) ||
		    ($href->{whois} eq 'whois.arin.net') ){
			$allow{$octet} = 1;
                        warn "allowing $octet\n" if $opt{D};
		}
	}

}else{
    warn "not success\n" if $opt{D};
	die $r->status_line;
}

my $expect = 0;
my @addr;
while( $expect <= 255 ){
    unless( exists($allow{$expect}) ){
        push @addr, NetAddr::IP->new("${expect}.0.0.0/8");
    }
    $expect++;
}

my @compact = Compact(@addr);
my @nprefix;
for( @compact ){
    push @nprefix, $_->nprefix;
}

if( $opt{c} ){
    open(LIST, "> /etc/non-na.cidr.tmp") || die "cannot write to /etc/non-na.cidr.tmp: $!\n";
    print LIST join("\n", @compact) . "\n";
    close LIST;
    rename("/etc/non-na.cidr.tmp","/etc/non-na.cidr") || die "cannot rename cidr: $!\n";
}

if( $opt{t} ){
    open(LIST, "> /etc/non-na.tcprules.tmp") || die "cannot write to /etc/non-na.tcprules.tmp: $!\n";
    #print LIST join("\n", map { $_->nprefix } @compact) . "\n";
    print LIST join("\n", @nprefix) . "\n";
    close LIST;
    rename("/etc/non-na.tcprules.tmp","/etc/non-na.tcprules") || die "cannot rename tcprules: $!\n";
}