1#!/usr/local/bin/perl
2#
3# dnswalk    Walk through a DNS tree, pulling out zone data and
4# dumping it in a directory tree
5#
6# $Id: dnswalk,v 1.18 1997/10/06 13:23:58 barr Exp barr $
7#
8# check data collected for legality using standard resolver
9#
10# invoke as dnswalk domain > logfile
11# Options:
12#    -r    Recursively descend subdomains of domain
13#    -i    Suppress check for invalid characters in a domain name.
14#    -a    turn on warning of duplicate A records.
15#    -d    Debugging
16#    -m    Check only if the domain has been modified.  (Useful only if
17#          dnswalk has been run previously.)
18#    -F    Enable "facist" checking.  (See man page)
19#    -l    Check lame delegations
20
21use Getopt::Std;
22use IO::Socket;
23use Net::DNS;
24
25getopts("D:rfiadmFl");
26
27$num_error{'FAIL'}=0;		# failures to access data
28$num_error{'WARN'}=0;		# questionable data
29$num_error{'BAD'}=0;		# bad data
30
31# Where all zone transfer information is saved.  You can change this to
32# something like /tmp/dnswalk if you don't want to clutter up the current
33# directory
34if ($opt_D) {
35    $basedir = $opt_D;
36} else {
37    $basedir = ".";
38}
39($domain = $ARGV[0]) =~ tr/A-Z/a-z/;
40if ($domain !~ /\.$/) {
41    die "Usage: dnswalk domain\ndomain MUST end with a '.'\n";
42}
43if (! -d $basedir) {
44	mkdir($basedir,0777) || die "FAIL: Cannot create $basedir: $!\n";
45}
46
47&dowalk($domain);
48print STDERR "$num_error{'FAIL'} failures, $num_error{'WARN'} warnings, $num_error{'BAD'} errors.\n";
49exit $num_error{'BAD'};
50
51sub dowalk {
52    my (@subdoms);
53    my (@sortdoms);
54    my ($domain)=$_[0];
55    $modified=0;
56    return unless $domain;
57    print "Checking $domain\n";
58    @subdoms=&doaxfr($domain);
59    &check_zone($domain) if (@zone);
60    undef @zone;
61    return if (! @subdoms);
62    @sortdoms = sort byhostname @subdoms;
63    local ($subdom);
64    if ($opt_r) {
65        foreach $subdom (@sortdoms) {
66            &dowalk($subdom);
67        }
68    }
69}
70# try to get a zone transfer, trying each listed authoritative server if
71# if fails.
72sub doaxfr {
73    local ($domain)=@_[0];
74    local (%subdoms)=();
75    local ($subdom);
76    local(@servers) = &getauthservers($domain);
77    &printerr("BAD", "$domain has only one authoritative nameserver\n")
78	if (scalar(@servers) == 1);
79    &printerr("BAD", "$domain has NO authoritative nameservers!\n")
80	if (scalar(@servers) == 0);
81    SERVER:
82    foreach $server (@servers) {
83        print STDERR "Getting zone transfer of $domain from $server...";
84	my $res = new Net::DNS::Resolver;
85	$res->nameservers($server);
86	@zone=$res->axfr($domain);
87	unless (@zone) {
88	    print STDERR "failed\n";
89		&printerr("FAIL",
90			"Zone transfer of $domain from $server failed: ".
91			$res->errorstring. "\n");
92		next SERVER;
93	}
94	@subdoms=undef;
95        foreach $rr (@zone) {
96            if ($rr->type eq "NS") {
97		$subdom = $rr->name;
98                $subdom =~ tr/A-Z/a-z/;
99                if ((!&equal($subdom,$domain)) && ( !$subdoms{$subdom})) {
100                    $subdoms{$subdom}=1;
101                }
102            }
103        }
104        print STDERR "done.\n";
105        last SERVER;
106    } # foreach #
107    unless (@zone) {
108	    &printerr("BAD","All zone transfer attempts of $domain failed!\n");
109	    return undef;
110    }
111    return (keys %subdoms);
112}
113
114sub getauthservers {
115    my ($domain)=$_[0];
116    my ($master)=&getmaster($domain);
117    my ($foundmaster)=0;
118    my ($ns);
119    my ($ns_tmp);
120    my ($res);
121    my ($ns_req);
122    my (@servers);
123    my (%servhash);
124    return if (!$master);  # this is null if there is no SOA or not found
125    return if (!$domain);
126    $res = new Net::DNS::Resolver;
127    $ns_req = $res->query($domain, "NS");
128    &printerr("FAIL", "No nameservers found for $domain: ".
129	$res->errorstring ."\n")
130	    unless (defined($ns_req) and ($ns_req->header->ancount > 0));
131    foreach $ns ($ns_req->answer) {
132	$ns_tmp = $ns->nsdname;
133	$ns_tmp =~ tr/A-Z/a-z/;
134	if (&equal($ns_tmp,$master)) {
135	    $foundmaster=1;   # make sure the master is at the top
136	} else {
137	    push(@servers,$ns_tmp) if ($servhash{$ns_tmp}++<1);
138	}
139    }
140    if ($foundmaster) {
141	unshift(@servers,$master);
142    }
143    return @servers;
144}
145
146# return 'master' server for zone
147sub getmaster {
148    my ($zone)=$_[0];
149    my ($res) = new Net::DNS::Resolver;
150    my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN");
151    my ($soa_req) = $res->send($packet);
152    unless (defined($soa_req)) {
153	&printerr("FAIL", "Cannot get SOA record for $zone:".
154	    $res->errorstring ."\n");
155	return "";
156    }
157    unless (($soa_req->header->ancount >= 1) &&
158	   (($soa_req->answer)[0]->type eq "SOA")) {
159	&printerr("BAD", "SOA record not found for $zone\n");
160	return "";
161    }
162    return ($soa_req->answer)[0]->mname;
163}
164
165# open result of zone tranfer and check lots of nasty things
166# here's where the fun begins
167sub check_zone {
168    my ($domain)=$_[0];
169    local (%glues)=();	# look for duplicate glue (A) records
170    local ($name, $aliases, $addrtype, $length, @addrs);
171    local ($prio,$mx);
172    local ($soa,$contact);
173    local ($lastns);	# last NS record we saw
174    local (@keys);	# temp variable
175    foreach $rr (@zone) {
176	# complain about invalid chars only for mail names
177        if ((($rr->type eq "A") || ($rr->type eq "MX")) && (!$opt_i) &&
178	    ($rr->name =~ /[^\*][^-A-Za-z0-9.]/)) {
179            &printerr("WARN", $rr->name .": invalid character(s) in name\n");
180        }
181        if ($rr->type eq "SOA") {
182	    print STDERR 's' if $opt_d;
183	    print "SOA=". $rr->mname ."	contact=". $rr->rname ."\n";
184	    # basic address check.  No "@", and user.dom.ain (two or more dots)
185	    if (($rr->rname =~ /@/)||!($rr->rname =~ /\..*\./)) {
186		&printerr("WARN", "SOA contact name (".
187		    $rr->rname .") is invalid\n");
188	    }
189        } elsif ($rr->type eq "PTR") {
190            print STDERR 'p' if $opt_d;
191            if (scalar((@keys=split(/\./,$rr->name))) == 6 ) {
192                # check if forward name exists, but only if reverse is
193                # a full IP addr
194                # skip ".0" networks
195                if ($keys[0] ne "0") {
196                   ($name, $aliases, $addrtype, $length,
197			    @addrs)=gethostbyname($rr->ptrdname);
198#                   if (!(($name, $aliases, $addrtype, $length,
199#			    @addrs)=gethostbyname($rr->ptrdname))) {
200#                        &printerr("FAIL", "gethostbyname(".
201#			    $rr->ptrdname ."): $!\n");
202#                   }
203#                   else {
204                        if (!$name) {
205                            &printerr("WARN", $rr->name
206				." PTR ". $rr->ptrdname .": unknown host\n");
207                        }
208                        elsif (!&equal($name,$rr->ptrdname)) {
209                            &printerr("WARN", $rr->name
210			      ." PTR ". $rr->ptrdname .": CNAME (to $name)\n");
211                        }
212                        elsif (!&matchaddrlist($rr->name)) {
213                            &printerr("WARN", $rr->name
214			     ." PTR ". $rr->ptrdname .": A record not found\n");
215                        }
216#                   }
217                }
218            }
219        } elsif (($rr->type eq "A") ) {
220            print STDERR 'a' if $opt_d;
221	    # check to see that a reverse PTR record exists
222            ($name,$aliases,$addrtype,$length,@addrs)=gethostbyaddr(pack('C4',
223		    split(/\./,$rr->address)),2);
224	    if (!$name) {
225		# hack - allow RFC 1101 netmasks encoding
226		if ($rr->address !=~ /^255/) {
227		    &printerr("WARN", $rr->name ." A ".
228			$rr->address .": no PTR record\n");
229		}
230	    }
231	    elsif ($opt_F && !&equal($name,$rr->name)) {
232		# Filter out "hostname-something" (like "neptune-le0")
233		if (index(split (/\./, $rr->name, 2) . "-",
234			    split (/\./, $name, 2)) == -1 ) {
235			&printerr("WARN", $rr->name ." A ".
236			    $rr->address .": points to $name\n")
237			    if ((split(/\./,$name))[0] ne "localhost");
238		}
239	    }
240	    if ($main'opt_a) {
241		# keep list in %glues, report any duplicates
242		if ($glues{$rr->address} eq "") {
243		    $glues{$rr->address}=$rr->name;
244		}
245		elsif (($glues{$rr->address} eq $rr->name) &&
246			(!&equal($lastns,$domain))) {
247		    &printerr("WARN", $rr->name
248			.": possible duplicate A record (glue of $lastns?)\n");
249		}
250	    }
251        } elsif ($rr->type eq "NS") {
252            $lastns=$rr->name;
253            print STDERR 'n' if $opt_d;
254            # check to see if object of NS is real
255            &checklamer($rr->name,$rr->nsdname) if ($main'opt_l);
256	    # check for bogusnesses like NS->IP addr
257	    if (&isipv4addr($rr->nsdname)) {
258		&printerr("BAD", $rr->name
259			." NS ". $rr->nsdname .": Nameserver must be a hostname\n");
260	    }
261            ($name, $aliases, $addrtype, $length,
262		    @addrs)=gethostbyname($rr->nsdname);
263#            if (!(($name, $aliases, $addrtype, $length,
264#		    @addrs)=gethostbyname($rr->nsdname))) {
265#                &printerr("FAIL", "gethostbyname(". $rr->nsdname ."): $!\n");
266#            }
267#            else {
268                if (!$name) {
269                    &printerr("BAD", $rr->name
270			." NS ". $rr->nsdname .": unknown host\n");
271                } elsif (!&equal($name,$rr->nsdname)) {
272                    &printerr("BAD", $rr->name
273			." NS ". $rr->nsdname .": CNAME (to $name)\n");
274                }
275#            }
276        } elsif ($rr->type eq "MX") {
277            print STDERR 'm' if $opt_d;
278            # check to see if object of mx is real
279	    if (&isipv4addr($rr->exchange)) {
280		&printerr("BAD", $rr->name
281			." MX ". $rr->exchange .": Mail exchange must be a hostname\n");
282	    }
283            ($name, $aliases, $addrtype, $length,
284		    @addrs)=gethostbyname($rr->exchange);
285#            if (!(($name, $aliases, $addrtype, $length,
286#		    @addrs)=gethostbyname($rr->exchange))) {
287#                &printerr("FAIL", "gethostbyname(". $rr->exchange ."): $!\n");
288#            }
289#            else {
290                if (!$name) {
291                    &printerr("WARN", $rr->name
292			." MX ". $rr->exchange .": unknown host\n");
293                }
294                elsif (!&equal($name,$rr->exchange)) {
295                    &printerr("WARN", $rr->name
296			." MX ". $rr->exchange .": CNAME (to $name)\n");
297                }
298#            }
299        } elsif ($rr->type eq "CNAME") {
300            print STDERR 'c' if $opt_d;
301            ($name, $aliases, $addrtype, $length,
302		    @addrs)=gethostbyname($rr->cname);
303	    if (&isipv4addr($rr->cname)) {
304		&printerr("BAD", $rr->name
305			." CNAME ". $rr->cname .": alias must be a hostname\n");
306	    }
307#            if (!(($name, $aliases, $addrtype, $length,
308#		    @addrs)=gethostbyname($rr->cname))) {
309#                &printerr("FAIL", "gethostbyname(". $rr->cname ."): $!\n");
310#            }
311#            else {
312                if (!$name) {
313                    &printerr("WARN", $rr->name
314			." CNAME ". $rr->cname .": unknown host\n");
315                } elsif (!&equal($name,$rr->cname)) {
316                    &printerr("WARN", $rr->name
317			." CNAME ". $rr->cname .": CNAME (to $name)\n");
318                }
319#            }
320        }
321    }
322    print STDERR "\n" if $opt_d;
323    close(FILE);
324}
325
326# prints an error message, suppressing duplicates
327sub printerr {
328    my ($type, $err)=@_;
329    if ($errlist{$err}==undef) {
330	print "$type: $err";
331	$num_error{$type}++;
332	print STDERR "!" if $opt_d;
333	$errlist{$err}=1;
334    } else {
335	print STDERR "." if $opt_d;
336    }
337}
338
339sub equal {
340    # Do case-insensitive string comparisons
341    local ($one)= $_[0];
342    local ($two)= $_[1];
343    $stripone=$one;
344    if (chop($stripone) eq '.') {
345	$one=$stripone;
346    }
347    $striptwo=$two;
348    if (chop($striptwo) eq '.') {
349	$two=$striptwo;
350    }
351    $one =~ tr/A-Z/a-z/;
352    $two =~ tr/A-Z/a-z/;
353    return ($one eq $two);
354}
355
356# check if argument looks like an IPv4 address
357sub isipv4addr {
358    my ($host)=$_[0];
359    my ($one,$two,$three,$four);
360    ($one,$two,$three,$four)=split(/\./,$host);
361    my $whole="$one$two$three$four";
362    # strings evaluated as numbers are zero
363    return (($whole+0) eq $whole);
364}
365sub matchaddrlist {
366    local($match)=pack('C4', reverse(split(/\./,$_[0],4)));
367    local($found)=0;
368    foreach $i (@addrs) {
369        $found=1 if ($i eq $match);
370    }
371    return $found;
372}
373
374# there's a better way to do this, it just hasn't evolved from
375# my brain to this program yet.
376sub byhostname {
377    @c = reverse(split(/\./,$a));
378    @d = reverse(split(/\./,$b));
379    for ($i=0;$i<=(($#c > $#d) ? $#c : $#d) ;$i++) {
380        next if $c[$i] eq $d[$i];
381        return -1 if $c[$i] eq "";
382        return  1 if $d[$i] eq "";
383        if ($c[$i] eq int($c[$i])) {
384            # numeric
385            return $c[$i] <=> $d[$i];
386        }
387        else {
388            # string
389            return $c[$i] cmp $d[$i];
390        }
391    }
392    return 0;
393}
394
395sub checklamer {
396    my ($zone,$nameserver)=@_;
397    my ($packet) = new Net::DNS::Packet($zone, "SOA", "IN");
398    my ($soa_req);
399    my ($res) = new Net::DNS::Resolver;
400    unless ($res->nameservers($nameserver)) {
401	&printerr("FAIL", "Cannot find address for nameserver: ".
402	    $res->errorstring. "\n");
403    }
404    $soa_req = $res->send($packet);
405    unless (defined($soa_req)) {
406	&printerr("FAIL",
407	    "Cannot get SOA record for $zone from $nameserver (lame?): ".
408		$res->errorstring ."\n");
409	return;
410    }
411    &printerr("BAD", "$zone NS $nameserver: lame NS delegation\n")
412	unless ($soa_req->header->aa);
413    return;
414}
415