#!/usr/bin/perl -w
#
#	Sleuth -- A Simple DNS Checking Tool
#
#	(c) 1999--2001 Martin Mares <mj@ucw.cz>
#

# Load configuration file and all modules we need

BEGIN {
	if (-f "/etc/sleuth.conf") {
		require "/etc/sleuth.conf";
	} else {
		require __FILE__ . ".conf";
	}
}

use Getopt::Std;
use Net::DNS::Resolver;

# Parse arguments

getopts('vmhp', \%opts) && (@ARGV >= 1 && @ARGV <= 3 || @ARGV == 5) || do {
	print <<EOF
Usage: sleuth [-hmpv] <domain> [<server> [<server-IP> [<secondary> <secondary-ip>]]]

-h	Produce HTML output
-m	Produce machine-readable output
-p	Private network mode (avoid public accessibility checks)
-v	Be verbose
EOF
;
	exit 1;
};
$domain = norm_name($ARGV[0]);
$mode_submit = @ARGV == 5;
$check_ns = defined($ARGV[1]) ? norm_name($ARGV[1]) : "";
$check_ns_ip = defined($ARGV[2]) ? $ARGV[2] : "";
$our_name = defined($ARGV[3]) ? norm_name($ARGV[3]) : "";
$our_ip = defined($ARGV[4]) ? $ARGV[4] : "";

$verbose = $opts{"v"};
$private = $opts{"p"};
if ($opts{"m"}) { $output = \&plain_output; }
elsif ($opts{"h"}) { $output = \&html_output; }
else { $output = \&fancy_output; }

# Initialize reliable resolver using our local nameserver.

$rres = new Net::DNS::Resolver;
$rres->defnames(0);
$rres->dnsrch(0);
$rres->debug(0);
# FIXME: Net::DNS doesn't implement persistent vc's yet
#$rres->usevc(1);
#$rres->stayopen(1);

# And do the checks...

info("Starting zone checks for $domain");
$err_cnt = 0;
$warn_cnt = 0;
if ($mode_submit) {
	check_zone_name();
	check_submit();
	check_ns_sanity();
	check_zone() || msg("noserv", "No zone data available, giving up");
} else {
	check_zone_name();
	check_zone_basics();
	$global_okay = 0;
	foreach my $nsvr (@check_servers) {
		$nsvr =~ /(.*) = (.*)/;
		$check_ns = $1;
		$check_ns_ip = $2;
		info("Decided to use $check_ns ($check_ns_ip) for zone check");
		init_resolver($check_ns_ip);
		check_ns_sanity();
		if (check_zone()) {
			$global_okay = 1;
			last;
		}
	}
	$global_okay || msg("noserv", "No name server available for checking");
}
info("Summary: $err_cnt errors, $warn_cnt warnings");

exit ($err_cnt > 0);

# Output of messages

sub plain_output {
	my $type = shift @_;
	my $msg = shift @_;
	my $ref = shift @_;
	$ref = (defined $ref) ? " [RFC$ref]" : "";
	print "$type $msg$ref\n";
}

sub fancy_output {
	my $type = shift @_;
	my $msg = shift @_;
	my $ref = shift @_;
	my $mmsg;
	my %msg_types = %{{	'W' => '### Warning: ',
				'E' => '### Error: ',
				'F' => '### Fatal error: ',
				'>' => '	',
				'*' => '	-> ',
				'.' => ''
			}};
	$mmsg = $msg_types{$type};
	$ref = (defined $ref) ? " [RFC$ref]" : "";
	print "$mmsg$msg$ref\n";
}

sub html_output {
	my $type = shift @_;
	my $msg = shift @_;
	my $ref = shift @_;
	if ($type =~ /[>*]/) {
		if (!$is_pre) { print "<PRE>"; $is_pre=1; }
		print "    ", ($type eq ">") ? "" : "-> ", $msg;
	} else {
		if (!defined $is_pre) { print "<P>"; $is_pre=0; }
		elsif ($is_pre) { print "</PRE>"; $is_pre=0; }
		else { print "<BR>"; }
		if ($type =~ /[WEF]/) {
			my $map = {'W'=>'Warning', 'E'=>'Error', 'F'=>'Fatal error'};
			print "<em class=msg$type>### ", ${$map}{$type}, ": $msg", "</em>";
		} elsif ($type eq "." && $msg =~ /^Summary: /) {
			if ($msg !~ / 0 errors,/) { $msg =~ s/ (\d+) errors,/ <em class=msgE>$1 errors,<\/em>/; }
			if ($msg !~ / 0 warnings/) { $msg =~ s/ (\d+) warnings/ <em class=msgW>$1 warnings<\/em>/; }
			print $msg;
		} else { print $msg; }
		if (defined $ref) {
			my $comma = 0;
			print "&nbsp;&nbsp;[see";
			foreach my $z (split(/,\s*/, $ref)) {
				my ($rfc, $url);
				$comma++ && print ",";
				if ($z =~ /(\d+)\/(.*)/) {
					$rfc = "$1:$2";
					$url = eval $rfc_sec_url;
				} elsif ($z =~ /(\d+)/) {
					$rfc = "$1";
					$url = eval $rfc_url;
				} else { die "Bad RFC reference"; }
				print " <A HREF=\"$url\">RFC$rfc</A>";
			}
			print " for details]";
		}
	}
	print "\n";
}

sub msg {
	my ($id, $msg, $ref) = @_;
	defined $sev{$id} or die "Internal error: unknown message code <$id>";
	my $type = $sev{$id};
	return if $type eq "";
	if (!$verbose) {
		if ($type =~ /[.>]/) { @msg_buffer = (); }
		elsif ($type =~ /[EWF]/ && @msg_buffer) {
			foreach my $m (@msg_buffer) { &{$output}('*', $m); }
			@msg_buffer = ();
		} elsif ($type eq '*') { push @msg_buffer, $msg; return; }
	}
	&{$output}($type, $msg, $ref);
	if ($type eq "E") { $err_cnt++; }
	elsif ($type eq "W") { $warn_cnt++; }
	elsif ($type eq "F") { exit 1; }
}

sub info { msg('.', shift @_); }
sub rr_echo { my $rr=shift @_; msg('*', $rr->string); }

# Our interface to the resolver

sub try_resolve {
	my $rver = shift @_;
	my $name = shift @_;
	my $type = shift @_;
	my $need_aa = shift @_;
	my $q = $rver->send($name, $type, "IN") or do {
		msg("reserr", $res->errorstring);
		return undef;
	};
	my $hdr = $q->header;
	$hdr->tc && msg("dnserr", "Truncated response received");
	my $rc = $hdr->rcode;
	$rc eq "NXDOMAIN" and return undef;
	$rc eq "NOERROR" or do { msg("reserr", "Unable to resolve $name: $rc"); return undef; };
	$hdr->ancount || return undef;
	!$need_aa || $hdr->aa || msg("needaa", "Answer is not authoritative");
	return $q;
}

sub resolve {
	my $name = shift @_;
	my $type = shift @_;
	my $allow_cnames = shift @_;
	my $check_rev = shift @_;
	my $need_aa = shift @_;
	my @answer;
	check_name($name) || return ();
	if ($cache{$name}{$type}) {
		@answer = @{$cache{$name}{$type}};
	} else {
		my $q = try_resolve($res, $name, $type, $need_aa);
		$q || return ();
		@answer = $q->answer;
		$cache{$name}{$type} = \@answer;
	}
	my @result = ();
	my $cname_cnt = 0;
	foreach my $r (@answer) {
		rr_echo($r);
		$r->class ne "IN" and next;
		if ($r->type eq "A") {
			# If it's an A record, automatically check it maps back.
			$check_rev && check_reverse($r->name, $r->address, "");
		}
		if ($r->type eq "CNAME") {
			if (!$allow_cnames) { msg("pcname", "DNS records must not point to CNAMEs", "1034/3.6, 1912/2.4, 2181/10.2-3"); }
			if ($cname_cnt) { msg("rcname", "CNAMEs must not point to CNAMEs", "1034/3.6, 1912/2.4, 2181/10.2-3"); }
			$cname_cnt++;
		}
		if ($r->type eq $type || $type eq "ANY") {
			# We shouldn't check minimum TTL here as we might have got a cached value
			($r->ttl > 4*7*86400) && msg("suspttl", "Suspicious TTL value");
			push @result, $r;
		} elsif ($r->type ne "CNAME") {
			msg("unxtype", "Expected $type, got " . $r->type);
		}
	}
	return @result;
}

# Normalization and comparison of host names and IP addresses

sub same_ipa {
	my $x = shift @_;
	my $y = shift @_;
	return $x eq $y;
}

sub norm_name {
	my $n = shift @_;
	$n =~ s/\.$//;
	$n =~ tr[A-Z][a-z];
	return $n;
}

sub same_name {
	my $x = shift @_;
	my $y = shift @_;
	return norm_name($x) eq norm_name($y);
}

# Checks of reverse mapping

sub reverse_name {
	my $addr = shift @_;
	$addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ or fatal("Unable to parse IP address $addr");
	return "$4.$3.$2.$1.in-addr.arpa.";
}

sub check_reverse {
	my $name = shift @_;
	my $addr = shift @_;
	my $allow_domain = shift @_;
	my $rn = reverse_name($addr);
	my $maps_back = "";
	my $found_exact = 0;
	my $warned = 0;
	$did_reverse_check{$addr} && return;
	$did_reverse_check{$addr} = 1;
	($addr =~ /^(192\.168|10|172\.(1[6-9]|2\d|3[01]))\./) && !$private &&
		msg("privadr", "Private addresses shouldn't occur in public zones", "1918");
	foreach my $q (resolve("$rn", "PTR", 1, 0)) {
		my $dname = $q->ptrdname;
		if (same_name($dname, $name)) { $found_exact++; }
		else {
			my $matched = 0;
			foreach my $a (resolve("$dname", "A", 1, 0)) {
				same_ipa($a->address, $addr) && ($matched = 1);
			}
			if (!$matched) {
				$warned = 1;
				msg("badrev", "$name maps to $dname which doesn't point back", "1912/2.1");
			}
			$maps_back = $dname;
		}
	}
	if (!$found_exact) {
		if ($maps_back eq "") { msg("norev", "$name ($addr) has no reverse record", "1912/2.1"); }
		elsif ($name ne $allow_domain && !$warned) {
			msg("inexrev", "$addr for $name points back to $maps_back", "1912/2.1");
		}
	}
}

# Check of e-mail address

sub check_email {
	my $e = shift @_;
	$e =~ /@/ && do { msg("soamail", "'\@' in e-mail addresses should be encoded as '.'", "1912/2.2"); return; };
	$e =~ /^(([^.\\]|\\.)+)\.(.*)$/ || do { msg("soamail", "Invalid e-mail address syntax"); return; };
	my $user = $1;
	my $host = norm_name($3);
	$user =~ s/\\(.)/$1/g;
	$e = "$user\@$host";
	# Don't touch! This string is exactly matched by check.cgi!
	info("Hostmaster e-mail address is $e");
	if (my @mx = resolve($host, "MX", 1, 0)) {
		foreach my $r (@mx) {
			resolve($r->exchange, "A", 0, 1) or msg("soammxa", "No A record for MX " . $r->exchange);
		}
	} elsif (resolve($host, "A", 1, 0)) {
		msg("soaamx", "MX records should be used for mail routing");
	} else {
		msg("soammx", "No MX record for $host");
	}
}

# Check of name syntax

sub check_name {
	my $n = shift @_;
	$n =~ s/\.$//;
	if ($n !~ /[^0-9.]/) {
		if ($n =~ /^(\d+\.){3}\d+$/) { msg("ipaname", "IP address found instead of name", "1912/2.1"); }
		else { msg("alldig", "All-digit names are not allowed", "1912/2.1"); }
		return 0;
	}
	if ($n =~ /^(.*)\.in-addr\.arpa$/i) {
		my $m = $1;
		if ($m !~ /^(\d+-\d+|\d+)(\/\d+)?(\.(\d+-\d+|\d+)(\/\d+)?)*$/) {
			msg("badrn", "Invalid name of reverse domain $n", "1035/3.5"); return 0;
		} elsif ($m =~ /(^|\.|-|\/)0[0-9]/) {
			msg("badrn", "Reverse names should not contain leading zeros", "1035/3.5"); return 0;
		}
	}
	$n =~ s/^\*\.//;
	foreach my $q (split(/\./, $n)) {
		if ($q eq "") {
			msg("badname", "Name $n has empty components", "1912/2.1"); return 0;
		} elsif ($q !~ /^[0-9a-zA-Z_-]*$/) {
			msg("badname", "Name $n contains invalid characters", "1912/2.1"); return 0;
		}
	}
	return 1;
}

# Generic checks of nameserver configuration

sub check_ns_sanity {
	# Check whether the nameserver is able to resolve its own address forth and back.

	info("Checking whether $check_ns knows an A record for its own name");
	my $ns_a = 0;
	foreach $r (resolve($check_ns, "A", 0, 0)) {
		if (same_ipa($check_ns_ip, $r->address)) { $ns_a++; }
	}
	$ns_a || msg("selfa", "no matching A record found");

	info("Checking whether $check_ns is able to reverse-map its own IP address");
	check_reverse($check_ns, $check_ns_ip, "");

	# General nameserver functionality checks

	if (!$private) {
		info("Checking connectivity with other nameservers");
		foreach $name (@test_hosts) {
			resolve($name, "A", 1, 1) or
				msg("recchk", "$check_ns is unable to resolve $name (maybe it's non-recursive)");
		}
	}

	info("Checking mapping of localhost");
	$res->recurse(0);
	if (@lh = resolve("localhost", "A", 1, 0, 1)) {
		(@lh != 1 || !same_ipa($lh[0]->address, "127.0.0.1")) &&
			msg("badloc", "Invalid resource records for localhost at $check_ns", "1912/4.1");
	} else { msg("nolocal", "$check_ns is unable to resolve localhost", "1912/4.1"); }
	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");
	$res->recurse(1);
}

# Zone name checks

sub check_zone_name {
	info("Checking zone name");
	check_name($domain);
	if ($domain =~ /^(.*)\.in-addr\.arpa$/) {
		my $rev = $1;
		if ($rev =~ /(^|\.)(\d+(\.\d+){2})$/) {
			$rev_net = join('.', reverse split (/\./, $2)) . '.';
			info("Switched to reverse zone check mode for network $rev_net");
		} else {
			msg("unkrevz", "Switched to reverse mode, but unable to find network number in zone name", "1035/3.5");
		}
		$reverse = 1;
	}
}

# Checks done for zone submission

sub check_submit {
	# Test for bogus and forbidden names

	($domain =~ /(^|\.)([^.]+)\.([^.]+)$/) || msg("rtoplev", "Registration of top-level domains not supported");
	$l2 = $2;
	$l1 = $3;
	try_resolve($rres, $l1, "SOA") || msg("utoplev", "Top level domain $l1 doesn't exist");
	if (length($l2) <= 4 && ($q = try_resolve($rres, $l2, "SOA"))) {
		rr_echo($q->answer);
		msg("xtoplev", "Second-level domains must not use names of top-level domains");
	}

	# Test whether our NS is not already authoritative.

	info("Checking for zone duplicity for $domain");
	init_resolver($our_ip);
	$res->recurse(0);
	$q = try_resolve($res, $domain, "SOA");
	($q && $q->header->aa) && msg("alknown", "$domain already known at $our_name");

	# Test whether the NS is authoritative for the zone.

	init_resolver($check_ns_ip);
	info("Checking for authoritative data for $domain");
	$res->recurse(0);
	$q = try_resolve($res, $domain, "SOA");
	$q || msg("snauth", "SOA record for $domain not found");
	$q->header->aa || msg("snauth", "$check_ns is not authoritative for $domain");
	$res->recurse(1);

	# Check number of name servers and whether we are one of them.

	info("Checking list of nameservers");
	@q = resolve($domain, "NS", 0, 1) or msg("missns", "No NS records for $domain found");
	@q >= 2 || msg("twons", "Each domain should have at least 2 nameservers", "1912/2.8");
	if (defined($our_name)) {
		$found_us = 0;
		foreach $r (@q) {
			same_name($r->nsdname, $our_name) && ($found_us = 1);
		}
		$found_us || msg("nosecns", "$our_name is not listed in NS records of $domain");
	}
}

# Zone transfer and check

sub check_zone {

info("Fetching zone data for $domain");
if (!(@zone = $res->axfr($domain))) {
	msg("axfer", "Zone transfer failed");
	return 0;
}

info("Parsing zone data");
$rcnt=0;
foreach $r (@zone) {
	$records{norm_name($r->name)}{$rcnt++} = $r;
}

info("Checking consistency of zone records");
$seen_localhost = 0;

foreach $name (sort { ($a eq $domain) ? -1 : ($b eq $domain) ? 1 : ($a cmp $b) } keys %records) {
	$seen_cname = 0;
	$seen_other = 0;
	foreach $z (keys %{$records{$name}}) {
		$r = $records{$name}{$z};
		my $txt = $r->string;
		msg(">", $txt);
		defined $seen{$txt} && msg("duprec", "Duplicate record");
		$seen{$txt} = 1;
		check_name($name);
		($r->ttl < 3600 || $r->ttl > 4*7*86400) && msg("suspttl", "Suspicious TTL value");
		$t = $r->type;
		$name =~ /(^|\.)$domain$/ || msg("outzone", "Out-of-zone record");
		if ($name =~ /\*/) {
			if ($t eq "SRV") {
				# Wildcard SRV's are a useful thing
			} elsif ($t eq "A" || $t eq "CNAME") {
				msg("wildac", "Wildcard A and CNAME records are likely to be very confusing", "1912/2.7");
			} else {
				msg("wild", "Wildcard names are generally considered bad practice", "1912/2.7");
			}
		}
		if ($reverse) {
			($name =~ /^(0|[1-9]\d*)\.$domain$/ && ($num = $1) < 256) ||
				($name eq $domain && $t ne "CNAME" && $t ne "PTR") ||
				msg("badrevn", "Reverse zones should contain only numeric names");
			if ($t =~ /^(MX|WKS)$/) {
				msg("badrevr", "Illegal record in reverse zone");
			} elsif ($t eq "A") {
				msg("arev", "A records in reverse zones are valid, but considered bad practice", "1912/2.3");
			}
		} else {
			if ($t eq "PTR") {
				msg("ptrfwd", "PTR records in forward zones are valid, but considered bad practice");
			}
		}
		if ($t eq "CNAME") {
			$seen_cname++;
			$d = norm_name($r->cname);
			# a.b.c -> a.b.c is wrong
			if (same_name($d, $name)) { msg("reccn", "Recursive CNAME", "1034/3.6"); }
			else {
				# a.b.c -> x.a.b.c and a.b.c -> b.c are probably wrong as well, but not forbidden
				if ($name =~ /(^|\.)$d/i || $d =~ /(^|\.)$name/) {
					msg("suspcn", "Possibly incorrect overlapping CNAME");
				}
				if (!resolve($d, "ANY", 0, 1)) {
					if ($reverse) {
						msg("dangcnr", "Unable to resolve CNAME destination (probably due to classless delegation)");
					} else { msg("dangcn", "Unable to resolve CNAME destination"); }
				}
			}
		} else { $seen_other++; }
		if (same_name($name, "localhost.$domain")) {
			if ($t eq "A" && same_ipa($r->address, "127.0.0.1")) { $seen_localhost++; next; }
			else { msg("badloc", "Invalid localhost record"); }
		}
		if ($t eq "A") {
			check_reverse($name, $r->address, $domain);
		} elsif ($t eq "NS") {
			$dest = $r->nsdname;
			resolve($dest, "A", 0, 1) || msg("missa", "Nameserver $dest doesn't have any valid A records");
		} elsif ($t =~ /^(MD|MF|MB|MG|MR)$/) {
			msg("obsrec", "MD/MF/MB/MG/MR records are obsolete and should not be used");
		} elsif ($t eq "SOA") {
			(same_name($name, $domain)) || do {
				msg("supsoa", "Superfluous SOA record");
				next;
			};
			resolve($r->mname, "A", 0, 1) || msg("soaorg", "No A record for zone origin");
			check_email($r->rname);
			($r->expire < 2*7*86400 || $r->expire > 4*7*86400) &&
				msg("suspexp", "Expire time should be between 2 and 4 weeks", "1912/2.2");
			($r->minimum < 3600) && msg("suspmtl", "Suspicious minimum TTL", "2308/4");
		} elsif ($t eq "WKS") {
			msg("wks", "WKS record is obsolete and should not be used", "1912/2.6.1");
		} elsif ($t eq "PTR") {
			if (@dd = resolve($r->ptrdname, "A", 0, 0)) {
				if (defined $rev_net) {
					$found = 0;
					foreach $rr (@dd) {
						(same_ipa($rr->address, $rev_net . $num)) && ($found=1);
					}
					$found || msg("ptrbada", "No corresponding A record found", "1912/2.4");
				}
			} else { msg("ptrnoa", "PTR doesn't point to an A record", "1912/2.4"); }
		} elsif ($t eq "MX") {
			($r->preference >= 0 && $r->preference < 65536) || msg("mxpref", "Invalid MX preference", "1035/3.3.9");
			$dest = $r->exchange;
			resolve($dest, "A", 0, 1) || msg("missa", "Mail exchanger $dest doesn't have any valid A records", "1035/3.3.9");
		} elsif ($t eq "SRV") {
			($name =~ /^(\*|_[0-9a-zA-Z]+)\.(\*|_[a-zA-Z]+)\./) || msg("srvnam", "Invalid service name", "2782");
			($r->priority >= 0 && $r->priority < 65536) || msg("srvpar", "Invalid SRV preference", "2782");
			($r->weight >= 0 && $r->weight < 65536) || msg("srvpar", "Invalid SRV weight", "2872");
			($r->port >= 0 && $r->port < 65536) || msg("srvpar", "Invalid SRV port number", "2872");
			$r->target eq "" || $r->target eq "." || resolve($r->target, "A", 0, 1) ||
				msg("srvdest", "Service provider has no valid A record");
		}
	}
	if ($seen_cname > 1) {
		msg("cnclash", "Multiple CNAMEs for one name", "1912/2.4");
	} elsif ($seen_cname && $seen_other) {
		msg("cnclash", "CNAME is not allowed to coexist with any other data", "1912/2.4");
	}
}
return 1;
}

# Initialize resolver library, but point it to the nameserver given

sub init_resolver {
	my $name = shift @_;
	$res = new Net::DNS::Resolver;
	$res->nameservers($name);
	$res->recurse(1);
	$res->defnames(0);
	$res->dnsrch(0);
	$res->debug(0);
	# FIXME: Net::DNS doesn't implement persistent vc's yet
	#$res->usevc(1);
	#$res->stayopen(1);
}

# Basic zone checks -- existence, matching SOA versions and lame delegations
# returns @check_servers

sub check_zone_basics {
	my $prefer_origin;

	# In case check_ns is given, use it for initial checks, else use our local nameserver
	if ($check_ns ne "") {
		if ($check_ns_ip eq "") {
			info("Resolving name-server address");
			$res = $rres;
			my @ips = resolve($check_ns, "A", 0, 0) or msg("nonsa", "$check_ns has no A record");
			$check_ns_ip = $ips[0]->address;
		}
		$prefer_origin = $check_ns;
		@check_servers = ( "$check_ns = $check_ns_ip" );
		init_resolver($check_ns_ip);
		$rres = $res;	# This one will be the reference
	} else {
		$res = $rres;
		@check_servers = ();
	}

	info("Checking existence of zone");
	resolve($domain, "CNAME", 1, 0) && msg("zcname", "$domain is a CNAME");
	my @soa = resolve($domain, "SOA", 0, 0) or msg("znexist", "$domain doesn't exist");
	my $real_origin = norm_name($soa[0]->mname);
	defined $prefer_origin || ($prefer_origin = $real_origin);

	info("Checking NS records");
	my @ns = resolve($domain, "NS", 0, 0) or msg("missns", "$domain has no NS records");
	(@ns >= 2) || msg("twons", "Each domain should have at least 2 nameservers", "1912/2.8");
	@ns = map { norm_name($_->nsdname) } @ns;
	my $nsnames = join(':', sort { $a cmp $b } @ns);
	my %nshash;
	foreach $r (@ns) { $nshash{$r} = 1; }
	if (!defined $nshash{$real_origin}) { msg("ornotns", "Origin server $real_origin not listed in NS records"); }
	delete $nshash{$prefer_origin};
	@ns = keys %nshash;
	unshift @ns, $prefer_origin;

	info("Checking nameserver authority and synchronization");
	my $psoa;
	foreach $n (@ns) {
		my @nips;
		$res = $rres;
		if (!(@nips = resolve($n, "A", 0, 1))) {
			msg("missa", "Nameserver $n doesn't have any valid A records");
			next;
		}
		my $nip = $nips[0]->address;
		info("Probing name server $n ($nip)");
		init_resolver($nip);
		$res->recurse(0);
		my $q = try_resolve($res, $domain, "SOA");
		$res->recurse(1);
		$q && $q->header->aa || do { msg("lamer", "Lame delegation of $domain to $n", "1912/2.8"); next; };
		my @ss = resolve($domain, "SOA", 0, 0);
		if (!@ss) { msg("lamer", "Lame delegation of $domain to $n", "1912/2.8"); next; }
		my $ss = $ss[0];

		if ($check_ns eq "") { push @check_servers, "$n = $nip"; }
		if (defined $psoa) {
			my $delta = $psoa->serial - $ss->serial;
			($delta >= 0x80000000) && ($delta -= 0x80000000);
			($delta <= -0x80000000) && ($delta += 0x80000000);
			if ($delta > 0) { msg("oodsec", "$n has out of date data for $domain"); }
			elsif ($delta < 0) { msg("oodsec", "$n has newer data for $domain than zone origin"); }
			if ($psoa->mname ne $ss->mname ||
			    $psoa->rname ne $ss->rname ||
			    $psoa->refresh != $ss->refresh ||
			    $psoa->retry != $ss->retry ||
			    $psoa->expire != $ss->expire ||
			    $psoa->minimum != $ss->minimum) {
				msg("oodsoa", "$n lists different SOA parameters than zone origin");
			}
		} else { $psoa = $ss; }

		my $nsb = join(':', sort { $a cmp $b } map { $_->nsdname } resolve($domain, "NS", 0, 0));
		same_name($nsnames,$nsb) || msg("diffns", "Different set of NS records reported ($nsb)");
	}
	# info("Continuing zone checks on " . join("/", @check_servers));
}