rpki-home/rpki-home.pl

#!/usr/bin/perl


use strict;
use JSON;
use Socket qw(AF_INET AF_INET6 inet_pton inet_ntop);
use Data::Dumper;
use File::Basename;
use File::stat;
use warnings;

$|=1;

my $conf = load_conf(dirname($0) . '/config.json') || die "Failed to load configuration";
$conf->{basedir} = dirname($0);

my ($cmd) = @ARGV;

if ( !defined $cmd ) {
	usage();
}
elsif ( $cmd eq 'all' ) {
	foreach my $mode ( split(/ /,"rpki routes genbl apply" ) ) {
		system("$0 $mode");
	}
}
elsif ( $cmd eq 'rpki' ) {
	getfile("ripe_export");
}
elsif ( $cmd eq 'routes' ) {
	getfile("ripe_ris_dump_v4");
	getfile("ripe_ris_dump_v6");
}
elsif ( $cmd eq 'genbl' ) {
	print "Loading ROAs...";
	my $data = loadfile("ripe_export");
	my $valid = { };
	foreach my $roa ( @{$data->{roas}} ) {
		$roa->{asn} =~ s/^AS//;
		$roa->{asn} += 0;

		my ($ip,$minlen) = split(/\//, $roa->{prefix});

		$valid->{$roa->{prefix}}{$roa->{asn}} = exists $roa->{maxLength} ? $roa->{maxLength} : $minlen;
	}

	print "\n";
	#print Dumper($valid);

	my $route = { };

	print "Loading routing dump IPv4...\r";

	$data = loadfile("ripe_ris_dump_v4");
	my ($ris_peers,$routes) = ris_peers($data);
	my $cnt=0;

	open(DEBUG,">$conf->{blacklist}{debug}");
	print DEBUG sprintf("%s\t%s\t%s\t%s\t%s\t%s\n",
		"prefix", "origin ASN", "roa state", "RIS relevance", "ROA", "error" );

	open(BL,">$conf->{blacklist}{cache4}");

	foreach my $l ( split(/\n/, $data) ) {
		if ( $l =~ /^(\d+)\t+(\d+\.\d+\.\d+\.\d+\/\d+)\t+(\d+)/ ) {
			my $asn    = $1;
			my $prefix = $2;
			my $peers  = $3;
			my $ret = check_route($valid, $asn, $prefix, $peers/$ris_peers);
			print DEBUG sprintf("%s\t%s\t%s\t%s\t%s\t%s\n",
				$ret->{prefix},
				$ret->{asn},
				$ret->{state},
				$ret->{relevance},
				exists $ret->{roa} ? ( defined $ret->{roa} ? $ret->{roa} : "n/a" ) : 'error',
				exists $ret->{error} ? $ret->{error} : '-' );

			if ( exists $conf->{blacklist}{filter}{$ret->{state}} && $ret->{relevance} > $conf->{blacklist}{filter}{$ret->{state}} ) {
				print BL sprintf("%s #\t%s\t%s\t%s\t%s\t%s\n",
					$ret->{prefix},
					$ret->{asn},
					$ret->{state},
					$ret->{relevance},
					exists $ret->{roa} ? ( defined $ret->{roa} ? $ret->{roa} : "n/a" ) : 'error',
					exists $ret->{error} ? $ret->{error} : '-' );
			}

			if ( ! ( $cnt % 1000 ) ) {
				printf("Loading routing dump IPv4... %0.2f%%\r", $cnt/$routes*100);
			}
			$cnt++;
		}
	}

	close(BL);
	close(DEBUG);

	print "Loading routing dump IPv4... 100%   \n";

	print "Loading routing dump IPv6...\r";
	$data = loadfile("ripe_ris_dump_v6");
	($ris_peers,$routes) = ris_peers($data);
	$cnt=0;

	open(DEBUG,">>$conf->{blacklist}{debug}");
	open(BL,">$conf->{blacklist}{cache6}");

	foreach my $l ( split(/\n/, $data) ) {
		if ( $l =~ /^(\d+)\t+([0-9a-f:]+\/\d+)\t+(\d+)/ ) {
			my $asn    = $1;
			my $prefix = $2;
			my $peers  = $3;
			my $ret = check_route($valid, $asn, $prefix, $peers/$ris_peers);
			print DEBUG sprintf("%s\t%s\t%s\t%s\t%s\t%s\n",
				$ret->{prefix},
				$ret->{asn},
				$ret->{state},
				$ret->{relevance},
				exists $ret->{roa} ? ( defined $ret->{roa} ? $ret->{roa} : "n/a" ) : 'error',
				exists $ret->{error} ? $ret->{error} : '-' );

			if ( exists $conf->{blacklist}{filter}{$ret->{state}} && $ret->{relevance} > $conf->{blacklist}{filter}{$ret->{state}} ) {
				print BL sprintf("%s #\t%s\t%s\t%s\t%s\t%s\n",
					$ret->{prefix},
					$ret->{asn},
					$ret->{state},
					$ret->{relevance},
					exists $ret->{roa} ? ( defined $ret->{roa} ? $ret->{roa} : "n/a" ) : 'error',
					exists $ret->{error} ? $ret->{error} : '-' );
			}

			if ( ! ( $cnt % 1000 ) ) {
				printf("Loading routing dump IPv6... %0.2f%%\r", $cnt/$routes*100);
			}
			$cnt++;
		}
	}

	close(BL);
	close(DEBUG);

	$data = undef;
	print "Loading routing dump IPv6... 100%   \n";
}
elsif ( $cmd eq 'apply' ) {
	mycmd("ipset destroy rpki4-tmp -exist");
	mycmd("ipset create rpki4-tmp hash:net family inet hashsize 32768 maxelem 131072");
	mycmd("ipset create rpki4 -exist hash:net family inet hashsize 32768 maxelem 131072");
	mycmd("ipset destroy rpki6-tmp -exist");
	mycmd("ipset create rpki6-tmp hash:net family inet6 hashsize 32768 maxelem 131072");
	mycmd("ipset create rpki6 -exist hash:net family inet6 hashsize 32768 maxelem 131072");

	open(IPS,"| ipset restore");
	open(BL,"$conf->{blacklist}{cache4}");
	while(<BL>) {
		chomp;
		s/ .*//;
		print IPS "add rpki4-tmp $_\n";
	}
	close(BL);
	open(BL,"$conf->{blacklist}{cache6}");
	while(<BL>) {
		chomp;
		s/ .*//;
		print IPS "add rpki6-tmp $_\n";
	}
	close(BL);
	close(IPS);

	mycmd("ipset swap rpki4 rpki4-tmp");
	mycmd("ipset swap rpki6 rpki6-tmp");
	mycmd("ipset destroy rpki4-tmp -exist");
	mycmd("ipset destroy rpki6-tmp -exist");
}

sub ris_peers {
	my ($data) = @_;
	my $max = 1;
	my $cnt = 0;
	foreach my $l ( split(/\n/, $data) ) {
		if ( $l =~ /^\d+\t+[^\t]+\t+(\d+)/ ) {
			my $peers = $1;
			$max = $peers if $peers > $max;
			$cnt++;
		}
	}
	return ($max,$cnt);
}

sub hexdump {
	my($i)=@_;
	print unpack("H*",$i);
	print "\n";
}

sub check_route {
	my($valid, $asn, $prefix, $peers) = @_;

	my($ip,$maxlen) = split(/\//,$prefix);

	my $msg;
	my $state = "notfound";

	for(my $len = $maxlen; $len>= 0; $len--) {
		my $net = prefixmask($ip, $len);

		my $print = "$prefix:AS$asn (RIS: $peers) matching to $net:";

		# found matching network
		if ( exists $valid->{$net} ) {
			# found matching asn
			if ( exists $valid->{$net}{$asn} ) {
				# found matching netmask
				if ( $len <= $valid->{$net}{$asn} ) {
					#print "$print match $prefix => $valid->{$net}{$asn}\n";
					$msg = "$net-$valid->{$net}{$asn}:$asn";
					$state="found";
					last;
				}
				else {
					#print "$print invalid subnet (too small)\n";
					$msg = "$net-$valid->{$net}{$asn}:$asn";
					$state="toosmall";
					last;
				}
			}
			else {
				my @asn;
				foreach my $test ( keys %{$valid->{$net}} ) {
					push @asn, $test if $valid->{$net}{$test} >= $len;
				}
				#print "$print asn not found (should be " . join(',',@asn) . ")\n";
				$msg = "(should be " . join(',',@asn) . ")";
				$state="aswrong";
			}
		}
	}

	my $ret = {
		prefix => $prefix,
		asn => $asn,
		relevance => sprintf("%0.3f",$peers),
		state => $state,
	};

	if ( $state eq "found" ) {
		$ret->{roa} = $msg;
	}
	elsif ( $state eq "aswrong" ) {
		$ret->{error} = $msg;
	}
	elsif ( $state eq "toosmall" ) {
		$ret->{error} = "invalid length for ROA $msg";
	}
	elsif ( $state eq "notfound" ) {
		$ret->{roa} = undef;
	}
	return $ret;
}

sub prefixmask {
	my($prefix, $len) = @_;

	$prefix =~ s/\/\d+//;

	if ( $prefix =~ /:/ ) {
		my @int = unpack("NNNN",inet_pton(AF_INET6, $prefix));
		my @size;
		if  ( $len > 96 ) {
			@size = ( 32, 32, 32, $len - 96 );
		}
		elsif ( $len > 64 ) {
			@size = ( 32, 32, $len - 64, 0 );
		}
		elsif ( $len > 32 ) {
			@size = ( 32, $len - 32, 0, 0 );
		}
		else {
			@size = ( $len, 0, 0, 0 );
		}

		for(my $i=0; $i<4; $i++) {
			$int[$i] -= $int[$i] % 2**(32-$size[$i]);
		}

		return sprintf("%s/%s", inet_ntop(AF_INET6, pack("NNNN", @int)), $len);

	}
	else {
		my $int = unpack("N",inet_pton(AF_INET, $prefix));
		my $size = 2**(32-$len);
		$int -= $int % $size;
		return sprintf("%s/%s", inet_ntop(AF_INET, pack("N", $int)), $len);
	}
}

sub loadfile {
	my($name) = @_;
	my $file = "$conf->{basedir}/$conf->{$name}{cache}";

	if ( !-r $file ) {
		print STDERR "ERROR: File $file not found\n";
		exit 1;
	}

	if ( $file =~ /\.gz$/ ) {
		open(F,"gzip -cd $file |");
	}
	else {
		open(F,$file);
	}

	my $d = '';
	while(<F>) { $d .= $_; }
	close(F);

	return from_json($d) if $file =~ /\.json/;
	return $d;
}

sub getfile {
	my($name) = @_;
	my $file = "$conf->{basedir}/$conf->{$name}{cache}";

	print "$conf->{$name}{descr}\n";

	my $dl=0;

	if ( -r $file ) {
		print "  - file found\n";
		if ( filetime($file) > $conf->{$name}{expires} ) {
			print "  - file expired\n";
			$dl=1;
		}
		else {
			print "  - file still valid\n";
		}
	}
	else {
		print "  - file not found\n";
		$dl=1;
	}

	if ( $dl ) {
		print "  - downloading $conf->{$name}{url}\n";
		system("wget --header=\"accept: application/json\" -q -T 10 -O $file \"$conf->{$name}{url}\"");
	}

}

sub mycmd {
	my($cmd) = @_;

	print "CMD: $cmd\n";
	system($cmd);
}

sub filetime {
	my($f) = @_;
	my $st = stat($f);
	return time() - $st->mtime; # mtime
}

sub usage {
	print "Usage: $0 <rpki|routes|genbl|apply|all>\n";
	exit 1;
}

sub load_conf {
	my($file) = @_;

	my $f = '';

	open(F,$file);
	while(<F>) { $f.=$_; }
	close(F);

	return from_json($f);
}