--- /dev/null
+2001-06-16 Martin Mares <mj@albireo.ucw.cz>
+
+ * sleuth (check_name): "IP address found instead of name" check
+ added to clarify most "all-digit name" error messages.
+
+ * sleuth (check_reverse): Corrected references to RFC 1912. Also fixed
+ the private address check and turned it to a warning.
+
+ * sleuth (check_zone): SRV records with empty destination and wildcard
+ SRV records are valid.
+
+ * sleuth (check_zone): Better checks for wildcard records, no more
+ false alarms.
+
+ * sleuth (resolve): Added authoritative answer checks (required
+ f.e. for localhost records).
+
+ * Released as version 1.3.
+
+2001-06-15 Martin Mares <mj@atrey.karlin.mff.cuni.cz>
+
+ * sleuth: Fixed a small bug in switching of nameservers.
+ Nameserver sanity check messages now indicate which nameserver
+ we're testing. Comparison of origin servers etc. is now really
+ case insensitive.
+
+2001-06-14 Martin Mares <mj@albireo.ucw.cz>
+
+ * check.cgi: Declare non-transitional DTD. We still use a couple
+ of transitional attributes (mostly align=center), but we don't
+ want the extra work-arounds Mozilla based browsers apply to
+ transitional documents.
+
+ * sleuth (html_output), check.cgi: Revamped all HTML output stuff.
+ Now we're using style sheets to add colors and most of the alignment.
+ Works wonderfully in Mozilla, relatively good in non-CSS browsers,
+ a bit funny in Netscape 4 due to its bugs.
+
+ * Released as version 1.2.
+
+2001-06-13 Martin Mares <mj@albireo.ucw.cz>
+
+ * check.cgi: Minor design changes.
+
+ * sleuth (check_zone): Changed checks for minimum TTL according to RFC 2308
+ which specifies minttl should be used to control negative caching.
+
+ * sleuth (check_zone): Check duplicate records.
+
+ * sleuth (check_zone): Dangling CNAME's in reverse zones produce only
+ warnings as they are usually an artifact of classless delegation schemes.
+
+ * sleuth (check_zone): Avoid `PTR -> A for same address' checks when
+ not in reverse check mode, but always check there is at least one A.
+
+ * sleuth (check_zone_name): Better parsing of reverse zone names,
+ give an error message if it fails.
+
+ * sleuth (check_zone): Added checks of SRV records.
+
+ * sleuth (check_zone): SOA: don't forget to resolve and check origin server.
+
+ * sleuth (check_name): Relaxed the name checking rules to allow underscores.
+ No standard currently seems to specify what is the exact syntax of a host
+ name (only RFC 1033, but it's categorized as informational, not as a standard).
+ Strictly speaking, we should do separate checks for host names, mail names,
+ domain names etc., but I'd like to avoid such extra complexity for now.
+
+ * sleuth (check_email): Warn about A records used instead of MX records.
+
+2001-06-12 Martin Mares <mj@albireo.ucw.cz>
+
+ * sleuth (check_zone_basics): Completely rewrote nameserver scans. All
+ nameservers mentioned in NS records plus the zone origin announced in
+ SOA are tried, the origin server is preferred. In case any of these
+ servers fails, the next one is tried automatically. If the user specifies
+ server name explicitly, do the basic checks for all nameservers, but
+ force use of the specified one for zone transfer and use it as the reference
+ name server. Also check differences between NS record sets reported by
+ all the servers.
+
+ * sleuth (check_submit): Moved all submit-dependent checks here. Better
+ checking of top-level domain names.
+
+ * sleuth (resolve): If the name requested is invalid, don't attempt
+ to resolve it.
+
+ * sleuth: Added a "-p" switch for scanning of private networks which avoids
+ private IP address checks and connectivity checks.
+
+ * sleuth (check_reverse): Report private IP addresses.
+
+ * sleuth: Try to avoid cascading of some kinds of errors, especially
+ those induced by bogus CNAME's.
+
+ * sleuth (check_zone): Wildcard A's and CNAME's are allowed, but strongly
+ deprecated. Tolerate PTR's in forward zones and A's in reverse zones, but
+ warn of them (they are permitted by RFC's, but this behaviour is very
+ obscure and it should be avoided) and check them anyway.
+
+ * sleuth (check_reverse): Rewrote the reverse mapping checks. Removed the
+ "$recursive_check" machinery, it was unnecessary. Report all mispointed
+ PTR's. Tolerate PTR's to a different name, but warn on them. Don't check
+ reverse mapping of any IP address twice.
+
+ * sleuth (check_zone): Better checks for recursive and overlapping CNAME's.
+
+ * sleuth (check_email): Check all MX'es, not only the best one.
+
+ * sleuth (check_zone): Fixed expire time checks, now 2..4 weeks as per RFC.
+
+ * sleuth (check_name): Allow prefix sizes in reverse zones. Replaced the
+ "all-digit name component" check by "all-digit name".
+
+ * sleuth: Load a configuration file sleuth.conf upon startup. Moved all
+ the hard-wired parameters there.
+
+ * sleuth: Made severity of all messages configurable.
+
+2000-10-29 Martin Mares <mj@albireo.ucw.cz>
+
+ * sleuth (resolve): Changed 2181/10.2,3 to 2181/10.2-3 to get the
+ references right. Thanks to Marcel Telka <marcel@telka.sk> for a bug report.
+
+Tue Sep 14 15:03:39 1999 Martin Mares <mj@albireo.ucw.cz>
+
+ * sleuth (try_resolve): Don't treat query send errors as fatal.
+
+Mon Sep 13 10:04:43 1999 Martin Mares <mj@albireo.ucw.cz>
+
+ * sleuth (check_zone): Added missing ref to RFC 1912/2.7 to
+ the `wildcard only for MX' message.
+ (check_name): Don't cry about invalid characters in proper wildcard names.
+
+Sun Sep 12 21:53:51 1999 Martin Mares <mj@albireo.ucw.cz>
+
+ * check.cgi: When sending mail with secondary name service request,
+ don't forget to mention the server.
+
+Tue Jun 8 20:57:33 1999 Martin Mares <mj@albireo.ucw.cz>
+
+ * check.cgi: Implemented $sec_ns_addr_space check.
+
+ * sleuth (check_zone): Commented out the localhost.$domain check
+ as it's defined only in already obsolete RFC's.
+
--- /dev/null
+# $Id$
+# Makefile for The DNS Sleuth
+# (c) 1999--2001 Martin Mares <mj@ucw.cz>
+
+CONF_PREFIX=/etc
+PREFIX=/usr
+VERSION=1.3
+
+all:
+
+clean:
+ rm -f `find . -name "*~" -o -name "*.[oa]" -o -name "\#*\#" -o -name TAGS -o -name core`
+ rm -rf dist
+
+install: all
+ install -m 644 sleuth.conf $(CONF_PREFIX)/
+ install -m 755 sleuth $(PREFIX)/bin
+
+release:
+ sed "s/\\(, version \\).*\./\\1$(VERSION)$(SUFFIX)./" <README >README.new
+ mv README.new README
+
+REL=sleuth-$(VERSION)
+DIST=dist/$(REL)
+
+dist: clean
+ mkdir dist
+ cp -a . $(DIST)
+ rm -rf `find $(DIST) -name CVS -o -name tmp` $(DIST)/dist
+ for a in $(DIST)/{sleuth.conf,check.conf} ; do \
+ sed 's/^push @INC/#push @INC/' <$$a >$$a.new ; \
+ mv $$a.new $$a ; \
+ done
+ cd dist ; tar czvvf /tmp/$(REL).tar.gz $(REL)
+
+.PHONY: all clean install dist release
--- /dev/null
+This package contains the DNS Sleuth, version 1.3.
+
+Copyright (c) 1999--2001 Martin Mares <mj@ucw.cz>
+
+All files in this package can be freely distributed and used according
+to the terms of the GNU General Public License, either version 2 or
+(at your opinion) any newer version. The exact text of the license can
+be found in file COPYING in any of GNU packages or at FSF Web pages
+at URL http://www.gnu.org/copyleft/
+
+
+ Sleuth is a Perl script designed for easy checking of DNS zones
+for common errors and also for processing of secondary name service
+requests. I wrote it after I've examined at least a dozen of utilities
+claiming to do this job and found that all of them are either unable
+to discover most zone bugs or too ugly for me to maintain. Sleuth also
+lists the corresponding RFC references with most of its error messages,
+so that the people upset with their zones being buggy can simply look
+up what exactly is going wrong and how to fix it.
+
+ Sleuth requires the Perl DNS module which can be found at
+ftp://ftp.cpan.org/pub/CPAN/modules/by-category/05_Networking_Devices_IPC/Net/Net-DNS-0.12.tar.gz.
+If you want to install it locally in your home directory, just modify
+the @INC path in sleuth.conf. Sleuth has been developed under Perl
+5.004_03 and it's probable that bugs in earlier Perl releases may
+prevent it from working properly.
+
+ You can download the current version from ftp://atrey.karlin.mff.cuni.cz/pub/local/mj/net/
+or try the online version at http://atrey.karlin.mff.cuni.cz/~mj/sleuth/ .
+
+ Please send me all bug reports and suggestions to <mj@ucw.cz>. This
+will help me with making Sleuth even more useful.
+
+ If you're tired of manually editing all the zone files and syncing the
+reverse records by hand, look at NSC -- a suite of M4 scripts for easy
+maintenance of DNS zones, you can download it from the same directory
+where Sleuth lives, look for "nsc-*.tar.gz".
+
+ The rest of this file tries to provide at least few bits of documentation.
+
+ Have fun
+ Martin
+
+
+Usage
+~~~~~
+To check a zone for consistency, just run "sleuth <domain>".
+
+To check a zone on specified name server, use "sleuth <domain> <server>"
+where <server> is the _name_ of the server. If the server itself is not
+yet registered, just add its IP address: "sleuth <domain> <server> <server-ip>".
+
+Also, Sleuth can be used for checks of secondary name service requests
+(this includes all of the usual zone checks plus several special ones,
+see below for a full list). To turn this mode on, just add two more
+parameters: the name of your secondary server and its IP address:
+"sleuth <domain> <server> <server-ip> <secondary-server> <secondary-ip>".
+
+By default, Sleuth lists only resource records defined in the zone being
+checked. By specifying a "-v" switch, Sleuth switches to verbose mode
+and includes all records it looks at during the checks (e.g., all the
+reverse records).
+
+If you want to check a private zone (i.e., skip all the tests regarding
+connection to the worldwide DNS and stop warning about private addresses
+occuring), add a "-p" switch.
+
+You can also switch formatting of output by specifying either "-m"
+(plain output -- just lines with their categories, useful for feeding
+to an external formatting engine) or "-h" (HTML fragment output,
+used by the WWW interface).
+
+
+WWW Interface
+~~~~~~~~~~~~~
+This package also includes a simple CGI script which allows Sleuth to be
+used interactively from any form-capable Web browser. The CGI interface
+(check.cgi) requires the CGI Perl module (standard part of recent Perl
+distributions or look at CPAN if you don't have it).
+
+The script needs some bits of customization, so please look at the
+check.conf file and follow the comments.
+
+The script expects Sleuth and check.conf to be in the same directory
+as it's run from.
+
+
+Configuration
+~~~~~~~~~~~~~
+You can customize Sleuth by editing the configuration file sleuth.conf
+(just follow the comments) which should be placed either in /etc or in
+the same directory as the sleuth script itself.
+
+
+Errors checked
+~~~~~~~~~~~~~~
+Here is a table of all the checks we do together with their identifiers.
+You can set severity of any of the checks (ignore/warning/error/fatal error)
+in the configuration file.
+
+dnserr Fatal DNS error (truncated errors and some other nasties)
+reserr Resolver error
+selfa Server unable to resolve its own name
+badname Malformed domain name
+badrn Malformed domain name in reverse zones
+zcname Zone is a CNAME
+znexist Zone doesn't exist
+nonsa Unable to find IP address of the DNS server
+pcname DNS record pointing to CNAME
+rcname CNAME pointing to CNAME
+badrev Invalid reverse mapping
+norev Missing reverse mapping
+inexrev Inexact reverse mapping (name -> ip -> different names only)
+soamail "@ instead of ." and other syntactic errors in SOA zone master address
+soammx Missing MX record for zone master address
+soammxa Missing A record for that MX record
+soaamx A record used instead of MX record
+soaorg Missing A record for origin server
+recchk The nameserver should be able to answer trivial queries
+nolocal No localhost records
+badloc Bad localhost records
+revloc No reverse record for 127.0.0.1
+unkrevz Unable to find network number in zone name
+badrevn Illegal name in reverse zone
+badrevr Illegal record type in reverse zone
+arev A records in reverse zones are considered bad practice
+revcn Illegal CNAME in reverse zone
+ptrnoa No A for PTR record
+ptrbada Mismatched A for PTR record
+outzone Out of zone records
+wildac Wildcard A's and CNAME's are strongly deprecated
+wild Wildcard records considered bad practice
+reccn CNAME recursion
+suspcn Suspicious overlapping CNAME
+dangcn Dangling CNAME
+dangcnr Dangling CNAME in reverse zone
+missrev Missing PTR for A
+missa Missing A for MX/NS/... destination
+obsrec Obsolete records (MD, MF, MB, MG, MR)
+supsoa Superfluous SOAs
+ptrfwd PTR records in forward zones are considered bad practice
+mxpref Invalid preference in MX record
+cnclash CNAME together with other records or two CNAME's for same name
+twons A zone has to have at least two nameservers
+lamer Lame delegations [check mode only]
+oodsec Authoritative servers don't agree on domain versions [check mode only]
+nosecns Our secondary not listed between NS records [submit mode only]
+utoplev Unknown top-level domain [submit mode only]
+xtoplev Name of top-level domain used as zone name [submit mode only]
+rtoplev Registration of top-level domain attempted [submit mode only]
+alknown Already known at our secondary [submit mode only]
+snauth Selected nameserver is not zone source [submit mode only]
+missns No NS records present [submit mode only]
+suspttl Suspicious TTL
+suspmtl Suspicious minttl in SOA
+suspexp Suspicious expire in SOA
+wks WKS record is obsolete
+ornotns Origin server not listed in domain's NS records
+unxtype Unexpected record in reply packet
+axfer Zone transfer failed
+alldig All-digit names are not allowed
+noserv No name server available for checking
+diffns Different name servers report different set of NS records
+duprec Duplicate record in zone
+srvnam Invalid name of SRV record
+srvpar Invalid parameters of SRV record
+srvdest Destination of SRV has no A
+iapname IP address found instead of name
+needaa Answer is not authoritative
--- /dev/null
+Thanks to people who have contributed their bug reports, ideas and patches
+and helped me make the DNS Sleuth what it is now.
+
+Ludek Coufal <ludek.coufal@oku-jh.cz>
+Lourdes Jones <lourdes@ljones.com>
+Pavel Kankovsky <peak@argo.troja.mff.cuni.cz>
+Jan Kasprzak <kas@fi.muni.cz>
+Vladimir Kotal <vladya@openbsd.cz>
+Michael Mraka <Michael.Mraka@GTSgroup.cz>
+Petr Nachtmann <petr@netmag.cz>
+Vojtech Pavlik <vojtech@ucw.cz>
+Jakub Skopal <j@kubs.cz>
+Petr Soucek <petr@ryston.cz>
+Marcel Telka <marcel@telka.sk>
--- /dev/null
+Unsorted ideas:
+~~~~~~~~~~~~~~~
+- check whether different nameservers are in different networks
+- check both TCP and UDP queries
+- SOA admin address: wildcard MX record?
+- IPv6 records and reversals
+- detailed host/mail/domain name checks
+- cgi: memory limits?
--- /dev/null
+#!/usr/bin/perl
+#
+# A Simple WWW interface for Sleuth domain checker
+# (c) 1999--2001 Martin Mares <mj@ucw.cz>
+#
+
+# Load configuration file and all modules we need
+
+BEGIN { require "check.conf"; }
+
+use CGI;
+use IO::Handle;
+
+$query = new CGI;
+print $query->header;
+
+$domain = $query->param('domain');
+$server = $query->param('server');
+$serverip = $query->param('serverip');
+$verbose = $query->param('verbose');
+$secondary = $query->param('secondary');
+$submitter = $query->param('submitter');
+$submit = "Submit";
+
+$stylesheet = <<EOF
+#headbar {
+ background-color: #4c3bff; color: #fffa45; margin: 0 15%; padding: 1ex;
+ text-align: center;
+ border: solid white;
+ border-width: 1px;
+}
+#headbox1 {
+ position: absolute;
+ width: 15%;
+ top: 0; bottom: auto; left: 0; right: auto;
+ text-align: center;
+}
+#headbox2 {
+ position: absolute;
+ width: 15%;
+ top: 0; bottom: auto; left: auto; right: 0;
+ text-align: center;
+}
+#querybox {
+ background-color: #ffffb0;
+ color: black;
+ margins: 0 15%;
+ padding: 1ex 2ex;
+ border: solid black;
+ border-width: 1px;
+}
+#querybox TD {
+ padding: 0.5ex 1ex;
+}
+TD#qbhead {
+ font-size: 150%;
+ font-weight: bold;
+ text-align: center;
+ padding-bottom: 1ex;
+}
+.singline { display: block }
+.collapse { margin: 0 0 }
+.msgW { color: #9e6500; font-style: normal; }
+.msgE, .msgF { color: #d73a05; font-style: normal; }
+EOF
+;
+
+print $query->start_html( -title=>"DNS Sleuth",
+ -author=>"$admin_email",
+ -dtd=>'-//W3C//DTD HTML 4.01//EN',
+ -style=>{-code=>$stylesheet}
+ );
+
+print <<EOF
+<div id=headbar align=center>
+<h2 class=collapse>The DNS Sleuth</h2>
+<p class=collapse style="margin-top: 1ex">An online tool for checking of DNS zones
+</div>
+<div id=headbox1 align=center>
+<p><A HREF="ftp://atrey.karlin.mff.cuni.cz/pub/local/mj/net/sleuth-$version.tar.gz">Sleuth</A> version $version ($rev_date)
+</div>
+<div id=headbox2 align=center>
+<p>
+<span class=singline>Written by</span>
+<span class=singline>$author_ref</span>
+<span class=singline><a href="mailto:$author_email"><$author_email></a></span>
+</div>
+EOF
+;
+
+if ($secondary_ns eq "") {
+ $secondary = '';
+}
+$msg = "New query";
+if ($domain eq "") {
+ print <<EOF
+<P>This is an online version of Sleuth -- a detector
+of common errors in DNS zones.
+
+<P>To check a zone, just enter its name in the form below. You can explictly
+specify a name server to be asked for zone data and if its name isn't available
+from the public DNS, then also its IP address. If you select the verbose mode,
+you will also get a full dump of the zone at no extra cost.
+EOF
+;
+ if ($secondary_ns ne "") {
+ print <<EOF
+<P>If you want to submit a request for secondary DNS service, fill in all
+form fields and check the "request secondary" box. The secondary server will
+run on <CODE>$secondary_ns</CODE>, so don't forget to list it as an
+authoritative server in your zone file.
+EOF
+;
+ }
+ print <<EOF
+<P>If you want to run Sleuth on your own machine, just <a href="ftp://atrey.karlin.mff.cuni.cz/pub/local/mj/net/">download</a>
+the latest version from our FTP server. Sleuth is free software, you can freely use and distribute it according
+to the <a href="http://www.gnu.org/copyleft/">GNU General Public License</a>.
+<P>If this page looks a bit fruitless, but otherwise displayed correctly,
+it's probably because your browser doesn't support the <a href="http://www.w3.org/Style/CSS/">Cascading
+Style Sheets</a> which are The Right Way to define presentation of HTML documents.
+In case this page looks a bit weird, your browser probably tries
+to support the style sheets, but does it wrongly (hello, Netscape 4).
+EOF
+;
+} elsif ($secondary ne "" && $serverip eq "") {
+ $msg = "Missing server name";
+} elsif ($secondary ne "" && $submitter eq "" && $need_submitter) {
+ $msg = "Please fill in who is submitting the zone";
+} elsif ($server !~ /^[0-9A-Za-z.-]*$/ ||
+ $serverip !~ /^(\d+\.\d+\.\d+\.\d+)?$/ ||
+ $domain !~ /^[0-9A-Za-z.-]*$/ ||
+ $submitter !~ /^[0-9A-Za-z.\240-\376 -]*$/) {
+ $msg = "Incorrect parameter syntax";
+} elsif ($secondary ne "" && defined $sec_ns_addr_space &&
+ unpack("H8",pack("c4",split(/\./,$serverip))) !~ $sec_ns_addr_space) {
+ $msg = "Name server address out of permitted range";
+} else {
+ print "<H2>Check results for $domain</H2>\n";
+ @c = "./sleuth";
+ if ($verbose ne "") { push @c, "-v"; }
+ push @c, "-h", $domain, $server;
+ if ($serverip ne "") { push @c, $serverip; }
+ if ($secondary ne "") { push @c, $secondary_ns, $secondary_ns_ip; }
+ STDOUT->flush();
+ $rc = system @c;
+ if ($secondary ne "") {
+ if ($rc / 256) {
+ print "<P>Request for secondary DNS service rejected because of errors in the zone.\n";
+ print "<P>If you have any questions, please ask $admin_ref.\n";
+ } else {
+ print "<P>Forwarding your secondary DNS service request to $admin_ref\n";
+ print "who will notify you by e-mail sent to the hostmaster address given in the\n";
+ print "SOA record when the secondary server will be configured.\n";
+ shift @c;
+ while ($c[0] =~ /^-[vh]$/) { shift @c; }
+ $ru = $query->remote_user;
+ ($rh = $query->remote_host) =~ s/[^A-Za-z0-9. \240-\376-]/?/g;
+ # This might look insecure, but we know all the names have been correctly
+ # validated by the first sleuth run.
+ `( echo "Domain: $domain" ;
+ echo "Server: $server [$serverip]" ;
+ echo "User: $ru" ;
+ echo "From: $submitter ($rh)" ;
+ echo ;
+ ./sleuth @c
+ ) | mail -s \"New zone\" $secondaries_to`;
+ $? && print "<P><EM>Forwarding failed (rc=$?)</EM>\n";
+ }
+ }
+ print "<hr>\n";
+}
+
+print $query->startform(-method=>'GET');
+print "\
+<p><table align=center border=0 id=querybox>\n\
+<tr><td colspan=4 align=center id=qbhead>$msg</td></tr>\n";
+print "<tr><td><em>Domain:</em></td><td>", $query->textfield('domain'), "</td>\n";
+print "<td><em>Verbose output:</em></td><td>", $query->checkbox(-name=>'verbose',value=>'ON',-label=>''), "</td></tr>\n";
+print "<tr><td><em>Server name:</em></td><td>", $query->textfield('server'), "</td>\n";
+print "<td><em>Server IP:</em></td><td>", $query->textfield('serverip'), "</td></tr>\n";
+if ($secondary_ns ne "") {
+ print "<tr><td><em>Request secondary:</em></td><td>", $query->checkbox(-name=>'secondary',value=>'ON',-label=>''), "</td>\n";
+ print "<td><em>Your name:</em></td><td>", $query->textfield('submitter'), "</td></tr>\n";
+}
+print "<tr><td colspan=4 align=center>", $query->submit('action', 'Submit'), "</td></tr>\n";
+print "</table>\n";
+print $query->endform;
+
+print "<div align=center><p>Please <a href=\"mailto:$author_email\">send</a> your bug reports and suggestions to $author_ref.</div>\n";
+print $query->end_html;
+print "\n";
--- /dev/null
+#
+# Configuration for check.cgi
+# (c) 1999--2001 Martin Mares <mj@ucw.cz>
+#
+# This file is just a piece of Perl code imported during
+# initialization of the check.cgi script, so you can do here
+# any Perl magic you wish here.
+#
+
+# Path to the CGI module
+#push @INC, "/home/mj/perl/lib/site_perl";
+
+$version = "1.3";
+$rev_date = "16-06-01";
+$admin_email = "mj\@ucw.cz";
+$admin_ref = "<A HREF=\"mailto:$admin_email\">Martin Mares</A>";
+$author_email = "mj\@ucw.cz";
+$author_ref = "<A HREF=\"http://atrey.karlin.mff.cuni.cz/~mj/\">Martin Mares</A>";
+
+#$secondary_ns = "server1.gts.cz"; # Comment out if you wish to disable the secondary DNS request fields
+#$secondary_ns_ip = "194.213.32.2";
+#$secondaries_to = "mj\@ucw.cz"; # Where to send secondary zone requests
+#$need_submitter = 1; # The Submitter field is mandatory
+#$sec_ns_addr_space = /^$/; # For secondary requests, hexadecimal IP address of NS must match this.
+
+1; # To make file loading successful :)
--- /dev/null
+#!/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 " [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";
+ 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));
+}
--- /dev/null
+#
+# Configuration for the DNS Sleuth
+# (c) 1999--2001 Martin Mares <mj@ucw.cz>
+#
+# This file is just a piece of Perl code imported during
+# initialization of the Sleuth script, so you can do here
+# any Perl magic you wish.
+#
+
+# Path to the DNS module
+#push @INC, "/home/mj/perl/lib/site_perl";
+
+# Hosts we check recursive resolving on
+@test_hosts = ( 'www.ucw.cz', 'atrey.karlin.mff.cuni.cz', 'metalab.unc.edu' );
+
+# Assign categories to all error messages:
+# '0' ignore
+# '.' informational message
+# 'W' warning
+# 'E' error
+# 'F' fatal error
+# Consult the README for a list of all the check names.
+%sev = %{{
+ 'selfa' => 'E',
+ 'badname' => 'E',
+ 'badrn' => 'E',
+ 'xtoplev' => 'F',
+ 'alknown' => 'F',
+ 'snauth' => 'F',
+ 'axfer' => 'E',
+ 'twons' => 'E',
+ 'reserr' => 'E',
+ 'pcname' => 'E',
+ 'rcname' => 'E',
+ 'badrev' => 'E',
+ 'norev' => 'E',
+ 'inexrev' => 'W',
+ 'soamail' => 'E',
+ 'soammx' => 'E',
+ 'soaamx' => 'W',
+ 'soammxa' => 'E',
+ 'soaorg' => 'E',
+ 'recchk' => 'W',
+ 'nolocal' => 'W',
+ 'badloc' => 'E',
+ 'revloc' => 'W',
+ 'nosecns' => 'E',
+ 'badrevn' => 'E',
+ 'badrevr' => 'E',
+ 'arev' => 'W',
+ 'outzone' => 'E',
+ 'wildac' => 'W',
+ 'wild' => 'W',
+ 'revcn' => 'E',
+ 'ptrnoa' => 'E',
+ 'ptrbada' => 'E',
+ 'reccn' => 'E',
+ 'suspcn' => 'W',
+ 'dangcn' => 'E',
+ 'dangcnr' => 'W',
+ 'missa' => 'E',
+ 'obsrec' => 'E',
+ 'supsoa' => 'E',
+ 'ptrfwd' => 'W',
+ 'mxpref' => 'E',
+ 'cnclash' => 'E',
+ 'lamer' => 'E',
+ 'oodsec' => 'E',
+ 'alldig' => 'E',
+ 'privadr' => 'W',
+ 'suspttl' => 'W',
+ 'unxtype' => 'W',
+ 'suspexp' => 'W',
+ 'suspmtl' => 'W',
+ 'wks' => 'W',
+ 'ornotns' => 'W',
+ 'diffns' => 'E',
+ 'duprec' => 'E',
+ 'unkrevz' => 'E',
+ 'srvnam' => 'E',
+ 'srvpar' => 'E',
+ 'srvdest' => 'E',
+ 'ipaname' => 'E',
+ 'needaa' => 'E',
+ 'zcname' => 'F', # These have to be fatal
+ 'znexist' => 'F',
+ 'nonsa' => 'F',
+ 'missns' => 'F',
+ 'dnserr' => 'F',
+ 'utoplev' => 'F',
+ 'rtoplev' => 'F',
+ 'noserv' => 'F',
+ '*' => '*', # Internal use only, don't modify
+ '>' => '>',
+ '.' => '.'
+}};
+
+# URL for RFC references and RFC section references
+$rfc_url = '"http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc$1.html"';
+$rfc_sec_url = '"http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc$1.html#sec-$2"';
+
+1; # To make file loading successful :)
git://git.jankratochvil.net / sleuth.git / commitdiff