path: root/rpsl2acl/rpsl2acl

#! /usr/bin/perl
# Copyright (C) 2012 Sergey Poznyakoff <gray@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use Getopt::Long qw(:config gnu_getopt no_ignore_case);
use Socket;
use IO::Socket;
use Net::CIDR;
use Pod::Usage;
use Pod::Man;
use POSIX qw(strftime);

# Global vars
my $sys_config_file = "/etc/rpsl2acl.conf"; # Configuration file name
my $descr = "query RPSL objects and convert them to a list of networks";
my $script;        # This script name.
my %debug_level = ( 'GENERAL' => 0,
                    'WHOIS' => 0);
my @netlist;
my @oldlist;

# Options:
my $debug;         # Debug mode indicator.
my $logfile;       # Name of the logfile.
my $dry_run;       # Dry-run mode.
my $help;          # Show help and exit.
my $man;           # Show man and exit.
my $whois_server = "whois.ripe.net";
my $single_query = 0;
my @rslist;
my $outfile = "netlist";
my $aclname;       # Name of a bind-style ACL
my $comment;       # Initial comment line
my $update;
    
sub logit {
    print LOG "@_\n";
}

sub loginit {
    if ($logfile && (!-e $logfile || -w $logfile)) {
	print STDERR "$script: logging to $logfile\n";
	open(LOG, ">$logfile");
    } else {
	open(LOG, ">&STDERR");
    }
}

sub logdone {
}

sub abend($) {
    my $msg = shift;
    logit($msg);
    debug('GENERAL', 1, "ABEND");
    logdone();
    exit(2);
}

sub debug {
    my $category = shift;
    my $level = shift;
    #    print STDERR "$category: $debug_level{$category} >= $level\n";
    if ($debug_level{$category} >= $level) {
	print LOG "$script: DEBUG[$category]: @_\n";
    }
}

sub read_config_file($) {
    my $config_file = shift;
    print STDERR "reading $config_file\n" if ($debug);
    open(FILE, "<", $config_file) or die("cannot open $config_file: $!");
    while (<FILE>) {
	chomp;
	s/^\s+//;
	s/\s+$//;
	s/\s+=\s+/=/;
        s/#.*//;
	next if ($_ eq "");
	unshift(@ARGV, "--$_");
    }
}

sub networks_from_file($) {
    my ($file) = @_;
    open(FILE, "<", $file)
	or abend("Cannot open file $file for reading");
    while (<FILE>) {
	chomp;
	s/^\s+//;
	s/\s+$//;
	s/;$//;
	s/#.*//;
	next if ($_ eq "");
	@netlist = Net::CIDR::cidradd($_,@netlist);
    }
    close(FILE);
}

sub read_acl($) {
    my ($file) = @_;
    open(FILE, "<", $file) or return;
    my $line=1;
    while (<FILE>) {
	chomp;
	s/^\s+//;
	s/\s+$//;
	s/;$//;
	s/#.*//;
	next if ($_ eq "");
	next if /^acl/;
	next if /}/;
        abend("$file:$line: invalid CIDR: $_") unless (Net::CIDR::cidrvalidate($_));
	@oldlist = Net::CIDR::cidradd($_,@oldlist);
        $line++;
    }
    sort @oldlist;
    close(FILE);
}

my $whois_socket = undef;
my $whois_refcount = 0;

sub whois_connect() {
    if (!$whois_socket) {
	debug('WHOIS',4,"connecting to $whois_server");
	$whois_socket = new IO::Socket::INET(PeerAddr => $whois_server,
					     PeerPort => 43,
					     Proto => 'tcp');
	abend("cannot connect to $whois_server: $!") unless ($whois_socket);
    }
    $whois_refcount++;
    return $whois_socket;
}

sub whois_disconnect($) {
    my $sock = shift;
    if ($sock == $whois_socket) {
	return if (--$whois_refcount);
    }
    debug('WHOIS',4,"closing connection $sock");
    close($sock);
}

sub update_netlist($) {
    my $rs = shift;
    my $state = 0;
    my $sock = whois_connect();
    debug('WHOIS',1,"querying $rs");
    $sock->write("-K $rs\r\n");
    while (<$sock>) {
	chomp;
	debug('WHOIS',3,"RCVT($state): $_");

	if (/^%ERROR:/) {
	    logit($_);
	    last;
	}

	next if (/^%/);

	if ($state == 0) {
	    next if /^$/;
	    if (/^route-set:\s+$1/) {
		$state = 1;
	    } else {
		abend("unexpected reply from $whois_server: $_");
	    }
	} elsif ($state == 1) {
	    last if /^$/;
	    if (/^members:/) {
		s/^members:\s+//;
		debug('WHOIS',2,"$rs <= $_");
		@netlist = Net::CIDR::cidradd($_,@netlist);
		$state = 2;
	    }
	} else {
	    if (/^members:/) {
		s/^members:\s+//;
		debug('WHOIS',2,"$rs <= $_");
		@netlist = Net::CIDR::cidradd($_,@netlist);
	    } else {
		last;
	    }
	}
    }
    whois_disconnect($sock);
}

###########
($script = $0) =~ s/.*\///;

my $home;

eval {
    my @ar = getpwuid($<);
    $home = $ar[7];
};

if ($ENV{'RPSL2ACL_CONF'}) {
    read_config_file($ENV{'RPSL2ACL_CONF'});
} elsif (-e "$home/.rpsl2acl.conf") {
    read_config_file("$home/.rpsl2acl.conf");
} elsif (-e "$sys_config_file") {
    read_config_file("$sys_config_file");
}

GetOptions("help|h" => \$help,
	   "man" => \$man,
	   "dry-run|n" => \$dry_run,
           "debug|d:s" => sub {
	       if (!$_[1]) {
		   foreach my $key (keys %debug_level) {
		       $debug_level{$key} = 1;
		   }
	       } else {
		   foreach my $cat (split(/,/, $_[1])) {
		       my @s = split(/[:=]/, $cat, 2);
		       $s[0] =~ tr/[a-z]/[A-Z]/;
		       if (defined($debug_level{$s[0]})) {
			   $debug_level{$s[0]} =
			       ($#s == 1) ? $s[1] : 1;
		       } else {
			   abend("no such category: $s[0]");
		       }
		   }
	       }
	   },
	   "no-persistent|p" => \$single_query,
           "log-file|l=s" => \$logfile,
	   "outfile|o=s" => \$outfile,
	   "acl=s" => \$aclname,
	   "comment=s" => \$comment,
	   "add-network=s" => sub {
	       foreach my $cidr (split(/,/, $_[1])) {
		   @netlist = Net::CIDR::cidradd($cidr,@netlist);
	       }
	   },
	   "from-file|T=s" => sub {
	       networks_from_file($_[1]);
	   },
	   "objects|r=s" => sub {
	       foreach my $rs (split(/,/, $_[1])) {
		   push(@rslist,$rs);
	       }
	   },
	   "whois-server=s" => \$whois_server,
	   "update|u" => \$update
    ) or exit(3);

pod2usage(-message => "$script: $descr", -exitstatus => 0) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

loginit();
debug('GENERAL', 1, "startup");

abend("List of RPSL objects is empty") if ($#rslist == -1);

read_acl($outfile) if ($update);

unless ($single_query) {
    whois_connect();
    $whois_socket->write("-k\r\n");
}

foreach my $rs (@rslist) {
    update_netlist($rs);
}

whois_disconnect($whois_socket) unless ($single_query);

sort @netlist;

if ($update) {
    my %oldset = map { $_ => $_ } @oldlist;
    $update = 0;
    foreach my $net (@netlist) {
	if (!$oldset{$net}) {
	    $update = 1;
	    last;
	} else {
	    delete $oldset{$net};
	}
    }
    unless ($update || keys(%oldset) > 0) {
	debug('GENERAL', 1, "shutdown: list unchanged");
	logdone();
	exit(1);
    }
}

if ($dry_run) {
    print join("\n",@netlist)."\n";
} else {
    my $file;
    my $indent = "";

    debug('GENERAL',1,"writing output file $outfile");
    
    open($file, ">", $outfile) or
	abend("cannot open $outfile for writing: $!");
    if ($comment) {
	foreach my $line (split(/\n/, $comment)) {
	    print $file "# $line\n";
	}
    }
    print $file strftime "# network list created by $script on %c\n",
          localtime;
    if (defined($aclname)) {
	print $file "acl $aclname {\n";
	$indent = "\t";
    }
    foreach my $cidr (@netlist) {
	print $file "${indent}${cidr};\n"
    }
    print $file "};\n" if (defined($aclname));
    close($file);
}

debug('GENERAL', 1, "shutdown");
logdone();

###########

__END__
=head1 RPSL2ACL

rpsl2acl - create a list of CIDRs from RPSL database    

=head1 SYNOPSIS

rpsl2acl [I<options>]
    
=head1 DESCRIPTION

B<Rpsl2acl> queries a set of RPSL objects from a whois server,
extracts B<members:> records and converts them into a list of
non-overlapping CIDR values.  The resulting list is sorted
lexicographically.

The program exits with code 0 if the file is up to date, 1 if it has
successfully updated the file, 2 if some error ocurred and 3 if the
command line usage was incorrect.    
    
=head1 OPTIONS

The following options control the output:
    
=over 4

=item B<--acl>=I<name>

Format output as a B<bind> ACL statement with the given I<name>.

=item B<--comment>=I<string>

Print I<string> as the heading comment to the output.  The argument can
consist of multiple lines.  A C<#> sign will be printed before each of
them.

=item B<--outfile>=I<FILE>, B<-o> I<FILE>

Write the result to I<FILE>, instead of the default C<netlist>.

=back

The following options control the selection of RPSL objects and initial
contents of the output list:

=over 4

=item B<--add-network>=I<arg>

Add given CIDRs to the output list.  Argument is a comma-separated list
of CIDRs.

=item B<--from-file>=I<FILE>, B<-T> I<FILE>

Populate the output list with CIDRs read from I<FILE>.  The file must
list each CIDR on a separate line.  Empty lines and comments (introduced
by C<#> sign) are ignored.

=item B<--objects>=I<objlist>, B<-r> I<objlist>

Defines a list of objects to query.  I<Objlist> is a comma-separated list
of RPSL object names.

=back

The following options control TCP connections:

=over 4

=item B<--no-persistent>

Disable persistent connection.  B<Rpsl2acl> will open a new connection
to the whois server for each RPSL object it is about to query.
 
=item B<--whois-server>=I<server>

Query this server, instead of the default C<whois.ripe.net>.

=back

Options controlling log and debug output:

=over 4

=item B<--log-file>=I<FILE>, B<-l> I<FILE>

Write the diagnostic output to I<FILE>, instead of standard error.

=item B<--debug>[=I<spec>[,I<spec>...]], B<-d>[I<spec>[,I<spec>...]]

Set debugging level.  I<Spec> is either B<category> or B<category>=B<level>,
B<category> is a debugging category name and B<level> is a decimal
verbosity level.  Valid categories are: C<GENERAL> and C<WHOIS>.

=item B<--dry-run>, B<-n>

Don't create the output file.  Instead print the result on the standard
output.

=back

Informational options:

=over 4

=item B<--help>, B<-h>

Show a terse help summary and exit.

=item B<--man>

Print the manual page and exit.

=back

=head1 CONFIGURATION

The program reads its configuration from one of the following locations:

=over 4

=item B<a.> File name given by C<RPSL2ACL_CONF> environment variable (if set)

=item B<b.> B<~>/.rpsl2acl.conf

=item B<c.> /etc/rpsl2acl.conf

=back

The first existing file from this list is read.  It is an error, if the
B<$RPSL2ACL_CONF> variable is set, but points to a file that does not exist.
It is not an error if B<$RPSL2ACL_CONF> is not set and neither of the two
remaining files exist.  It is, however, an error if any of these file exists,
but is not readable.

The configuration file uses a usual UNIX configuration format.  Empty
lines and UNIX comments are ignored.  Each non-empty line is either an
option name, or option assignment, i.e. B<opt>=B<val>, with any amount of
optional whitespace around the equals sign.  Valid option names are
the same as long command line options, but without the leading B<-->.
For example:

  objects = RS-FOO,RS-BAR,RS-BAZ
  aclname = mynets
  add-network = 10.0.0.0/8
  outfile = networks.inc

=head1 ENVIRONMENT

=over 4

=item RPSL2ACL_CONF

The name of the configuration file to read, instead of the default
F</etc/rpsl2acl.conf>.

=back

=head1 SEE ALSO

B<axfr2acl>(1).

=back

=head1 AUTHOR

Sergey Poznyakoff <gray@gnu.org>

=cut