#!/usr/bin/perl
# $Header: /home/dns/RCS/dnsrefresh,v 1.2 2003/09/10 20:46:09 dns Exp $
# -*- perl -*-
# John Levine, johnl@iecc.com, 9/03.
# Distributed free of charge with no warranty or support.  If you find
# bugs, feel free to fix them and send me a note telling what you fixed.

=head1 NAME

  dnsrefresh --- implement BIND-like logic for secondary nameservers

=head1 SYNOPSIS

  dnsrefresh [-jN] [-d] [-pHOST] zonedir zonelist

=head1 DESCRIPTION

dnsrefresh implements similar logic to BIND, for automatically
refreshing secondary nameservers via AXFR from their primaries.

	-jN	run N axfr jobs at once, default 5
	-d	produce debug info
	-pHOST	default primary host

zonedir is where the retrieved zone data files will be saved. The
files will be in tinydns-data format, named <zonename>.db.

zonelist is a file containing a list of zone names one per line,
optionally followed by a space and the name of the primary for that
zone. This file can contain comments, which are lines that must have
"#" in the first column; and it may contain blank lines.

Timestamps reflecting when zones were last fetched are kept in a
separate directory, with name hardwired to "last/"; the timestamps
on the files in zonedir are only updated when the files are actually
fetched, so a Makefile can intelligently decide whether it is
necessary to rebuild data.cdb, by concatenating the files in zonedir
to create the file data, then running tinydns-data.

=cut

use Getopt::Std;
use Net::DNS;
use vars qw($opt_d $opt_j $opt_p);

getopts('dj:p:');

$myip = "0.0.0.0";		# host to use for AXFR

$opt_j ||= 5;			# parallel transfers

sub dorefresh( $$ );		# zone, primary
sub downto( $ );		# number of jobs
sub touchit( $ );		# touch zone file

%jobs = ();
$njobs = 0;

# refresh zones that are due

$zonedir = shift || die "Need directory with zone files";

$now = time;

$gotone = 0;

$res = new Net::DNS::Resolver;

while($zone = <>) {
    my $pri;

    chomp($zone);

    next if $zone =~ /^#|^$/;

    if($zone =~ /(\S+) \s+ (\S+)/x) {
	$zone = $1;
	$pri = $2;
    } else {
	$pri = $opt_p || die "No primary for $zone";
    }

    print "-- $zone\n" if $opt_d;

    my $lasttime = 0;
    my ($serial, $refresh);

    if(-r "last/$zone") {
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks);

	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	 $atime,$mtime,$ctime,$blksize,$blocks) = stat(_);
	$lasttime = $mtime;

	$age = $now - $lasttime;
	print "  last $lasttime, age $age," if $opt_d;

	if(open(ZONE, "$zonedir/$zone.db")) {
	    print "  read $zone.db " if $opt_d;
	    while(<ZONE>) {
		if(/^Z(.*)/) {
		    my @zlist = split /:/,$1;

		    $serial = $zlist[3];
		    $refresh = $zlist[4];
		    last;
		}
	    }
	    close ZONE;
	}
	if($size > 0) {		# override refresh time in the file
	    open(REF, "last/$zone") or die "cannot open $zone";
	    $refresh = <REF>;
	    close REF;
	    chomp $refresh;
	    if($refresh =~ /(\d+)h/i) {
		$refresh = 3600 * $1;
	    } elsif($refresh =~ /(\d+)m/i) {
		$refresh = 60 * $1;
	    }
	    print " file ref $refresh, " if $opt_d;
	}
    }
    print "  serial $serial, refresh $refresh," if $opt_d;

    if($refresh and $age < $refresh) {
	print "  not stale, skipped\n" if $opt_d;
    } else {
	print "  check serial at $pri ... " if $opt_d;
	$res->nameservers($pri);
	my $ans = $res->query($zone, "SOA");
	if($ans) {
	    @a = $ans->answer;
	    $rr = $a[0];

	    die "bad SOA result $zone " . $rr->string
		unless $rr->type eq "SOA";
	    $newserial = $rr->serial;
	    print "new serial $newserial " if $opt_d;
	    if($serial == $newserial) {
		print " unchanged\n" if $opt_d;
		touchit($zone);
	    } else {
		print "  needs update\n" if $opt_d;
		downto($opt_j);
		dorefresh($zone, $pri);
		$gotone = 1;
	    }
	} else {
	    print "  no answer, ignore\n" if $opt_d;
	}
    } # not stale
} # zone loop

if($gotone) {
    downto(0);
} else {
    print "All zones up to date\n";
}

sub touchit($) {
    my ($zone) = @_;
    my $f = "last/$zone";

    unless ( -r $f ) {
	open(T, ">>$f") or die "cannot create $f";
	close T;
    }
    utime $now,$now,$f;
}

################################################################
sub dorefresh($$) {
    my ($zone, $pri) = @_;

    my $pid = fork();

    die "Cannot fork" unless defined($pid);

    if($pid == 0) {
	# go get the zone

	print STDERR "Fetch $zone from $pri\n";

	exec "tcpclient","-i$myip", $pri, "53",
	"axfr-get", $zone, "$zonedir/$zone.db", "$zonedir/$zone.$$.tmp"
	    or print STDERR "tcpclient failed $?";
	exit 99;
    } else {
	$jobs{$pid} = [ $zone, $pri ];
	$njobs++;
    }
}

################################################################
# wait for jobs, mark fetched zones as OK
#
sub downto($) {
    my ($maxjobs) = @_;

    print "Wait until $maxjobs jobs\n" if $opt_d;
    while($njobs > $maxjobs) {
	my $pid = wait();
	my $retval = $?;
	my ($zone, $pri);

	if($pid < 0) {
	    print "?? wait with no pids\n";
	    return;
	}
	my $job = $jobs{$pid};

	if(!defined $job) {
	    print "?? mystery pid $pid\n";
	    next;
	}
	delete $jobs{$pid};
	($zone, $pri) = @$job;
	if($retval == 0) {
	    print "$zone fetch OK\n" if $opt_d;
	    touchit($zone);
	} else {
	    print "$zone fetch failed $retval\n" if $opt_d;
	}
	$njobs--;
    }
}