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 Digest::MD5;
21use Net::DNS;
22use Net::CIDR;
23use Pod::Usage;
24use Pod::Man;
25use POSIX qw(strftime);
26
27# Global vars
28my $sys_config_file = "/etc/axfr2acl.conf"; # Configuration file name
29my $descr = "create a BIND-style ACL containing all A records from a zone";
30my $script;        # This script name.
31my %debug_level = ( 'GENERAL' => 0, 'DNS' => 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 @zones;
42my $outfile = "netlist";
43my $aclname;       # Name of a bind-style ACL
44my $comment;       # Initial comment line
45my $update;
46my %oldserial;     # Old serial numbers
47my %serial;        # Zone serial numbers
48
49# "Initial" are networks supplied by "--add-network" and "--from-file" options.
50my $initnetctx;    # MD5 context for tracking changes in initial networks
51my $oldsig;        # Old MD5 signature of the initial networks
52my $netsig;        # Current MD5 signature of the initial networks
53
54# Return codes:
55#  0 - OK, nothing changed
56#  1 - OK, list updated
57#  2 - General error
58#  3 - Usage error
59
60#############
61
62sub logit {
63    print LOG "@_\n";
64}
65
66sub loginit {
67    if ($logfile and (!-e $logfile or -w $logfile)) {
68	print STDERR "$script: logging to $logfile\n";
69	open(LOG, ">$logfile");
70    } else {
71	open(LOG, ">&STDERR");
72    }
73}
74
75sub logdone {
76}
77
78sub abend($) {
79    my $msg = shift;
80    logit($msg);
81    debug('GENERAL', 1, "ABEND");
82    logdone();
83    exit(2);
84}
85
86sub debug {
87    my $category = shift;
88    my $level = shift;
89    #    print STDERR "$category: $debug_level{$category} >= $level\n";
90    if ($debug_level{$category} >= $level) {
91	print LOG "$script: DEBUG[$category]: @_\n";
92    }
93}
94
95sub read_config_file($) {
96    my $config_file = shift;
97    print STDERR "reading $config_file\n" if ($debug);
98    open(FILE, "<", $config_file) or die("cannot open $config_file: $!");
99    while (<FILE>) {
100	chomp;
101	s/^\s+//;
102	s/\s+$//;
103	s/\s+=\s+/=/;
104        s/#.*//;
105	next if ($_ eq "");
106	unshift(@ARGV, "--$_");
107    }
108}
109
110sub note_init_network($) {
111    my $cidr = shift;
112    $initnetctx->add($cidr);
113}
114
115sub networks_from_file($) {
116    my ($file) = @_;
117    open(FILE, "<", $file)
118	or abend("Cannot open file $file for reading");
119    while (<FILE>) {
120	chomp;
121	s/^\s+//;
122	s/\s+$//;
123	s/;$//;
124	s/#.*//;
125	next if ($_ eq "");
126	note_init_network($_);
127	@netlist = Net::CIDR::cidradd($_,@netlist);
128    }
129    close(FILE);
130}
131
132sub read_acl($) {
133    my ($file) = @_;
134    open(FILE, "<", $file) or return;
135    my $line=1;
136    my $zone;
137    my $sn;
138    while (<FILE>) {
139	chomp;
140	s/^\s+//;
141	s/\s+$//;
142	s/;$//;
143	if (($zone, $sn) = ($_ =~ /^#serial\s+(\S+)\s+([0-9]+)/)) {
144	    $oldserial{$zone} = $sn;
145	    next;
146        }
147	if (($sn) = ($_ =~ /^#netsig\s+(\S+)/)) {
148            $oldsig = $sn;
149	}
150	s/#.*//;
151	next if ($_ eq "");
152	next if /^acl/;
153	next if /}/;
154        abend("$file:$line: invalid CIDR: $_") unless (Net::CIDR::cidrvalidate($_));
155	@oldlist = Net::CIDR::cidradd($_,@oldlist);
156        $line++;
157    }
158    @oldlist = sort @oldlist;
159    close(FILE);
160}
161
162###########
163($script = $0) =~ s/.*\///;
164
165my $home;
166
167eval {
168    my @ar = getpwuid($<);
169    $home = $ar[7];
170};
171
172if ($ENV{'AXFR2ACL_CONF'}) {
173    read_config_file($ENV{'AXFR2ACL_CONF'});
174} elsif (-e "$home/.axfr2acl.conf") {
175    read_config_file("$home/.axfr2acl.conf");
176} elsif (-e "$sys_config_file") {
177    read_config_file("$sys_config_file");
178}
179
180$initnetctx = Digest::MD5->new;
181
182GetOptions("help|h" => \$help,
183	   "man" => \$man,
184	   "dry-run|n" => \$dry_run,
185           "debug|d:s" => sub {
186	       if (!$_[1]) {
187		   foreach my $key (keys %debug_level) {
188		       $debug_level{$key} = 1;
189		   }
190	       } elsif ($_[1] =~ /^[0-9]+/) {
191		   foreach my $key (keys %debug_level) {
192		       $debug_level{$key} = $_[1];
193		   }
194	       } else {
195		   foreach my $cat (split(/,/, $_[1])) {
196		       my @s = split(/[:=]/, $cat, 2);
197		       $s[0] =~ tr/[a-z]/[A-Z]/;
198		       if (defined($debug_level{$s[0]})) {
199			   $debug_level{$s[0]} =
200			       ($#s == 1) ? $s[1] : 1;
201		       } else {
202			   abend("no such category: $s[0]");
203		       }
204		   }
205	       }
206	   },
207           "log-file|l=s" => \$logfile,
208	   "outfile|o=s" => \$outfile,
209	   "acl=s" => \$aclname,
210	   "comment=s" => \$comment,
211	   "add-network=s" => sub {
212	       foreach my $cidr (split(/,/, $_[1])) {
213		   note_init_network($cidr);
214		   @netlist = Net::CIDR::cidradd($cidr,@netlist);
215	       }
216	   },
217	   "from-file|T=s" => sub {
218	       networks_from_file($_[1]);
219	   },
220	   "zones|z=s" => sub {
221	       foreach my $rs (split(/,/, $_[1])) {
222		   push(@zones,$rs);
223	       }
224	   },
225	   "update|u" => \$update
226    ) or exit(3);
227
228pod2usage(-message => "$script: $descr", -exitstatus => 0) if $help;
229pod2usage(-exitstatus => 0, -verbose => 2) if $man;
230
231loginit();
232debug('GENERAL', 1, "startup");
233
234abend("No zones given") if ($#zones == -1);
235
236$netsig = $initnetctx->b64digest;
237read_acl($outfile) if ($update);
238
239# Determine initial update status:
240# The output needs to be updated if either the --update flag is *not*
241# given (i.e. the user wants unconditional update), or if the MD5 signatures
242# of added network differ.
243#
244# The initial update status will be corrected in the loop below, based on the
245# SOA of the networks involved.
246#
247my $need_update = !$update;
248if (!$need_update) {
249    $need_update = $netsig ne $oldsig;
250    debug('GENERAL', 1,
251	  "update forced because initial networks changed") if ($need_update);
252}
253
254# Create resolvers and collect serial numbers
255my %resolver;
256
257foreach my $zone (@zones) {
258    my $res  = Net::DNS::Resolver->new;
259    debug('DNS', 1, "querying SOA for $zone");
260    my $query = $res->query($zone, "SOA");
261    unless ($query) {
262	print STDERR "$script: cannot get SOA of $zone: " . $res->errorstring . "\n";
263	next;
264    }
265    $resolver{$zone} = $res;
266    my $rr = (grep { $_->type eq 'SOA' } $query->answer)[0];
267    debug('DNS', 2, "zone $zone serial ".$rr->serial);
268    $need_update = 1
269	if ($update && (!defined($oldserial{$zone}) ||
270			$oldserial{$zone} < $rr->serial));
271    delete $oldserial{$zone};
272    $serial{$zone} = $rr->serial;
273}
274
275if ($update and keys(%oldserial)) {
276    debug('GENERAL', 1, "some zones removed: forcing update");
277    $need_update = 1;
278}
279
280if ($need_update) {
281    foreach my $zone (@zones) {
282	my $res;
283	my $rr;
284
285	$res = $resolver{$zone};
286	next unless ($res);
287
288	debug('DNS', 1, "querying NSs for $zone");
289	my $query = $res->query($zone, "NS");
290	unless ($query) {
291	    print STDERR "$script: cannot get NS records for $zone: " .
292		          $res->errorstring . "\n";
293	    next;
294	}
295
296	foreach $rr (grep { $_->type eq 'NS' } $query->answer) {
297	    $res->nameservers($rr->nsdname);
298	    debug('DNS', 2, "$zone NS ". $rr->nsdname);
299	}
300
301	debug('DNS', 1, "Transferring $zone");
302	my @records = grep { $_->type eq 'A' } $res->axfr($zone);
303	debug('DNS', 1, "Got $#records records");
304
305	foreach my $rr (@records) {
306	    @netlist = Net::CIDR::cidradd($rr->address,@netlist);
307	}
308    }
309}
310
311if (!$need_update) {
312    debug('GENERAL', 1, "shutdown: list unchanged");
313    logdone();
314    exit(1);
315}
316
317if ($update) {
318    my %oldset = map { $_ => $_ } @oldlist;
319    $update = 0;
320    foreach my $net (sort @netlist) {
321	if (!$oldset{$net}) {
322	    $update = 1;
323	    last;
324	} else {
325	    delete $oldset{$net};
326	}
327    }
328    unless ($update or keys(%oldset) > 0) {
329	if ($need_update && !$dry_run) {
330	    debug('GENERAL', 1, "list unchanged; proceeding to save serials");
331	} else {
332	    debug('GENERAL', 1, "shutdown: list unchanged");
333	    logdone();
334	    exit(1);
335	}
336    }
337}
338
339if ($dry_run) {
340    print join("\n",@netlist)."\n";
341} else {
342    my $file;
343    my $indent = "";
344
345    debug('GENERAL',1,"writing output file $outfile");
346
347    open($file, ">", $outfile) or
348	abend("cannot open $outfile for writing: $!");
349    if ($comment) {
350	foreach my $line (split(/\n/, $comment)) {
351	    print $file "# $line\n";
352	}
353    }
354    print $file strftime "# network list created by $script on %c\n",
355          localtime;
356    foreach my $zone (keys %serial) {
357	print $file "#serial $zone $serial{$zone}\n";
358    }
359    print $file "#netsig $netsig\n" if ($netsig);
360
361    if (defined($aclname)) {
362	print $file "acl $aclname {\n";
363	$indent = "\t";
364    }
365    foreach my $cidr (@netlist) {
366	print $file "${indent}${cidr};\n";
367    }
368    print $file "};\n" if (defined($aclname));
369    close($file);
370}
371
372debug('GENERAL', 1, "shutdown");
373logdone();
374
375###########
376
377__END__
378=head1 NAME
379
380axfr2acl - create a BIND ACL containing "A" records from a set of zones
381
382=head1 SYNOPSIS
383
384axfr2acl [I<options>]
385
386=head1 DESCRIPTION
387
388B<Axfr2acl> collects all B<A> records from a set of supplied DNS zones
389and writes out a DNS ACL containing all of them.  If possible, the
390addresses are compressed into CIDRs.  The resulting list is sorted
391lexicographically.
392
393The resulting ACL is normally written to a file, either as a list of CIDRs
394or as a BIND B<acl> statement, if the ACL name is given.  In both cases, the
395file is sutable for inclusion in the BIND configuration file.  If the file
396already exists when the command is invoked, its contents is recorded and
397is used subsequently to determine whether it has changed.  The utility will
398actually modify the output file only if the constructed list differs from
399the one it contained initially.  It will also avoid running zone transfers
400if the serial records of all involved zones did not change since the last
401run.
402
403The program exits with code 0 if the file is up to date, 1 if it has
404successfully updated the file, 2 if some error ocurred and 3 if the
405command line usage was incorrect.
406
407=head1 OPTIONS
408
409The following option control the output:
410
411=over 4
412
413=item B<--acl>=I<name>
414
415Format output as a B<bind> ACL statement with the given I<name>.
416
417=item B<--comment>=I<string>
418
419Print I<string> as the heading comment to the output.  The argument can
420consist of multiple lines.  A C<#> sign will be printed before each of
421them.
422
423=item B<--outfile>=I<FILE>, B<-o> I<FILE>
424
425Write the result to I<FILE>, instead of the default C<netlist>.
426
427=back
428
429The following options control the selection of DNS zones and initial
430contents of the output list:
431
432=over 4
433
434=item B<--add-network>=I<arg>
435
436Add given CIDRs to the output list.  Argument is a comma-separated list
437of CIDRs.
438
439=item B<--from-file>=I<FILE>, B<-T> I<FILE>
440
441Populate the output list with CIDRs read from I<FILE>.  The file must
442list each CIDR on a separate line.  Empty lines and comments (introduced
443by C<#> sign) are ignored.
444
445=item B<--zones>=I<zonelist>, B<-z> I<zonelist>
446
447Defines a list of zones to query.  I<Zonelist> is a comma-separated list
448of zone names.
449
450=back
451
452Options controlling log and debug output:
453
454=over 4
455
456=item B<--log-file>=I<FILE>, B<-l> I<FILE>
457
458Write diagnostic output to I<FILE>, instead of standard error.
459
460=item B<--debug>[=I<spec>[,I<spec>...]], B<-d>[I<spec>[,I<spec>...]]
461
462Set debugging level.  I<Spec> is either B<category> or B<category>=B<level>,
463B<category> is a debugging category name and B<level> is a decimal
464verbosity level.  Valid categories are: C<GENERAL> and C<DNS>.
465
466=item B<--dry-run>, B<-n>
467
468Don't create output file.  Instead print the result on the standard
469output.
470
471=back
472
473Informational options:
474
475=over 4
476
477=item B<--help>, B<-h>
478
479Shows a terse help summary and exit.
480
481=item B<--man>
482
483Prints the manual page and exits.
484
485=back
486
487=head1 CONFIGURATION
488
489The program reads its configuration from one of the following locations:
490
491=over 4
492
493=item B<a.> The file name given by C<AXFR2ACL_CONF> environment variable (if set)
494
495=item B<b.> B<~>/.axfr2acl.conf
496
497=item B<c.> /etc/axfr2acl.conf
498
499=back
500
501The first existing file from this list is used.  It is an error, if the
502B<$AXFR2ACL_CONF> variable is set, but points to a file that does not exist.
503It is not an error, if B<$AXFR2ACL_CONF> is not set and neither of the two
504remaining files exist.  It is, however, an error if any of these file exists,
505but is not readable.
506
507The configuration file uses a usual UNIX configuration format.  Empty
508lines and UNIX comments are ignored.  Each non-empty line is either an
509option name, or option assignment, i.e. B<opt>=B<val>, with any amount of
510optional whitespace around the equals sign.  Valid option names are
511the same as the long command line options, but without the leading B<-->.
512For example:
513
514  zones = example.net,example.com
515  acl = mynets
516  add-network = 10.0.0.0/8
517  outfile = networks.inc
518
519=head1 ENVIRONMENT
520
521=over 4
522
523=item AXFR2ACL_CONF
524
525The name of the configuration file to read, instead of the default
526F</etc/axfr2acl.conf>.
527
528=back
529
530=head1 SEE ALSO
531
532B<rpsl2acl>(1).
533
534=head1 AUTHOR
535
536Sergey Poznyakoff <gray@gnu.org>
537
538=cut
539
540