#!/usr/local/bin/perl -w

# $Id: check_zone 264 2005-04-06 09:16:15Z olaf $

=head1 NAME

check_zone - Check a DNS zone for errors

=head1 SYNOPSIS

C<check_zone> [ C<-r> ] I<domain> [ I<class> ]

=head1 DESCRIPTION

Checks a DNS zone for errors.  Current checks are:

=over 4

=item *

Checks that all A records have corresponding PTR records.

=item *

Checks that hosts listed in NS, MX, and CNAME records have

A records.

=back

=head1 OPTIONS

=over 4

=item C<-r>

Perform a recursive check on subdomains.

=back

=head1 AUTHOR

Michael Fuhr <mike@fuhr.org>

=head1 SEE ALSO

L<perl(1)>, L<axfr>, L<check_soa>, L<mresolv>, L<mx>, L<perldig>, L<Net::DNS>

=cut

use strict;

use vars qw($opt_r);

use Getopt::Std;

use File::Basename;

use IO::Socket;

use Net::DNS;

getopts("r");

die "Usage: ", basename($0), " [ -r ] domain [ class ]\n"

	unless (@ARGV >= 1) && (@ARGV <= 2);

check_domain(@ARGV);

exit;

sub check_domain {

	my ($domain, $class) = @_;

	$class ||= "IN";

	print "-" x 70, "\n";

	print "$domain (class $class)\n";

	print "\n";

	my $res = Net::DNS::Resolver->new;

	$res->defnames(0);

	$res->retry(2);

	my $nspack = $res->query($domain, "NS", $class);

	unless (defined($nspack)) {

		warn "Couldn't find nameservers for $domain: ",

		     $res->errorstring, "\n";

		return;

	}

	print "nameservers (will request zone from first available):\n";

	my $ns;

	foreach $ns (grep { $_->type eq "NS" } $nspack->answer) {

		print "\t", $ns->nsdname, "\n";

	}

	print "\n";

	$res->nameservers(map  { $_->nsdname }

			  grep { $_->type eq "NS" }

			  $nspack->answer);

	my @zone = $res->axfr($domain, $class);

	unless (@zone) {

		warn "Zone transfer failed: ", $res->errorstring, "\n";

		return;

	}

	print "checking PTR records\n";

	check_ptr($domain, $class, @zone);

	print "\n";

	print "checking NS records\n";

	check_ns($domain, $class, @zone);

	print "\n";

	print "checking MX records\n";

	check_mx($domain, $class, @zone);

	print "\n";

	print "checking CNAME records\n";

	check_cname($domain, $class, @zone);

	print "\n";

	if ($opt_r) {

		print "checking subdomains\n\n";

		my %subdomains;

		foreach (grep { $_->type eq "NS" and $_->name ne $domain } @zone) {

			$subdomains{$_->name} = 1;

		}

		foreach (sort keys %subdomains) {

			check_domain($_, $class);

		}

	}

}

sub check_ptr {

	my ($domain, $class, @zone) = @_;

	my $res = Net::DNS::Resolver->new;

	my $rr;

	foreach $rr (grep { $_->type eq "A" } @zone) {

		my $host = $rr->name;

		my $addr = $rr->address;

		my $ans = $res->send($addr, "A", $class);

		print "\t$host ($addr) has no PTR record\n"

			if ($ans->header->ancount < 1);

	}

}

sub check_ns {

	my ($domain, $class, @zone) = @_;

	my $res = Net::DNS::Resolver->new;

	my $rr;

	foreach $rr (grep { $_->type eq "NS" } @zone) {

		my $ans = $res->send($rr->nsdname, "A", $class);

		print "\t", $rr->nsdname, " has no A record\n"

			if ($ans->header->ancount < 1);

	}

}

sub check_mx {

	my ($domain, $class, @zone) = @_;

	my $res = Net::DNS::Resolver->new;

	my $rr;

	foreach $rr (grep { $_->type eq "MX" } @zone) {

		my $ans = $res->send($rr->exchange, "A", $class);

		print "\t", $rr->exchange, " has no A record\n"

			if ($ans->header->ancount < 1);

	}

}

sub check_cname {

	my ($domain, $class, @zone) = @_;

	my $res = Net::DNS::Resolver->new;

	my $rr;

	foreach $rr (grep { $_->type eq "CNAME" } @zone) {

		my $ans = $res->send($rr->cname, "A", $class);

		print "\t", $rr->cname, " has no A record\n"

			if ($ans->header->ancount < 1);

	}

}