1#! /usr/bin/perl
2# Copyright (C) 2012 Sergey Poznyakoff <gray@gnu.org>
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 3, or (at your option)
7# any later version.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
17use strict;
18use Getopt::Long qw(:config gnu_getopt no_ignore_case);
19use Socket;
20use IO::Socket;
21use Net::CIDR;
22use Pod::Usage;
23use Pod::Man;
24use POSIX qw(strftime);
25
26# Global vars
27my $sys_config_file = "/etc/rpsl2acl.conf"; # Configuration file name
28my $descr = "query RPSL objects and convert them to a list of networks";
29my $script;        # This script name.
30my %debug_level = ( 'GENERAL' => 0,
31                    'WHOIS' => 0);
32my @netlist;
33my @oldlist;
34
35# Options:
36my $debug;         # Debug mode indicator.
37my $logfile;       # Name of the logfile.
38my $dry_run;       # Dry-run mode.
39my $help;          # Show help and exit.
40my $man;           # Show man and exit.
41my $whois_server = "whois.ripe.net";
42my $single_query = 0;
43my @rslist;
44my $outfile = "netlist";
45my $aclname;       # Name of a bind-style ACL
46my $comment;       # Initial comment line
47my $update;
48
49sub logit {
50    print LOG "@_\n";
51}
52
53sub loginit {
54    if ($logfile and (!-e $logfile or -w $logfile)) {
55	print STDERR "$script: logging to $logfile\n";
56	open(LOG, ">$logfile");
57    } else {
58	open(LOG, ">&STDERR");
59    }
60}
61
62sub logdone {
63}
64
65sub abend($) {
66    my $msg = shift;
67    logit($msg);
68    debug('GENERAL', 1, "ABEND");
69    logdone();
70    exit(2);
71}
72
73sub debug {
74    my $category = shift;
75    my $level = shift;
76    #    print STDERR "$category: $debug_level{$category} >= $level\n";
77    if ($debug_level{$category} >= $level) {
78	print LOG "$script: DEBUG[$category]: @_\n";
79    }
80}
81
82sub read_config_file($) {
83    my $config_file = shift;
84    print STDERR "reading $config_file\n" if ($debug);
85    open(FILE, "<", $config_file) or die("cannot open $config_file: $!");
86    while (<FILE>) {
87	chomp;
88	s/^\s+//;
89	s/\s+$//;
90	s/\s+=\s+/=/;
91        s/#.*//;
92	next if ($_ eq "");
93	unshift(@ARGV, "--$_");
94    }
95}
96
97sub networks_from_file($) {
98    my ($file) = @_;
99    open(FILE, "<", $file)
100	or abend("Cannot open file $file for reading");
101    while (<FILE>) {
102	chomp;
103	s/^\s+//;
104	s/\s+$//;
105	s/;$//;
106	s/#.*//;
107	next if ($_ eq "");
108	@netlist = Net::CIDR::cidradd($_,@netlist);
109    }
110    close(FILE);
111}
112
113sub read_acl($) {
114    my ($file) = @_;
115    open(FILE, "<", $file) or return;
116    my $line=1;
117    while (<FILE>) {
118	chomp;
119	s/^\s+//;
120	s/\s+$//;
121	s/;$//;
122	s/#.*//;
123	next if ($_ eq "");
124	next if /^acl/;
125	next if /}/;
126        abend("$file:$line: invalid CIDR: $_") unless (Net::CIDR::cidrvalidate($_));
127	@oldlist = Net::CIDR::cidradd($_,@oldlist);
128        $line++;
129    }
130    sort @oldlist;
131    close(FILE);
132}
133
134my $whois_socket = undef;
135my $whois_refcount = 0;
136
137sub whois_connect() {
138    if (!$whois_socket) {
139	debug('WHOIS',4,"connecting to $whois_server");
140	$whois_socket = new IO::Socket::INET(PeerAddr => $whois_server,
141					     PeerPort => 43,
142					     Proto => 'tcp');
143	abend("cannot connect to $whois_server: $!") unless ($whois_socket);
144    }
145    $whois_refcount++;
146    return $whois_socket;
147}
148
149sub whois_disconnect($) {
150    my $sock = shift;
151    if ($sock == $whois_socket) {
152	return if (--$whois_refcount);
153    }
154    debug('WHOIS',4,"closing connection $sock");
155    close($sock);
156}
157
158sub update_netlist($) {
159    my $rs = shift;
160    my $state = 0;
161    my $sock = whois_connect();
162    debug('WHOIS',1,"querying $rs");
163    $sock->write("-K $rs\r\n");
164    while (<$sock>) {
165	chomp;
166	debug('WHOIS',3,"RCVT($state): $_");
167
168	if (/^%ERROR:/) {
169	    logit($_);
170	    last;
171	}
172
173	next if (/^%/);
174
175	if ($state == 0) {
176	    next if /^$/;
177	    if (/^route-set:\s+$1/) {
178		$state = 1;
179	    } else {
180		abend("unexpected reply from $whois_server: $_");
181	    }
182	} elsif ($state == 1) {
183	    last if /^$/;
184	    if (/^members:/) {
185		s/^members:\s+//;
186		debug('WHOIS',2,"$rs <= $_");
187		@netlist = Net::CIDR::cidradd($_,@netlist);
188		$state = 2;
189	    }
190	} else {
191	    if (/^members:/) {
192		s/^members:\s+//;
193		debug('WHOIS',2,"$rs <= $_");
194		@netlist = Net::CIDR::cidradd($_,@netlist);
195	    } else {
196		last;
197	    }
198	}
199    }
200    whois_disconnect($sock);
201}
202
203###########
204($script = $0) =~ s/.*\///;
205
206my $home;
207
208eval {
209    my @ar = getpwuid($<);
210    $home = $ar[7];
211};
212
213if ($ENV{'RPSL2ACL_CONF'}) {
214    read_config_file($ENV{'RPSL2ACL_CONF'});
215} elsif (-e "$home/.rpsl2acl.conf") {
216    read_config_file("$home/.rpsl2acl.conf");
217} elsif (-e "$sys_config_file") {
218    read_config_file("$sys_config_file");
219}
220
221GetOptions("help|h" => \$help,
222	   "man" => \$man,
223	   "dry-run|n" => \$dry_run,
224           "debug|d:s" => sub {
225	       if (!$_[1]) {
226		   foreach my $key (keys %debug_level) {
227		       $debug_level{$key} = 1;
228		   }
229	       } else {
230		   foreach my $cat (split(/,/, $_[1])) {
231		       my @s = split(/[:=]/, $cat, 2);
232		       $s[0] =~ tr/[a-z]/[A-Z]/;
233		       if (defined($debug_level{$s[0]})) {
234			   $debug_level{$s[0]} =
235			       ($#s == 1) ? $s[1] : 1;
236		       } else {
237			   abend("no such category: $s[0]");
238		       }
239		   }
240	       }
241	   },
242	   "no-persistent|p" => \$single_query,
243           "log-file|l=s" => \$logfile,
244	   "outfile|o=s" => \$outfile,
245	   "acl=s" => \$aclname,
246	   "comment=s" => \$comment,
247	   "add-network=s" => sub {
248	       foreach my $cidr (split(/,/, $_[1])) {
249		   @netlist = Net::CIDR::cidradd($cidr,@netlist);
250	       }
251	   },
252	   "from-file|T=s" => sub {
253	       networks_from_file($_[1]);
254	   },
255	   "objects|r=s" => sub {
256	       foreach my $rs (split(/,/, $_[1])) {
257		   push(@rslist,$rs);
258	       }
259	   },
260	   "whois-server=s" => \$whois_server,
261	   "update|u" => \$update
262    ) or exit(3);
263
264pod2usage(-message => "$script: $descr", -exitstatus => 0) if $help;
265pod2usage(-exitstatus => 0, -verbose => 2) if $man;
266
267loginit();
268debug('GENERAL', 1, "startup");
269
270abend("List of RPSL objects is empty") if ($#rslist == -1);
271
272read_acl($outfile) if ($update);
273
274unless ($single_query) {
275    whois_connect();
276    $whois_socket->write("-k\r\n");
277}
278
279foreach my $rs (@rslist) {
280    update_netlist($rs);
281}
282
283whois_disconnect($whois_socket) unless ($single_query);
284
285sort @netlist;
286
287if ($update) {
288    my %oldset = map { $_ => $_ } @oldlist;
289    $update = 0;
290    foreach my $net (@netlist) {
291	if (!$oldset{$net}) {
292	    $update = 1;
293	    last;
294	} else {
295	    delete $oldset{$net};
296	}
297    }
298    unless ($update or keys(%oldset) > 0) {
299	debug('GENERAL', 1, "shutdown: list unchanged");
300	logdone();
301	exit(1);
302    }
303}
304
305if ($dry_run) {
306    print join("\n",@netlist)."\n";
307} else {
308    my $file;
309    my $indent = "";
310
311    debug('GENERAL',1,"writing output file $outfile");
312
313    open($file, ">", $outfile) or
314	abend("cannot open $outfile for writing: $!");
315    if ($comment) {
316	foreach my $line (split(/\n/, $comment)) {
317	    print $file "# $line\n";
318	}
319    }
320    print $file strftime "# network list created by $script on %c\n",
321          localtime;
322    if (defined($aclname)) {
323	print $file "acl $aclname {\n";
324	$indent = "\t";
325    }
326    foreach my $cidr (@netlist) {
327	print $file "${indent}${cidr};\n"
328    }
329    print $file "};\n" if (defined($aclname));
330    close($file);
331}
332
333debug('GENERAL', 1, "shutdown");
334logdone();
335
336###########
337
338__END__
339=head1 RPSL2ACL
340
341rpsl2acl - create a list of CIDRs from RPSL database
342
343=head1 SYNOPSIS
344
345rpsl2acl [I<options>]
346
347=head1 DESCRIPTION
348
349B<Rpsl2acl> queries a set of RPSL objects from a whois server,
350extracts B<members:> records and converts them into a list of
351non-overlapping CIDR values.  The resulting list is sorted
352lexicographically.
353
354The program exits with code 0 if the file is up to date, 1 if it has
355successfully updated the file, 2 if some error ocurred and 3 if the
356command line usage was incorrect.
357
358=head1 OPTIONS
359
360The following options control the output:
361
362=over 4
363
364=item B<--acl>=I<name>
365
366Format output as a B<bind> ACL statement with the given I<name>.
367
368=item B<--comment>=I<string>
369
370Print I<string> as the heading comment to the output.  The argument can
371consist of multiple lines.  A C<#> sign will be printed before each of
372them.
373
374=item B<--outfile>=I<FILE>, B<-o> I<FILE>
375
376Write the result to I<FILE>, instead of the default C<netlist>.
377
378=back
379
380The following options control the selection of RPSL objects and initial
381contents of the output list:
382
383=over 4
384
385=item B<--add-network>=I<arg>
386
387Add given CIDRs to the output list.  Argument is a comma-separated list
388of CIDRs.
389
390=item B<--from-file>=I<FILE>, B<-T> I<FILE>
391
392Populate the output list with CIDRs read from I<FILE>.  The file must
393list each CIDR on a separate line.  Empty lines and comments (introduced
394by C<#> sign) are ignored.
395
396=item B<--objects>=I<objlist>, B<-r> I<objlist>
397
398Defines a list of objects to query.  I<Objlist> is a comma-separated list
399of RPSL object names.
400
401=back
402
403The following options control TCP connections:
404
405=over 4
406
407=item B<--no-persistent>
408
409Disable persistent connection.  B<Rpsl2acl> will open a new connection
410to the whois server for each RPSL object it is about to query.
411
412=item B<--whois-server>=I<server>
413
414Query this server, instead of the default C<whois.ripe.net>.
415
416=back
417
418Options controlling log and debug output:
419
420=over 4
421
422=item B<--log-file>=I<FILE>, B<-l> I<FILE>
423
424Write the diagnostic output to I<FILE>, instead of standard error.
425
426=item B<--debug>[=I<spec>[,I<spec>...]], B<-d>[I<spec>[,I<spec>...]]
427
428Set debugging level.  I<Spec> is either B<category> or B<category>=B<level>,
429B<category> is a debugging category name and B<level> is a decimal
430verbosity level.  Valid categories are: C<GENERAL> and C<WHOIS>.
431
432=item B<--dry-run>, B<-n>
433
434Don't create the output file.  Instead print the result on the standard
435output.
436
437=back
438
439Informational options:
440
441=over 4
442
443=item B<--help>, B<-h>
444
445Show a terse help summary and exit.
446
447=item B<--man>
448
449Print the manual page and exit.
450
451=back
452
453=head1 CONFIGURATION
454
455The program reads its configuration from one of the following locations:
456
457=over 4
458
459=item B<a.> File name given by C<RPSL2ACL_CONF> environment variable (if set)
460
461=item B<b.> B<~>/.rpsl2acl.conf
462
463=item B<c.> /etc/rpsl2acl.conf
464
465=back
466
467The first existing file from this list is read.  It is an error, if the
468B<$RPSL2ACL_CONF> variable is set, but points to a file that does not exist.
469It is not an error if B<$RPSL2ACL_CONF> is not set and neither of the two
470remaining files exist.  It is, however, an error if any of these file exists,
471but is not readable.
472
473The configuration file uses a usual UNIX configuration format.  Empty
474lines and UNIX comments are ignored.  Each non-empty line is either an
475option name, or option assignment, i.e. B<opt>=B<val>, with any amount of
476optional whitespace around the equals sign.  Valid option names are
477the same as long command line options, but without the leading B<-->.
478For example:
479
480  objects = RS-FOO,RS-BAR,RS-BAZ
481  aclname = mynets
482  add-network = 10.0.0.0/8
483  outfile = networks.inc
484
485=head1 ENVIRONMENT
486
487=over 4
488
489=item RPSL2ACL_CONF
490
491The name of the configuration file to read, instead of the default
492F</etc/rpsl2acl.conf>.
493
494=back
495
496=head1 SEE ALSO
497
498B<axfr2acl>(1).
499
500=back
501
502=head1 AUTHOR
503
504Sergey Poznyakoff <gray@gnu.org>
505
506=cut
507
508