#!/afs/athena/contrib/perl/perl

$tmpd = "/afs/sipb/user/bert/rdump/tmp/";
$errs =   $tmpd."errors.log";
$weird =  $tmpd."weird_stuff.log";
$mxlog =  $tmpd."dump_mx.log";
$alog =   $tmpd."dump_a.log";
$cnlog =  $tmpd."dump_cname.log";
$hilog =  $tmpd."dump_hinfo.log";
$soalog = $tmpd."dump_soa.log";

$debug=0; $verbose=1;  $ipres = 1; $printns = 1; $printsoa = 1;

sub dump_prt {
    print "::: ", join(":", @_), "\n";
}

sub debug_prt {
    print "+++ id = '",@_[0],"'  auth = '",@_[1],"'\n";
    print "+++ recurs = '",@_[2],"'  resp = '",@_[3],"'\n";
    print "+++ Q = '",  join("','",@_[ (@_[4])..(@_[4]+@_[5]-1)] ),  "'\n";
    print "+++ A = '",  join("','",@_[ (@_[6])..(@_[6]+@_[7]-1)] ),  "'\n";
    print "+++ auth = '",  join("','",@_[ (@_[8])..(@_[8]+@_[9]-1)] ),  "'\n";
    print "+++ addl = '",  join("','",@_[ (@_[10])..(@_[10]+@_[11]-1)] ),"'\n";
}

sub query_addr {
    $qa = &res_mkquery(@_[1], "A", "IN", 16256);
    @qares = &res_send(@_[0], $qa);
    &rs_die;
    die "Unable to find IP address: query failed ($res[3])" if $res[3];
    &debug_prt(@qares) if $debug;
    @_[1] =~ tr/a-z/A-Z/;
    return(  $ipaddr{@_[1]} = (split(" ", $qares[$qares[6]]))[4]  );
}

sub ns_lookup {
    $q = &res_mkquery(@_[1], "NS", "IN", 16256);
    @res = &res_send(@_[0], $q);
    &rs_die;
    die "Unable to find domain nameserver: query failed ($res[3])" if $res[3];
    &debug_prt(@res) if $debug;

    $stack = "";
    for ($i=0; $i<$res[7]; $i++) {
	$stack .= (split(" ",$res[$res[6]+$i]))[4] . " ";
    }
    chop($stack);
    $stack =~ tr/a-z/A-Z/;
    $dns{$domain} = $stack;
    print "Nameservers are $stack.\n" if $verbose;

    # one IP addr per server is quite OK... =)

    for ($i=0; $i<$res[11]; $i++) {
	@tmp = split(" ",$res[$res[10]+$i]);
	$tmp[0] =~ tr/a-z/A-Z/;
	$ipaddr{$tmp[0]} = $tmp[4];
    }
}

sub choose_server {
    return( (split(" ",$dns{@_[0]}))[0] );
}

sub punt_server {
    local(@tmp) = split(" ",$dns{@_[0]});
    $dns{@_[0]} = join(" ",@tmp[1..$#tmp]);
}

sub weird_log {
    if (@_[7] == 0 && $weird) {
	print WEIRD "No answers in queue! in domain $domain\n";
    }
    if (@_[7] > 1 && $weird) {
	print WEIRD "@_[7] answers in queue! in domain $domain\n";
    }
    if (@_[9] != 0 && $weird) {
	print WEIRD "@_[9] authority records in queue in domain $domain:\n";
	for ($i=0; $i<@_[9]; $i++) { print WEIRD "+",@_[@_[8]+$i],"\n"; }
    }
    if (@_[11] != 0 && $weird) {
	print WEIRD "@_[11] additional records in queue in domain $domain:\n";
	for ($i=0; $i<@_[11]; $i++) { print WEIRD "+",@_[@_[10]+$i],"\n"; }
    }
}

sub fmt {
    return( sprintf("%-35s %s %s %6s %s %s %s %s", @_) );
}

sub parse_rec {
    @tmp = split(" ",@_[0]);
    if ($tmp[2] ne "IN") {
	if ($weird) {
	    print WEIRD "Wow! a non-Internet entry in domain $domain!",
                        "Weird!  Here goes:\n";
	    print WEIRD "+",@_[0],"\n";
	}
    }
    else {
	if    ($tmp[1] eq "NS") { print &fmt(@tmp),"\n" if $printns;
				  $tmp[0] =~ tr/a-z/A-Z/;
				  push(@localns, $tmp[0], $tmp[4]); }
	elsif ($tmp[1] eq "SOA") { print @_[0],"\n" if $printsoa;
				   print SOALOG &fmt(@tmp),"\n" if $soalog; }
	elsif ($tmp[1] eq "A")   { print ALOG &fmt(@tmp),"\n" if $alog;
				   $tmp[0] =~ tr/a-z/A-Z/;
				   $localaddr{$tmp[0]} = $tmp[4]; }
	elsif ($tmp[1] eq "MX")  { print MXLOG &fmt(@tmp),"\n" if $mxlog; }
	elsif ($tmp[1] eq "HINFO"){print HILOG &fmt(@tmp),"\n" if $hilog; }
	elsif ($tmp[1] eq "CNAME"){print CNLOG &fmt(@tmp),"\n" if $cnlog; }
	else     { print WEIRD "Strange entry type in domain $domain:\n+",
		                @_[0],"\n" if $weird; }
    }
}

sub member {
    $el = shift;
    while (@_) {
	return 1 if shift eq $el;
    }
    return 0;
}

sub parse_local {
    %ldns = ();
    @ldoml = ();
    while (@localns) {
	local($dom) = shift(@localns); $dom =~ tr/a-z/A-Z/;
	local($nsn) = shift(@localns);  $nsn =~ tr/a-z/A-Z/;
	if (! &member($dom, @known)) {
	    if (! &member($dom, @ldoml)) { push(@ldoml, $dom); }
	    $ldns{$dom} .= $nsn . " ";
	    $ipaddr{$nsn} = $localaddr{$nsn} if $localaddr{$nsn};
	}
    }
    unshift(@queue, @ldoml);
    push(@known, @ldoml);
    while (@ldoml) {
	local($dom) = shift(@ldoml);
	local($dnss) = $ldns{$dom};
	chop($dnss);
	$dns{$dom} = $dnss;
    }
}

### the main part:

# unshift(@INC,"/afs/athena.mit.edu/user/m/a/marc/perl");
unshift(@INC,"/afs/athena.mit.edu/user/b/e/bert/PERL");
require 'resolv.pl';

# usage:  $0 domain ns
$domain = shift(@ARGV) || die "args!";   $domain =~ tr/a-z/A-Z/;
$initserv = shift(@ARGV) || die "args!"; $initserv =~ tr/a-z/A-Z/;
@queue = @known = ($domain);

# logfiles
open(WEIRD, ">".$weird)  || die "Can't open '$weird'"  if $weird;
open(ERRS, ">".$errs)    || die "Can't open '$errs'"   if $errs;
open(MXLOG, ">".$mxlog)  || die "Can't open '$mxlog'"  if $mxlog;
open(ALOG,  ">".$alog)   || die "Can't open '$alog'"   if $alog;
open(CNLOG, ">".$cnlog)  || die "Can't open '$cnlog'"  if $cnlog;
open(HILOG, ">".$hilog)  || die "Can't open '$hilog'"  if $hilog;
open(SOALOG,">".$soalog) || die "Can't open '$soalog'" if $soalog;

## one of these two:
&set_opts(0);
# &set_opts(&RES_DEBUG);

## connect to initial nameserver, build query and look up target nameserver.

$ns = &res_open($initserv) || die "Unable to contact $initserv!";
&ns_lookup($ns,$domain);

## fix this for real someday!
if ($ipres) {
    $ipaddr{$nsname} || &query_addr($ns,$nsname);
}

while (@queue) {
    $domain = shift(@queue);
    print "I'm parsing domain $domain. $retry\n" if $verbose;
    $retry = "";

    $nsname = &choose_server($domain);
    if (! $nsname) {
	print "No available servers for domain $domain.\n";
	print ERRS "Exhausted list of servers for domain $domain.\n";
    }
    else {
	print "I'm using nameserver $nsname.\n" if $verbose;

	if ($ipres) {
	    $nameserv = $nsaddr = $ipaddr{$nsname} ||
		die "Oops! needs resolving!";
	    print "I'm using address $nsaddr.\n" if $verbose;
	}
	else {
	    $nameserv = $nsname;
	}

	## connect to nameserver.
	$ns = &res_open($nameserv);

	$q = &res_mkquery($domain, "AXFR", "IN", 16256);
	@res = &res_send($ns, $q);
	if ( &rs_error ) {
	    print "Unable to connect to $nameserv.\n" if $verbose;
	    print ERRS "Unable to send to $nameserv: ",&rs_error,"\n";
	    &punt_server($domain);
	    unshift( @queue,$domain );
	    $retry = "(retry)";
	}
	else
	{
	    if ($debug) {print "\n"; &debug_prt(@res);} 
	    die "Error starting domain transfer: query failed ($res[3])"
		if $res[3];
	    &weird_log(@res);
	    for ($i=0; $i<$res[7]; $i++) { &parse_rec($res[$res[6]+$i]); }

	    $res[5] = 0;
	    while ($res[5] == 0) {
		@res = &res_send($ns, "");
		&rs_die;
		if ($debug) {print "\n"; &debug_prt(@res);} 
		die "Error in domain transfer: query failed ($res[3])"
		    if $res[3];
		&weird_log(@res);
		for ($i=0; $i<$res[7]; $i++) { &parse_rec($res[$res[6]+$i]); }
	    }

	    &parse_local;
	}
    }
}

# options using single-quotes

sub set_opts {
    $res'options |= &RES_USEVC | &RES_STAYOPEN | @_[0];
}

sub rs_die {
    die "res_send: $res'error" if $res'error;
}

sub rs_error {
    return( $res'error );
}