#!/usr/bin/perl
# $Id: check_zone 1815 2020-10-14 21:55:18Z willem $

=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 warnings;
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 my $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);
		}
	}
	return;
}

sub check_ptr {
	my ($domain, $class, @zone) = @_;
	my $res = Net::DNS::Resolver->new;
	my $rr;
	foreach my $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);
	}
	return;
}

sub check_ns {
	my ($domain, $class, @zone) = @_;
	my $res = Net::DNS::Resolver->new;
	my $rr;
	foreach my $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);
	}
	return;
}

sub check_mx {
	my ($domain, $class, @zone) = @_;
	my $res = Net::DNS::Resolver->new;
	my $rr;
	foreach my $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);
	}
	return;
}

sub check_cname {
	my ($domain, $class, @zone) = @_;
	my $res = Net::DNS::Resolver->new;
	my $rr;
	foreach my $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);
	}
	return;
}