DNSWALK -- perl source code, post Perl5 works!
This information is offered only for education purposes with absolutely no warranty of any kind, express or impled. USE AT YOUR OWN RISK.
Hello,
This was originally written pre-perl5 and was used to walk DNS trees on domains and find issues with the domain. It stopped working properly when perl5 was released. I rewrote it to work post Perl5. Now-days most zone transfers (AXFR) are refused and so it may not be useful to you. But if they are your zones and you are checking things, it might. You can test it against "zonetransfer.me" which is a public nameserver that allows zone transfers to see it work.
Here's how to use it:
$ ./dnswalk -r zonetransfer.me.
Checking zonetransfer.me.
Getting zone transfer of zonetransfer.me. from nsztm1.digi.ninja...done.
Checking internal.zonetransfer.me
BAD: internal.zonetransfer.me has only one authoritative nameserver
Getting zone transfer of internal.zonetransfer.me from intns1.zonetransfer.me...done.
0 failures, 0 warnings, 1 errors.Here's the code: (also available from our git repository: https://cvs.tekops.com/TekOps_Inc/DNSWALK.git
#!/usr/bin/perl
#
# dnswalk Walk through a DNS tree, pulling out zone data and
# dumping it in a directory tree
#
# $Id: dnswalk,v 1.18 1997/10/06 13:23:58 barr Exp barr $
#
# check data collected for legality using standard resolver
#
# invoke as dnswalk domain > logfile
# Options:
# -r Recursively descend subdomains of domain
# -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
#
# modern perl needs this explicitly globalized:
#
# File-scope "globals"
my %errlist;
my %num_error;
use Getopt::Std;
use IO::Socket;
use Net::DNS;
getopts("D:rfiadmFl");
$num_error{'FAIL'}=0;# failures to access data
$num_error{'WARN'}=0;# questionable data
$num_error{'BAD'}=0;# bad data
# 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 \tOptions:\n \t\t-r\tRecursively descend subdomains of domain\n \t\t-i\tSuppress check for invalid characters in a domain name.\n \t\t-a\tturn on warning of duplicate A records.\n \t\t-d\tDebugging\n \t\t-m\tCheck only if the domain has been modified. (Useful only if\n \t\t\tdnswalk has been run previously.)\n \t\t-F\tEnable 'facist' checking. (See man page)\n \t\t-l\tCheck lame delegations\n\n";
}
if (! -d $basedir) {
mkdir($basedir,0777) || die "FAIL: Cannot create $basedir: $!\n";
}
&dowalk($domain);
print STDERR "$num_error{'FAIL'} failures, $num_error{'WARN'} warnings, $num_error{'BAD'} errors.\n";
exit $num_error{'BAD'};
sub dowalk {
my (@subdoms);
my (@sortdoms);
my ($domain)=$_[0];
$modified=0;
return unless $domain;
print "Checking $domain\n";
@subdoms=&doaxfr($domain);
&check_zone($domain) if (@zone);
undef @zone;
return if (!@subdoms);
@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 {
my ($domain) = @_;
my %subdoms;
my @servers = getauthservers($domain);
printerr("BAD", "$domain has only one authoritative nameserver\n")
if scalar(@servers) == 1;
printerr("BAD", "$domain has NO authoritative nameservers!\n")
if scalar(@servers) == 0;
my @zone;
SERVER:
foreach my $server (@servers) {
print STDERR "Getting zone transfer of $domain from $server...";
my $res = Net::DNS::Resolver->new;
$res->nameservers($server);
@zone = $res->axfr($domain);
unless (@zone) {
print STDERR "failed\n";
printerr("FAIL", "Zone transfer of $domain from $server failed: " . $res->errorstring . "\n");
next SERVER;
}
foreach my $rr (@zone) {
if ($rr->type eq "NS") {
my $subdom = lc($rr->name); # lowercase for comparison
if (!equal($subdom, $domain) && !$subdoms{$subdom}) {
$subdoms{$subdom} = 1;
}
}
}
print STDERR "done.\n";
last SERVER; # Exit loop after successful transfer
}
unless (@zone) {
printerr("BAD", "All zone transfer attempts of $domain failed!\n");
return ();
}
return keys %subdoms;
}
sub getauthservers {
my ($domain) = @_;
return unless $domain;
my $master = getmaster($domain);
return unless $master; # No SOA/master found, abort.
my $res = Net::DNS::Resolver->new;
my $ns_req = $res->query($domain, "NS");
unless (defined $ns_req && $ns_req->header->ancount > 0) {
printerr("FAIL", "No nameservers found for $domain: " . $res->errorstring . "\n");
return;
}
my @servers;
my %servhash;
my $foundmaster = 0;
foreach my $ns_rr ($ns_req->answer) {
my $ns_name = lc($ns_rr->nsdname);
if (equal($ns_name, $master)) {
$foundmaster = 1; # Put master at top
} else {
unless ($servhash{$ns_name}) {
push @servers, $ns_name;
$servhash{$ns_name} = 1;
}
}
}
# Put master at the top if found
unshift @servers, $master if $foundmaster;
return @servers;
}
# return 'master' server for zone
sub getmaster {
my ($zone) = @_;
return "" unless $zone;
my $res = Net::DNS::Resolver->new;
my $soa_req = $res->query($zone, "SOA");
unless (defined $soa_req) {
printerr("FAIL", "Cannot get SOA record for $zone: " . $res->errorstring . "\n");
return "";
}
foreach my $rr ($soa_req->answer) {
if ($rr->type eq "SOA") {
return $rr->mname;
}
}
printerr("BAD", "SOA record not found for $zone\n");
return "";
}
# open result of zone tranfer and check lots of nasty things
# here's where the fun begins
use Net::DNS;
use Socket;
sub check_zone {
my ($domain) = @_;
my %glues;
my ($name, $aliases, $addrtype, $length, @addrs);
my $lastns;
foreach my $rr (@zone) {
# Warn about invalid characters in A or MX names
if (($rr->type eq "A" || $rr->type eq "MX") && !$opt_i && $rr->name =~ /[^\*][^-A-Za-z0-9.]/) {
printerr("WARN", $rr->name . ": invalid character(s) in name\n");
}
if ($rr->type eq "SOA") {
print STDERR 's' if $opt_d;
my @soa = split(/\s+/, $rr->rdstring);
my $rname = $soa[1];
print "SOA=" . $rr->mname . " contact=" . $rname . "\n";
# Basic contact format check
if ($rname =~ /@/ || $rname !~ /[^.]+(\.[^.]+){2,}/) {
printerr("WARN", "SOA contact name (" . $rname . ") is invalid\n");
}
} elsif ($rr->type eq "PTR") {
print STDERR 'p' if $opt_d;
my @keys = split(/\./, $rr->name);
if (scalar(@keys) == 6 && $keys[0] ne "0") {
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->ptrdname);
if (!$name) {
printerr("WARN", $rr->name . " PTR " . $rr->ptrdname . ": unknown host\n");
} elsif (!equal($name, $rr->ptrdname)) {
printerr("WARN", $rr->name . " PTR " . $rr->ptrdname . ": CNAME (to $name)\n");
} elsif (!matchaddrlist($rr->name)) {
printerr("WARN", $rr->name . " PTR " . $rr->ptrdname . ": A record not found\n");
}
}
} elsif ($rr->type eq "A") {
print STDERR 'a' if $opt_d;
my $packed_ip = pack('C4', split(/\./, $rr->address));
($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($packed_ip, AF_INET);
if (!$name && $rr->address !~ /^255/) {
printerr("WARN", $rr->name . " A " . $rr->address . ": no PTR record\n");
} elsif ($opt_F && $name && !equal($name, $rr->name)) {
# Ignore localhost and similar special cases
if (index((split(/\./, $rr->name, 2))[0] . "-", (split(/\./, $name, 2))[0]) == -1) {
printerr("WARN", $rr->name . " A " . $rr->address . ": points to $name\n")
if (split(/\./, $name))[0] ne "localhost";
}
}
if ($main::opt_a) {
# Duplicate glue record detection
if (!$glues{$rr->address}) {
$glues{$rr->address} = $rr->name;
} elsif ($glues{$rr->address} eq $rr->name && !equal($lastns, $domain)) {
printerr("WARN", $rr->name . ": possible duplicate A record (glue of $lastns?)\n");
}
}
} elsif ($rr->type eq "NS") {
$lastns = $rr->name;
print STDERR 'n' if $opt_d;
checklamer($rr->name, $rr->nsdname) if $main::opt_l;
if (isipv4addr($rr->nsdname)) {
printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": Nameserver must be a hostname\n");
}
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->nsdname);
if (!$name) {
printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": unknown host\n");
} elsif (!equal($name, $rr->nsdname)) {
printerr("BAD", $rr->name . " NS " . $rr->nsdname . ": CNAME (to $name)\n");
}
} elsif ($rr->type eq "MX") {
print STDERR 'm' if $opt_d;
if (isipv4addr($rr->exchange)) {
printerr("BAD", $rr->name . " MX " . $rr->exchange . ": Mail exchange must be a hostname\n");
}
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->exchange);
if (!$name) {
printerr("WARN", $rr->name . " MX " . $rr->exchange . ": unknown host\n");
} elsif (!equal($name, $rr->exchange)) {
printerr("WARN", $rr->name . " MX " . $rr->exchange . ": CNAME (to $name)\n");
}
} elsif ($rr->type eq "CNAME") {
print STDERR 'c' if $opt_d;
($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($rr->cname);
if (isipv4addr($rr->cname)) {
printerr("BAD", $rr->name . " CNAME " . $rr->cname . ": alias must be a hostname\n");
}
if (!$name) {
printerr("WARN", $rr->name . " CNAME " . $rr->cname . ": unknown host\n");
} elsif (!equal($name, $rr->cname)) {
printerr("WARN", $rr->name . " CNAME " . $rr->cname . ": CNAME (to $name)\n");
}
}
}
print STDERR "\n" if $opt_d;
close(FILE);
}
# prints an error message, suppressing duplicates
sub printerr {
my ($type, $err) = @_;
unless (exists $errlist{$err}) {
print "$type: $err";
$num_error{$type}++;
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);
}
# check if argument looks like an IPv4 address
sub isipv4addr {
my ($host)=$_[0];
my ($one,$two,$three,$four);
($one,$two,$three,$four)=split(/\./,$host);
my $whole="$one$two$three$four";
# strings evaluated as numbers are zero
return (($whole+0) eq $whole);
}
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 {
my @c = reverse split(/\./, $a);
my @d = reverse split(/\./, $b);
my $max = @c > @d ? $#c : $#d;
for my $i (0 .. $max) {
next if $c[$i] eq $d[$i];
return -1 if !defined($c[$i]) || $c[$i] eq "";
return 1 if !defined($d[$i]) || $d[$i] eq "";
if ($c[$i] =~ /^\d+$/ && $d[$i] =~ /^\d+$/) {
return $c[$i] <=> $d[$i];
} else {
return $c[$i] cmp $d[$i];
}
}
return 0;
}
sub checklamer {
my ($zone, $nameserver) = @_;
my $res = Net::DNS::Resolver->new;
unless ($res->nameservers($nameserver)) {
printerr("FAIL", "Cannot find address for nameserver: " . $res->errorstring . "\n");
return;
}
my $packet = Net::DNS::Packet->new($zone, "SOA", "IN");
my $soa_req = $res->send($packet);
unless (defined $soa_req) {
printerr("FAIL", "Cannot get SOA record for $zone from $nameserver (lame?): " . $res->errorstring . "\n");
return;
}
unless ($soa_req->header->aa) {
printerr("BAD", "$zone NS $nameserver: lame NS delegation\n");
}
}
I hope it helps you!
David