sleuth

   1 #!/usr/bin/perl -w
   2 #
   3 #       Sleuth -- A Simple DNS Checking Tool
   4 #
   5 #       (c) 1999--2001 Martin Mares <mj@ucw.cz>
   6 #
   7
   8 # Load configuration file and all modules we need
   9
  10 BEGIN {
  11         if (-f "/etc/sleuth.conf") {
  12                 require "/etc/sleuth.conf";
  13         } else {
  14                 require __FILE__ . ".conf";
  15         }
  16 }
  17
  18 use Getopt::Std;
  19 use Net::DNS::Resolver;
  20
  21 # Parse arguments
  22
  23 getopts('vmhp', \%opts) && (@ARGV >= 1 && @ARGV <= 3 || @ARGV == 5) || do {
  24         print <<EOF
  25 Usage: sleuth [-hmpv] <domain> [<server> [<server-IP> [<secondary> <secondary-ip>]]]
  26
  27 -h      Produce HTML output
  28 -m      Produce machine-readable output
  29 -p      Private network mode (avoid public accessibility checks)
  30 -v      Be verbose
  31 EOF
  32 ;
  33         exit 1;
  34 };
  35 $domain = norm_name($ARGV[0]);
  36 $mode_submit = @ARGV == 5;
  37 $check_ns = defined($ARGV[1]) ? norm_name($ARGV[1]) : "";
  38 $check_ns_ip = defined($ARGV[2]) ? $ARGV[2] : "";
  39 $our_name = defined($ARGV[3]) ? norm_name($ARGV[3]) : "";
  40 $our_ip = defined($ARGV[4]) ? $ARGV[4] : "";
  41
  42 $verbose = $opts{"v"};
  43 $private = $opts{"p"};
  44 if ($opts{"m"}) { $output = \&plain_output; }
  45 elsif ($opts{"h"}) { $output = \&html_output; }
  46 else { $output = \&fancy_output; }
  47
  48 # Initialize reliable resolver using our local nameserver.
  49
  50 $rres = new Net::DNS::Resolver;
  51 $rres->defnames(0);
  52 $rres->dnsrch(0);
  53 $rres->debug(0);
  54 # FIXME: Net::DNS doesn't implement persistent vc's yet
  55 #$rres->usevc(1);
  56 #$rres->stayopen(1);
  57
  58 # And do the checks...
  59
  60 info("Starting zone checks for $domain");
  61 $err_cnt = 0;
  62 $warn_cnt = 0;
  63 if ($mode_submit) {
  64         check_zone_name();
  65         check_submit();
  66         check_ns_sanity();
  67         check_zone() || msg("noserv", "No zone data available, giving up");
  68 } else {
  69         check_zone_name();
  70         check_zone_basics();
  71         $global_okay = 0;
  72         foreach my $nsvr (@check_servers) {
  73                 $nsvr =~ /(.*) = (.*)/;
  74                 $check_ns = $1;
  75                 $check_ns_ip = $2;
  76                 info("Decided to use $check_ns ($check_ns_ip) for zone check");
  77                 init_resolver($check_ns_ip);
  78                 check_ns_sanity();
  79                 if (check_zone()) {
  80                         $global_okay = 1;
  81                         last;
  82                 }
  83         }
  84         $global_okay || msg("noserv", "No name server available for checking");
  85 }
  86 info("Summary: $err_cnt errors, $warn_cnt warnings");
  87
  88 exit ($err_cnt > 0);
  89
  90 # Output of messages
  91
  92 sub plain_output {
  93         my $type = shift @_;
  94         my $msg = shift @_;
  95         my $ref = shift @_;
  96         $ref = (defined $ref) ? " [RFC$ref]" : "";
  97         print "$type $msg$ref\n";
  98 }
  99
 100 sub fancy_output {
 101         my $type = shift @_;
 102         my $msg = shift @_;
 103         my $ref = shift @_;
 104         my $mmsg;
 105         my %msg_types = %{{     'W' => '### Warning: ',
 106                                 'E' => '### Error: ',
 107                                 'F' => '### Fatal error: ',
 108                                 '>' => '        ',
 109                                 '*' => '        -> ',
 110                                 '.' => ''
 111                         }};
 112         $mmsg = $msg_types{$type};
 113         $ref = (defined $ref) ? " [RFC$ref]" : "";
 114         print "$mmsg$msg$ref\n";
 115 }
 116
 117 sub html_output {
 118         my $type = shift @_;
 119         my $msg = shift @_;
 120         my $ref = shift @_;
 121         if ($type =~ /[>*]/) {
 122                 if (!$is_pre) { print "<PRE>"; $is_pre=1; }
 123                 print "    ", ($type eq ">") ? "" : "-> ", $msg;
 124         } else {
 125                 if (!defined $is_pre) { print "<P>"; $is_pre=0; }
 126                 elsif ($is_pre) { print "</PRE>"; $is_pre=0; }
 127                 else { print "<BR>"; }
 128                 if ($type =~ /[WEF]/) {
 129                         my $map = {'W'=>'Warning', 'E'=>'Error', 'F'=>'Fatal error'};
 130                         print "<em class=msg$type>### ", ${$map}{$type}, ": $msg", "</em>";
 131                 } elsif ($type eq "." && $msg =~ /^Summary: /) {
 132                         if ($msg !~ / 0 errors,/) { $msg =~ s/ (\d+) errors,/ <em class=msgE>$1 errors,<\/em>/; }
 133                         if ($msg !~ / 0 warnings/) { $msg =~ s/ (\d+) warnings/ <em class=msgW>$1 warnings<\/em>/; }
 134                         print $msg;
 135                 } else { print $msg; }
 136                 if (defined $ref) {
 137                         my $comma = 0;
 138                         print "&nbsp;&nbsp;[see";
 139                         foreach my $z (split(/,\s*/, $ref)) {
 140                                 my ($rfc, $url);
 141                                 $comma++ && print ",";
 142                                 if ($z =~ /(\d+)\/(.*)/) {
 143                                         $rfc = "$1:$2";
 144                                         $url = eval $rfc_sec_url;
 145                                 } elsif ($z =~ /(\d+)/) {
 146                                         $rfc = "$1";
 147                                         $url = eval $rfc_url;
 148                                 } else { die "Bad RFC reference"; }
 149                                 print " <A HREF=\"$url\">RFC$rfc</A>";
 150                         }
 151                         print " for details]";
 152                 }
 153         }
 154         print "\n";
 155 }
 156
 157 sub msg {
 158         my ($id, $msg, $ref) = @_;
 159         defined $sev{$id} or die "Internal error: unknown message code <$id>";
 160         my $type = $sev{$id};
 161         return if $type eq "";
 162         if (!$verbose) {
 163                 if ($type =~ /[.>]/) { @msg_buffer = (); }
 164                 elsif ($type =~ /[EWF]/ && @msg_buffer) {
 165                         foreach my $m (@msg_buffer) { &{$output}('*', $m); }
 166                         @msg_buffer = ();
 167                 } elsif ($type eq '*') { push @msg_buffer, $msg; return; }
 168         }
 169         &{$output}($type, $msg, $ref);
 170         if ($type eq "E") { $err_cnt++; }
 171         elsif ($type eq "W") { $warn_cnt++; }
 172         elsif ($type eq "F") { exit 1; }
 173 }
 174
 175 sub info { msg('.', shift @_); }
 176 sub rr_echo { my $rr=shift @_; msg('*', $rr->string); }
 177
 178 # Our interface to the resolver
 179
 180 sub try_resolve {
 181         my $rver = shift @_;
 182         my $name = shift @_;
 183         my $type = shift @_;
 184         my $need_aa = shift @_;
 185         my $q = $rver->send($name, $type, "IN") or do {
 186                 msg("reserr", $res->errorstring);
 187                 return undef;
 188         };
 189         my $hdr = $q->header;
 190         $hdr->tc && msg("dnserr", "Truncated response received");
 191         my $rc = $hdr->rcode;
 192         $rc eq "NXDOMAIN" and return undef;
 193         $rc eq "NOERROR" or do { msg("reserr", "Unable to resolve $name: $rc"); return undef; };
 194         $hdr->ancount || return undef;
 195         !$need_aa || $hdr->aa || msg("needaa", "Answer is not authoritative");
 196         return $q;
 197 }
 198
 199 sub resolve {
 200         my $name = shift @_;
 201         my $type = shift @_;
 202         my $allow_cnames = shift @_;
 203         my $check_rev = shift @_;
 204         my $need_aa = shift @_;
 205         my @answer;
 206         check_name($name) || return ();
 207         if ($cache{$name}{$type}) {
 208                 @answer = @{$cache{$name}{$type}};
 209         } else {
 210                 my $q = try_resolve($res, $name, $type, $need_aa);
 211                 $q || return ();
 212                 @answer = $q->answer;
 213                 $cache{$name}{$type} = \@answer;
 214         }
 215         my @result = ();
 216         my $cname_cnt = 0;
 217         foreach my $r (@answer) {
 218                 rr_echo($r);
 219                 $r->class ne "IN" and next;
 220                 if ($r->type eq "A") {
 221                         # If it's an A record, automatically check it maps back.
 222                         $check_rev && check_reverse($r->name, $r->address, "");
 223                 }
 224                 if ($r->type eq "CNAME") {
 225                         if (!$allow_cnames) { msg("pcname", "DNS records must not point to CNAMEs", "1034/3.6, 1912/2.4, 2181/10.2-3"); }
 226                         if ($cname_cnt) { msg("rcname", "CNAMEs must not point to CNAMEs", "1034/3.6, 1912/2.4, 2181/10.2-3"); }
 227                         $cname_cnt++;
 228                 }
 229                 if ($r->type eq $type || $type eq "ANY") {
 230                         # We shouldn't check minimum TTL here as we might have got a cached value
 231                         ($r->ttl > 4*7*86400) && msg("suspttl", "Suspicious TTL value");
 232                         push @result, $r;
 233                 } elsif ($r->type ne "CNAME") {
 234                         msg("unxtype", "Expected $type, got " . $r->type);
 235                 }
 236         }
 237         return @result;
 238 }
 239
 240 # Normalization and comparison of host names and IP addresses
 241
 242 sub same_ipa {
 243         my $x = shift @_;
 244         my $y = shift @_;
 245         return $x eq $y;
 246 }
 247
 248 sub norm_name {
 249         my $n = shift @_;
 250         $n =~ s/\.$//;
 251         $n =~ tr[A-Z][a-z];
 252         return $n;
 253 }
 254
 255 sub same_name {
 256         my $x = shift @_;
 257         my $y = shift @_;
 258         return norm_name($x) eq norm_name($y);
 259 }
 260
 261 # Checks of reverse mapping
 262
 263 sub reverse_name {
 264         my $addr = shift @_;
 265         $addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or fatal("Unable to parse IP address $addr");
 266         return "$4.$3.$2.$1.in-addr.arpa.";
 267 }
 268
 269 sub check_reverse {
 270         my $name = shift @_;
 271         my $addr = shift @_;
 272         my $allow_domain = shift @_;
 273         my $rn = reverse_name($addr);
 274         my $maps_back = "";
 275         my $found_exact = 0;
 276         my $warned = 0;
 277         $did_reverse_check{$addr} && return;
 278         $did_reverse_check{$addr} = 1;
 279         ($addr =~ /^(192\.168|10|172\.(1[6-9]|2\d|3[01]))\./) && !$private &&
 280                 msg("privadr", "Private addresses shouldn't occur in public zones", "1918");
 281         foreach my $q (resolve("$rn", "PTR", 1, 0)) {
 282                 my $dname = $q->ptrdname;
 283                 if (same_name($dname, $name)) { $found_exact++; }
 284                 else {
 285                         my $matched = 0;
 286                         foreach my $a (resolve("$dname", "A", 1, 0)) {
 287                                 same_ipa($a->address, $addr) && ($matched = 1);
 288                         }
 289                         if (!$matched) {
 290                                 $warned = 1;
 291                                 msg("badrev", "$name maps to $dname which doesn't point back", "1912/2.1");
 292                         }
 293                         $maps_back = $dname;
 294                 }
 295         }
 296         if (!$found_exact) {
 297                 if ($maps_back eq "") { msg("norev", "$name ($addr) has no reverse record", "1912/2.1"); }
 298                 elsif ($name ne $allow_domain && !$warned) {
 299                         msg("inexrev", "$addr for $name points back to $maps_back", "1912/2.1");
 300                 }
 301         }
 302 }
 303
 304 # Check of e-mail address
 305
 306 sub check_email {
 307         my $e = shift @_;
 308         $e =~ /@/ && do { msg("soamail", "'\@' in e-mail addresses should be encoded as '.'", "1912/2.2"); return; };
 309         $e =~ /^(([^.\\]|\\.)+)\.(.*)$/ || do { msg("soamail", "Invalid e-mail address syntax"); return; };
 310         my $user = $1;
 311         my $host = norm_name($3);
 312         $user =~ s/\\(.)/$1/g;
 313         $e = "$user\@$host";
 314         # Don't touch! This string is exactly matched by check.cgi!
 315         info("Hostmaster e-mail address is $e");
 316         if (my @mx = resolve($host, "MX", 1, 0)) {
 317                 foreach my $r (@mx) {
 318                         resolve($r->exchange, "A", 0, 1) or msg("soammxa", "No A record for MX " . $r->exchange);
 319                 }
 320         } elsif (resolve($host, "A", 1, 0)) {
 321                 msg("soaamx", "MX records should be used for mail routing");
 322         } else {
 323                 msg("soammx", "No MX record for $host");
 324         }
 325 }
 326
 327 # Check of name syntax
 328
 329 sub check_name {
 330         my $n = shift @_;
 331         $n =~ s/\.$//;
 332         if ($n !~ /[^0-9.]/) {
 333                 if ($n =~ /^(\d+\.){3}\d+$/) { msg("ipaname", "IP address found instead of name", "1912/2.1"); }
 334                 else { msg("alldig", "All-digit names are not allowed", "1912/2.1"); }
 335                 return 0;
 336         }
 337         if ($n =~ /^(.*)\.in-addr\.arpa$/i) {
 338                 my $m = $1;
 339                 if ($m !~ /^(\d+-\d+|\d+)(\/\d+)?(\.(\d+-\d+|\d+)(\/\d+)?)*$/) {
 340                         msg("badrn", "Invalid name of reverse domain $n", "1035/3.5"); return 0;
 341                 } elsif ($m =~ /(^|\.|-|\/)0[0-9]/) {
 342                         msg("badrn", "Reverse names should not contain leading zeros", "1035/3.5"); return 0;
 343                 }
 344         }
 345         $n =~ s/^\*\.//;
 346         foreach my $q (split(/\./, $n)) {
 347                 if ($q eq "") {
 348                         msg("badname", "Name $n has empty components", "1912/2.1"); return 0;
 349                 } elsif ($q !~ /^[0-9a-zA-Z_-]*$/) {
 350                         msg("badname", "Name $n contains invalid characters", "1912/2.1"); return 0;
 351                 }
 352         }
 353         return 1;
 354 }
 355
 356 # Generic checks of nameserver configuration
 357
 358 sub check_ns_sanity {
 359         # Check whether the nameserver is able to resolve its own address forth and back.
 360
 361         info("Checking whether $check_ns knows an A record for its own name");
 362         my $ns_a = 0;
 363         foreach $r (resolve($check_ns, "A", 0, 0)) {
 364                 if (same_ipa($check_ns_ip, $r->address)) { $ns_a++; }
 365         }
 366         $ns_a || msg("selfa", "no matching A record found");
 367
 368         info("Checking whether $check_ns is able to reverse-map its own IP address");
 369         check_reverse($check_ns, $check_ns_ip, "");
 370
 371         # General nameserver functionality checks
 372
 373         if (!$private) {
 374                 info("Checking connectivity with other nameservers");
 375                 foreach $name (@test_hosts) {
 376                         resolve($name, "A", 1, 1) or
 377                                 msg("recchk", "$check_ns is unable to resolve $name (maybe it's non-recursive)");
 378                 }
 379         }
 380
 381         info("Checking mapping of localhost");
 382         $res->recurse(0);
 383         if (@lh = resolve("localhost", "A", 1, 0, 1)) {
 384                 (@lh != 1 || !same_ipa($lh[0]->address, "127.0.0.1")) &&
 385                         msg("badloc", "Invalid resource records for localhost at $check_ns", "1912/4.1");
 386         } else { msg("nolocal", "$check_ns is unable to resolve localhost", "1912/4.1"); }
 387         resolve("1.0.0.127.in-addr.arpa", "PTR", 1, 0, 1) or msg("revloc", "Reverse mapping of 127.0.0.1 at $check_ns doesn't work", "1912/4.1");
 388         $res->recurse(1);
 389 }
 390
 391 # Zone name checks
 392
 393 sub check_zone_name {
 394         info("Checking zone name");
 395         check_name($domain);
 396         if ($domain =~ /^(.*)\.in-addr\.arpa$/) {
 397                 my $rev = $1;
 398                 if ($rev =~ /(^|\.)(\d+(\.\d+){2})$/) {
 399                         $rev_net = join('.', reverse split (/\./, $2)) . '.';
 400                         info("Switched to reverse zone check mode for network $rev_net");
 401                 } else {
 402                         msg("unkrevz", "Switched to reverse mode, but unable to find network number in zone name", "1035/3.5");
 403                 }
 404                 $reverse = 1;
 405         }
 406 }
 407
 408 # Checks done for zone submission
 409
 410 sub check_submit {
 411         # Test for bogus and forbidden names
 412
 413         ($domain =~ /(^|\.)([^.]+)\.([^.]+)$/) || msg("rtoplev", "Registration of top-level domains not supported");
 414         $l2 = $2;
 415         $l1 = $3;
 416         try_resolve($rres, $l1, "SOA") || msg("utoplev", "Top level domain $l1 doesn't exist");
 417         if (length($l2) <= 4 && ($q = try_resolve($rres, $l2, "SOA"))) {
 418                 rr_echo($q->answer);
 419                 msg("xtoplev", "Second-level domains must not use names of top-level domains");
 420         }
 421
 422         # Test whether our NS is not already authoritative.
 423
 424         info("Checking for zone duplicity for $domain");
 425         init_resolver($our_ip);
 426         $res->recurse(0);
 427         $q = try_resolve($res, $domain, "SOA");
 428         ($q && $q->header->aa) && msg("alknown", "$domain already known at $our_name");
 429
 430         # Test whether the NS is authoritative for the zone.
 431
 432         init_resolver($check_ns_ip);
 433         info("Checking for authoritative data for $domain");
 434         $res->recurse(0);
 435         $q = try_resolve($res, $domain, "SOA");
 436         $q || msg("snauth", "SOA record for $domain not found");
 437         $q->header->aa || msg("snauth", "$check_ns is not authoritative for $domain");
 438         $res->recurse(1);
 439
 440         # Check number of name servers and whether we are one of them.
 441
 442         info("Checking list of nameservers");
 443         @q = resolve($domain, "NS", 0, 1) or msg("missns", "No NS records for $domain found");
 444         @q >= 2 || msg("twons", "Each domain should have at least 2 nameservers", "1912/2.8");
 445         if (defined($our_name)) {
 446                 $found_us = 0;
 447                 foreach $r (@q) {
 448                         same_name($r->nsdname, $our_name) && ($found_us = 1);
 449                 }
 450                 $found_us || msg("nosecns", "$our_name is not listed in NS records of $domain");
 451         }
 452 }
 453
 454 # Zone transfer and check
 455
 456 sub check_zone {
 457
 458 info("Fetching zone data for $domain");
 459 if (!(@zone = $res->axfr($domain))) {
 460         msg("axfer", "Zone transfer failed");
 461         return 0;
 462 }
 463
 464 info("Parsing zone data");
 465 $rcnt=0;
 466 foreach $r (@zone) {
 467         $records{norm_name($r->name)}{$rcnt++} = $r;
 468 }
 469
 470 info("Checking consistency of zone records");
 471 $seen_localhost = 0;
 472
 473 foreach $name (sort { ($a eq $domain) ? -1 : ($b eq $domain) ? 1 : ($a cmp $b) } keys %records) {
 474         $seen_cname = 0;
 475         $seen_other = 0;
 476         foreach $z (keys %{$records{$name}}) {
 477                 $r = $records{$name}{$z};
 478                 my $txt = $r->string;
 479                 msg(">", $txt);
 480                 defined $seen{$txt} && msg("duprec", "Duplicate record");
 481                 $seen{$txt} = 1;
 482                 check_name($name);
 483                 ($r->ttl < 3600 || $r->ttl > 4*7*86400) && msg("suspttl", "Suspicious TTL value");
 484                 $t = $r->type;
 485                 $name =~ /(^|\.)$domain$/ || msg("outzone", "Out-of-zone record");
 486                 if ($name =~ /\*/) {
 487                         if ($t eq "SRV") {
 488                                 # Wildcard SRV's are a useful thing
 489                         } elsif ($t eq "A" || $t eq "CNAME") {
 490                                 msg("wildac", "Wildcard A and CNAME records are likely to be very confusing", "1912/2.7");
 491                         } else {
 492                                 msg("wild", "Wildcard names are generally considered bad practice", "1912/2.7");
 493                         }
 494                 }
 495                 if ($reverse) {
 496                         ($name =~ /^(0|[1-9]\d*)\.$domain$/ && ($num = $1) < 256) ||
 497                                 ($name eq $domain && $t ne "CNAME" && $t ne "PTR") ||
 498                                 msg("badrevn", "Reverse zones should contain only numeric names");
 499                         if ($t =~ /^(MX|WKS)$/) {
 500                                 msg("badrevr", "Illegal record in reverse zone");
 501                         } elsif ($t eq "A") {
 502                                 msg("arev", "A records in reverse zones are valid, but considered bad practice", "1912/2.3");
 503                         }
 504                 } else {
 505                         if ($t eq "PTR") {
 506                                 msg("ptrfwd", "PTR records in forward zones are valid, but considered bad practice");
 507                         }
 508                 }
 509                 if ($t eq "CNAME") {
 510                         $seen_cname++;
 511                         $d = norm_name($r->cname);
 512                         # a.b.c -> a.b.c is wrong
 513                         if (same_name($d, $name)) { msg("reccn", "Recursive CNAME", "1034/3.6"); }
 514                         else {
 515                                 # a.b.c -> x.a.b.c and a.b.c -> b.c are probably wrong as well, but not forbidden
 516                                 if ($name =~ /(^|\.)$d/i || $d =~ /(^|\.)$name/) {
 517                                         msg("suspcn", "Possibly incorrect overlapping CNAME");
 518                                 }
 519                                 if (!resolve($d, "ANY", 0, 1)) {
 520                                         if ($reverse) {
 521                                                 msg("dangcnr", "Unable to resolve CNAME destination (probably due to classless delegation)");
 522                                         } else { msg("dangcn", "Unable to resolve CNAME destination"); }
 523                                 }
 524                         }
 525                 } else { $seen_other++; }
 526                 if (same_name($name, "localhost.$domain")) {
 527                         if ($t eq "A" && same_ipa($r->address, "127.0.0.1")) { $seen_localhost++; next; }
 528                         else { msg("badloc", "Invalid localhost record"); }
 529                 }
 530                 if ($t eq "A") {
 531                         check_reverse($name, $r->address, $domain);
 532                 } elsif ($t eq "NS") {
 533                         $dest = $r->nsdname;
 534                         resolve($dest, "A", 0, 1) || msg("missa", "Nameserver $dest doesn't have any valid A records");
 535                 } elsif ($t =~ /^(MD|MF|MB|MG|MR)$/) {
 536                         msg("obsrec", "MD/MF/MB/MG/MR records are obsolete and should not be used");
 537                 } elsif ($t eq "SOA") {
 538                         (same_name($name, $domain)) || do {
 539                                 msg("supsoa", "Superfluous SOA record");
 540                                 next;
 541                         };
 542                         resolve($r->mname, "A", 0, 1) || msg("soaorg", "No A record for zone origin");
 543                         check_email($r->rname);
 544                         ($r->expire < 2*7*86400 || $r->expire > 4*7*86400) &&
 545                                 msg("suspexp", "Expire time should be between 2 and 4 weeks", "1912/2.2");
 546                         ($r->minimum < 3600) && msg("suspmtl", "Suspicious minimum TTL", "2308/4");
 547                 } elsif ($t eq "WKS") {
 548                         msg("wks", "WKS record is obsolete and should not be used", "1912/2.6.1");
 549                 } elsif ($t eq "PTR") {
 550                         if (@dd = resolve($r->ptrdname, "A", 0, 0)) {
 551                                 if (defined $rev_net) {
 552                                         $found = 0;
 553                                         foreach $rr (@dd) {
 554                                                 (same_ipa($rr->address, $rev_net . $num)) && ($found=1);
 555                                         }
 556                                         $found || msg("ptrbada", "No corresponding A record found", "1912/2.4");
 557                                 }
 558                         } else { msg("ptrnoa", "PTR doesn't point to an A record", "1912/2.4"); }
 559                 } elsif ($t eq "MX") {
 560                         ($r->preference >= 0 && $r->preference < 65536) || msg("mxpref", "Invalid MX preference", "1035/3.3.9");
 561                         $dest = $r->exchange;
 562                         resolve($dest, "A", 0, 1) || msg("missa", "Mail exchanger $dest doesn't have any valid A records", "1035/3.3.9");
 563                 } elsif ($t eq "SRV") {
 564                         ($name =~ /^(\*|_[0-9a-zA-Z]+)\.(\*|_[a-zA-Z]+)\./) || msg("srvnam", "Invalid service name", "2782");
 565                         ($r->priority >= 0 && $r->priority < 65536) || msg("srvpar", "Invalid SRV preference", "2782");
 566                         ($r->weight >= 0 && $r->weight < 65536) || msg("srvpar", "Invalid SRV weight", "2872");
 567                         ($r->port >= 0 && $r->port < 65536) || msg("srvpar", "Invalid SRV port number", "2872");
 568                         $r->target eq "" || $r->target eq "." || resolve($r->target, "A", 0, 1) ||
 569                                 msg("srvdest", "Service provider has no valid A record");
 570                 }
 571         }
 572         if ($seen_cname > 1) {
 573                 msg("cnclash", "Multiple CNAMEs for one name", "1912/2.4");
 574         } elsif ($seen_cname && $seen_other) {
 575                 msg("cnclash", "CNAME is not allowed to coexist with any other data", "1912/2.4");
 576         }
 577 }
 578 return 1;
 579 }
 580
 581 # Initialize resolver library, but point it to the nameserver given
 582
 583 sub init_resolver {
 584         my $name = shift @_;
 585         $res = new Net::DNS::Resolver;
 586         $res->nameservers($name);
 587         $res->recurse(1);
 588         $res->defnames(0);
 589         $res->dnsrch(0);
 590         $res->debug(0);
 591         # FIXME: Net::DNS doesn't implement persistent vc's yet
 592         #$res->usevc(1);
 593         #$res->stayopen(1);
 594 }
 595
 596 # Basic zone checks -- existence, matching SOA versions and lame delegations
 597 # returns @check_servers
 598
 599 sub check_zone_basics {
 600         my $prefer_origin;
 601
 602         # In case check_ns is given, use it for initial checks, else use our local nameserver
 603         if ($check_ns ne "") {
 604                 if ($check_ns_ip eq "") {
 605                         info("Resolving name-server address");
 606                         $res = $rres;
 607                         my @ips = resolve($check_ns, "A", 0, 0) or msg("nonsa", "$check_ns has no A record");
 608                         $check_ns_ip = $ips[0]->address;
 609                 }
 610                 $prefer_origin = $check_ns;
 611                 @check_servers = ( "$check_ns = $check_ns_ip" );
 612                 init_resolver($check_ns_ip);
 613                 $rres = $res;   # This one will be the reference
 614         } else {
 615                 $res = $rres;
 616                 @check_servers = ();
 617         }
 618
 619         info("Checking existence of zone");
 620         resolve($domain, "CNAME", 1, 0) && msg("zcname", "$domain is a CNAME");
 621         my @soa = resolve($domain, "SOA", 0, 0) or msg("znexist", "$domain doesn't exist");
 622         my $real_origin = norm_name($soa[0]->mname);
 623         defined $prefer_origin || ($prefer_origin = $real_origin);
 624
 625         info("Checking NS records");
 626         my @ns = resolve($domain, "NS", 0, 0) or msg("missns", "$domain has no NS records");
 627         (@ns >= 2) || msg("twons", "Each domain should have at least 2 nameservers", "1912/2.8");
 628         @ns = map { norm_name($_->nsdname) } @ns;
 629         my $nsnames = join(':', sort { $a cmp $b } @ns);
 630         my %nshash;
 631         foreach $r (@ns) { $nshash{$r} = 1; }
 632         if (!defined $nshash{$real_origin}) { msg("ornotns", "Origin server $real_origin not listed in NS records"); }
 633         delete $nshash{$prefer_origin};
 634         @ns = keys %nshash;
 635         unshift @ns, $prefer_origin;
 636
 637         info("Checking nameserver authority and synchronization");
 638         my $psoa;
 639         foreach $n (@ns) {
 640                 my @nips;
 641                 $res = $rres;
 642                 if (!(@nips = resolve($n, "A", 0, 1))) {
 643                         msg("missa", "Nameserver $n doesn't have any valid A records");
 644                         next;
 645                 }
 646                 my $nip = $nips[0]->address;
 647                 info("Probing name server $n ($nip)");
 648                 init_resolver($nip);
 649                 $res->recurse(0);
 650                 my $q = try_resolve($res, $domain, "SOA");
 651                 $res->recurse(1);
 652                 $q && $q->header->aa || do { msg("lamer", "Lame delegation of $domain to $n", "1912/2.8"); next; };
 653                 my @ss = resolve($domain, "SOA", 0, 0);
 654                 if (!@ss) { msg("lamer", "Lame delegation of $domain to $n", "1912/2.8"); next; }
 655                 my $ss = $ss[0];
 656
 657                 if ($check_ns eq "") { push @check_servers, "$n = $nip"; }
 658                 if (defined $psoa) {
 659                         my $delta = $psoa->serial - $ss->serial;
 660                         ($delta >= 0x80000000) && ($delta -= 0x80000000);
 661                         ($delta <= -0x80000000) && ($delta += 0x80000000);
 662                         if ($delta > 0) { msg("oodsec", "$n has out of date data for $domain"); }
 663                         elsif ($delta < 0) { msg("oodsec", "$n has newer data for $domain than zone origin"); }
 664                         if ($psoa->mname ne $ss->mname ||
 665                             $psoa->rname ne $ss->rname ||
 666                             $psoa->refresh != $ss->refresh ||
 667                             $psoa->retry != $ss->retry ||
 668                             $psoa->expire != $ss->expire ||
 669                             $psoa->minimum != $ss->minimum) {
 670                                 msg("oodsoa", "$n lists different SOA parameters than zone origin");
 671                         }
 672                 } else { $psoa = $ss; }
 673
 674                 my $nsb = join(':', sort { $a cmp $b } map { $_->nsdname } resolve($domain, "NS", 0, 0));
 675                 same_name($nsnames,$nsb) || msg("diffns", "Different set of NS records reported ($nsb)");
 676         }
 677         # info("Continuing zone checks on " . join("/", @check_servers));
 678 }