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