#!/usr/bin/perl
# dnswalk    Walk through a DNS tree, pulling out zone data and
# dumping it in a directory tree
#
# $Id: dnswalk,v 1.12 1994/11/17 19:16:14 barr Exp barr $
#
# check data collected for legality using standard resolver
#
# invoke as dnswalk domain > logfile
# Options:
#    -r    Recursively descend subdomains of domain
#    -f    Force a zone transfer, ignore existing axfr file
#    -i    Suppress check for invalid characters in a domain name.
#    -a    turn on warning of duplicate A records.
#    -d    Debugging
#    -m    Check only if the domain has been modified.  (Useful only if
#          dnswalk has been run previously.)
#    -F    Enable "facist" checking.  (See man page)
#    -l    Check lame delegations
#    -D dir  Use 'dir' as base directory for saved axfr files

require "getopts.pl";

do Getopts("D:rfiadmFl");

# Where all zone transfer information is saved.  You can change this to
# something like /tmp/dnswalk if you don't want to clutter up the current
# directory
if ($opt_D) {
    $basedir = $opt_D;
} else {
    $basedir = ".";
}
($domain = $ARGV[0]) =~ tr/A-Z/a-z/;
if ($domain !~ /\.$/) {
    die "Usage: dnswalk domain\ndomain MUST end with a '.'\n";
}
if (! -d $basedir) {
	mkdir($basedir,0777) || die "Cannot create $basedir: $!\n";
}

&dowalk($domain);

exit;

sub dowalk {
    local (@subdoms);
    local (@sortdoms);
    local ($domain)=$_[0];
    $modified=0;
#    ($file,@subdoms)=&doaxfr($domain);  /* perl bug */
    @subdoms=&doaxfr($domain);
    $file=shift(@subdoms);
    if ($file && !($opt_m && !$modified)) {
        &checkfile($file,$domain);
    }
    else {
        print STDERR "skipping...\n";
    }
    @sortdoms = sort byhostname @subdoms;
    local ($subdom);
    if ($opt_r) {
        foreach $subdom (@sortdoms) {
            &dowalk($subdom);
        }
    }
}
# try to get a zone transfer, trying each listed authoritative server if
# if fails.
sub doaxfr {
    local ($domain)=@_[0];
    local (%subdoms)=();
    local ($subdom);
    local ($serial);
    local ($foundsoa)=0;    # attempt to make up for dig's poor 
                # error handling
    ($path=&host2path($domain)) =~ tr/A-Z/a-z/;
    local(@servers) = &getauthservers($domain);
    &printerr("warning: $domain has only one authoritative nameserver\n") if (scalar(@servers) == 1);
    &printerr("warning: $domain has NO authoritative nameservers!\n") if (scalar(@servers) == 0);
    if ((-f "$basedir/$path/axfr") && (!$main'opt_f)) {
        open(DIG,"<$basedir/$path/axfr") || die "cannot open $basedir/$path/axfr: $!\n";
        while (<DIG>) {
            chop;
            if (/(\d+)\s*; ?serial/) {
                $serial=$1;
            }
            if (/(\S+)\s*\d+\s+NS/) {
		$subdom = $1;
                $subdom =~ tr/A-Z/a-z/;
                if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) {
                    $subdoms{$subdom}=1;
                }
            }
        }
        # if there's no serial number in file, assume it is corrupt
        if ($serial) {
            foreach $server (@servers) {
                $authserno=&getserno($domain,$server);
                last if ($authserno);
            }
            if ($authserno <= $serial) {
                print STDERR "Using existing zone transfer info for $domain\n";
                return ("$basedir/$path/axfr", keys %subdoms);
            }
        }
    }
    &mkdirpath($path);
    SERVER:
    foreach $server (@servers) {
	$foundsoa=0;
        $SIG{'INT'}="nop;";
        print STDERR "Getting zone transfer of $domain from $server...";
        open(DIG,"dig axfr $domain \@$server 2>/dev/null |");
        open(DIGOUT,">$basedir/$path/axfr") || die "cannot open $basedir/$path/axfr: $!\n";
	@subdoms=undef;
        while (<DIG>) {
            if (/(\S+)\s*\d+\s+NS/) {
		$subdom = $1;
                $subdom =~ tr/A-Z/a-z/;
                if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) {
                    $subdoms{$subdom}=1;
                }
            }
            elsif (/\S+\s*\d+\s+SOA/) {
                $foundsoa=1;
            }
            print DIGOUT $_;
        }
        if ($? || !$foundsoa) {
            print STDERR "failed.\n";
            close(DIGOUT);
            next SERVER;
        }
        print STDERR "done.\n";
        close(DIGOUT);
        close(DIG);
        last SERVER;
    } # foreach #
    $SIG{'INT'}=undef;
    if ($? || !$foundsoa) {
        print STDERR "All zone transfer attempts of $domain failed\n";
        print "Cannot check $domain: no available nameservers!\n";
        unlink("$basedir/$path/axfr");
        &rmdirpath($path);
        return undef;
    }
    $modified=1;
    return ("$basedir/$path/axfr", keys %subdoms);
}

# returns "edu/psu/pop" given "pop.psu.edu"
sub host2path {
    join('/',reverse(split(/\./,$_[0])));
}

# makes sure all directories exist in "foo/bar/baz"
sub mkdirpath {
    local (@path)=split(/\//,$_[0]);
    local ($dir)=$basedir;
    foreach $p (@path) {
	$dir .= "/".$p;
	if (! -d $dir) {
            mkdir($dir, 0777) || die "Cannot mkdir $dir: $!\n";
	}
    }
}

# remove empty directories in path
sub rmdirpath {
    local (@path)=split(/\//,$_[0]);
    local (@dirs);
    local ($dir)=$basedir;
    foreach $p (@path) {
      push(@dirs, ($dir .= "/".$p));
    }
    foreach $p (reverse(@dirs)) {
        last if !rmdir($p);
    }
}

sub getserno {
    local ($serno)="";
    $SIG{'INT'}="nop;";
    open(DIG,"dig soa $_[0] \@$_[1] 2>/dev/null|");
    while (<DIG>) {
        if (/(\d+)\s*; ?serial/) { 
            $serno=$1;
        }
    }
    close(DIG);
    $SIG{'INT'}=undef;
    return $serno;
}


sub getauthservers {
    local ($domain)=$_[0];
    local ($master)=&getmaster($domain);
    local ($foundmaster)=0;
    local ($s);
    open(DIG,"dig +noau ns $_[0] 2>/dev/null|");
    local(@servers)=();
    local(%servhash)=();
    while (<DIG>) {
        chop;
	tr/A-Z/a-z/;
        if (/\S+\s+\d+\s+ns\s+(\S+)/) {
	    $s=$1;
	    if (&equal($s,$master)) {
		$foundmaster=1;   # make sure the master is at the top
	    } else {
                push(@servers,$s) if ($servhash{$s}++<1);
	    }
        }
    }
    close(DIG);
    if ($foundmaster) {
	unshift(@servers,$master);
    }
    return @servers;
}


sub getmaster {  # return 'master' server for zone
    local ($master)="";
    $SIG{'INT'}="nop;";
    open(DIG,"dig soa $_[0] 2>/dev/null|");
    while (<DIG>) {
	tr/A-Z/a-z/;
        if (/.*\t\d+\tsoa\t(\S+) /) { 
            $master=$1;
        }
    }
    close(DIG);
    $SIG{'INT'}=undef;
    return $master;
}

# open result of zone tranfer and check lots of nasty things
# here's where the fun begins
sub checkfile {
    open(FILE,"<$_[0]") || die "Cannot open $_[0]: $!\n";
    undef $errlist;
    print "Checking $domain\n";
    local (%glues)=();	# look for duplicate glue (A) records
    local ($name, $aliases, $addrtype, $length, @addrs);
    local ($prio,$mx);
    local ($soa,$contact);
    local ($lastns);	# last NS record we saw
    local (@keys);	# temp variable
    $soa=undef;
    $doubledom = $domain . $domain;
    $doubledom =~ s/(\W)/\\\1/g;	# quote string so it's a regexp
    while (<FILE>) {
        chop;
        if (/^;/) {
            if (/(.*[Ee][Rr][Rr][Oo][Rr].*)/) {
                # print any dig errors
                print $1 ."\n";
                next;
            }
        }
        next if /^$/;	# skip blanks
	# check to see if there is a "foo.bar.baz.bar.baz."
	# probably a trailing-dot death.
	if (/$doubledom/) {
		&printerr(" $_: domain occurred twice, forgot trailing '.'?\n");
	}
        split(/\t/);
        # 0=key 2=rrtype 3=value (4=value if 2=MX)
        next if ($_[0] =~ /;/);
	# complain only for mail names
        if (($_[0] =~ /[^\*][^-A-Za-z0-9.]/) && (!$opt_i) && (($_[2] eq "A") || ($_[2] eq "MX"))) {
            &printerr(" $_[0]: invalid character(s) in name\n");
        }
        if ($_[2] eq "SOA") {
            print STDERR 's' if $opt_d;
	    if (! $soa) {  # avoid duplicate SOA's.  Argh.
               ($soa,$contact) = $_[3] =~ /(\S+)\s+(\S+)/;
               print "SOA=$soa	contact=$contact\n";
	    }
        } elsif ($_[2] eq "PTR") {
            print STDERR 'p' if $opt_d;
            if (scalar((@keys=split(/\./,$_[0]))) == 6 ) {
                # check if forward name exists, but only if reverse is
                # a full IP addr
                # skip ".0" networks
                if ($keys[0] ne "0") {
                    if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($_[3])) && !$?) {
                        &printerr(" gethostbyname($_[3]): $!\n");
                    }
                    else {
                        if (!$name) {
                            &printerr(" $_[0] PTR $_[3]: unknown host\n");
                        }
                        elsif (!&equal($name,$_[3])) {
                            &printerr(" $_[0] PTR $_[3]: CNAME (to $name)\n");
                        }    
                        elsif (!&matchaddrlist($_[0])) {
                            &printerr(" $_[0] PTR $_[3]: A record not found\n");
                        }
                    }
                }
            }
        } elsif (($_[2] eq "A") ) {
            print STDERR 'a' if $opt_d;
# check to see that a reverse PTR record exists
            if (!(($name,$aliases,$addrtype,$length,@addrs)=gethostbyaddr(pack('C4', split(/\./,$_[3])),2)) && !$?) {
                &printerr(" gethostbyaddr($_[3]): $!\n");
            }
            else {
                if (!$name) {
		    # hack - allow RFC 1101 netmasks encoding
		    if ( $_[3] !=~ /^255/) {
                        &printerr(" $_[0] A $_[3]: no PTR record\n");
		    }
                }
                elsif ($opt_F && !&equal($name,$_[0])) {
                    &printerr(" $_[0] A $_[3]: points to $name\n") if ((split(/\./,$name))[0] ne "localhost");
                }
                if ($main'opt_a) {
                    # keep list in %glues, report any duplicates
                    if ($glues{$_[3]} eq "") {
                        $glues{$_[3]}=$_[0];
                    }
                    elsif (($glues{$_[3]} eq $_[0]) && (!&equal($lastns,$domain))) {
                            &printerr(" $_[0]: possible duplicate A record (glue of $lastns?)\n");
                    }
                }
            }
        } elsif ($_[2] eq "NS") {
            $lastns=$_[0];
            print STDERR 'n' if $opt_d;
            # check to see if object of NS is real
            &checklamer($_[0],$_[3]) if ($main'opt_l);
            if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($_[3])) && !$?) {
                &printerr(" gethostbyname($_[3]): $!\n");
            }
            else {
                if (!$name) {
                    &printerr(" $_[0] NS $_[3]: unknown host\n");
                } elsif (!&equal($name,$_[3])) {
                    &printerr(" $_[0] NS $_[3]: CNAME (to $name)\n");
                }
            }
        } elsif ($_[2] eq "MX") {
            print STDERR 'm' if $opt_d;
            # check to see if object of mx is real
            ($prio,$mx)=split(/ /,$_[3]);
            if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($mx)) && !$?) {
                &printerr(" gethostbyname($mx): $!\n");
            }
            else {
                if (!$name) {
                    &printerr(" $_[0] MX $_[3]: unknown host\n");
                }
                elsif (!&equal($name,$mx)) {
                    &printerr(" $_[0] MX $_[3]: CNAME (to $name)\n");
                }
            }
        } elsif ($_[2] eq "CNAME") {
            print STDERR 'c' if $opt_d;
            if (!(($name, $aliases, $addrtype, $length, @addrs)=gethostbyname($_[3])) && !$?) {
                &printerr(" gethostbyname($_[3]): $!\n");
            }
            else {
                if (!$name) {
                    &printerr(" $_[0] CNAME $_[3]: unknown host\n");
                } elsif (!&equal($name,$_[3])) {
                    &printerr(" $_[0] CNAME $_[3]: CNAME (to $name)\n");
                }
            }
        }
    }
    print STDERR "\n" if $opt_d;
    close(FILE);
}

# prints an error message, suppressing duplicates
sub printerr {
    local ($err)=$_[0];
    if ($errlist{$err}==undef) {
	print $err;
	print STDERR "!" if $opt_d;
	$errlist{$err}=1;
    } else {
	print STDERR "." if $opt_d;
    }
}

sub equal {
    # Do case-insensitive string comparisons
    local ($one)= $_[0];
    local ($two)= $_[1];
    $stripone=$one;
    if (chop($stripone) eq '.') {
	$one=$stripone;
    }
    $striptwo=$two;
    if (chop($striptwo) eq '.') {
	$two=$striptwo;
    }
    $one =~ tr/A-Z/a-z/;
    $two =~ tr/A-Z/a-z/;
    return ($one eq $two);
}

sub matchaddrlist {
    local($match)=pack('C4', reverse(split(/\./,$_[0],4)));
    local($found)=0;
    foreach $i (@addrs) {
        $found=1 if ($i eq $match);
    }
    return $found;
}

# there's a better way to do this, it just hasn't evolved from
# my brain to this program yet.
sub byhostname {
    @c = reverse(split(/\./,$a));
    @d = reverse(split(/\./,$b));
    for ($i=0;$i<=(($#c > $#d) ? $#c : $#d) ;$i++) {
        next if $c[$i] eq $d[$i];
        return -1 if $c[$i] eq "";
        return  1 if $d[$i] eq "";
        if ($c[$i] eq int($c[$i])) {
            # numeric
            return $c[$i] <=> $d[$i];
        }
        else {
            # string
            return $c[$i] cmp $d[$i];
        }
    }
    return 0;
}

sub checklamer {
    local ($isauth)=0;
    local ($error)=0;
    # must check twice, since first query may be authoritative
    # trap stderr here and print if non-empty
    open(DIG,"dig soa +noaa $_[0] \@$_[1] 2>&1 1>/dev/null |");
    while (<DIG>) {
        print " $_[0] NS $_[1]: nameserver error (lame?):\n" if !$error;
	print;
	$error=1;
    }
    close(DIG);
    return if $error;
    open(DIG,"dig soa +noaa $_[0] \@$_[1] 2>/dev/null|");
    while (<DIG>) {
        if (/status: NXDOMAIN/) { 
            $isauth=0;
	    last;
        }
        if (/status: SERVFAIL/) { 
            $isauth=0;
	    last;
        }
        if (/;; flags.*aa.*;/) { 
            $isauth=1;
        }
    }
    if (!$isauth) {
        print " $_[0] NS $_[1]: lame NS delegation\n";
    }
    close(DIG);
    return;
}
