1#!/usr/bin/perl
2# $Id: check_zone 1815 2020-10-14 21:55:18Z willem $
3
4=head1 NAME
5
6check_zone - Check a DNS zone for errors
7
8=head1 SYNOPSIS
9
10C<check_zone> [ C<-r> ] I<domain> [ I<class> ]
11
12=head1 DESCRIPTION
13
14Checks a DNS zone for errors.  Current checks are:
15
16=over 4
17
18=item *
19
20Checks that all A records have corresponding PTR records.
21
22=item *
23
24Checks that hosts listed in NS, MX, and CNAME records have
25A records.
26
27=back
28
29=head1 OPTIONS
30
31=over 4
32
33=item C<-r>
34
35Perform a recursive check on subdomains.
36
37=back
38
39=head1 AUTHOR
40
41Michael Fuhr <mike@fuhr.org>
42
43=head1 SEE ALSO
44
45L<perl(1)>, L<axfr>, L<check_soa>, L<mresolv>, L<mx>, L<perldig>, L<Net::DNS>
46
47=cut
48
49use strict;
50use warnings;
51use vars qw($opt_r);
52
53use Getopt::Std;
54use File::Basename;
55use IO::Socket;
56use Net::DNS;
57
58getopts("r");
59
60die "Usage: ", basename($0), " [ -r ] domain [ class ]\n"
61	unless (@ARGV >= 1) && (@ARGV <= 2);
62
63check_domain(@ARGV);
64exit;
65
66sub check_domain {
67	my ($domain, $class) = @_;
68	$class ||= "IN";
69
70	print "-" x 70, "\n";
71	print "$domain (class $class)\n";
72	print "\n";
73
74	my $res = Net::DNS::Resolver->new;
75	$res->defnames(0);
76	$res->retry(2);
77
78	my $nspack = $res->query($domain, "NS", $class);
79
80	unless (defined($nspack)) {
81		warn "Couldn't find nameservers for $domain: ",
82		     $res->errorstring, "\n";
83		return;
84	}
85
86	print "nameservers (will request zone from first available):\n";
87	my $ns;
88	foreach my $ns (grep { $_->type eq "NS" } $nspack->answer) {
89		print "\t", $ns->nsdname, "\n";
90	}
91	print "\n";
92
93	$res->nameservers(map  { $_->nsdname }
94			  grep { $_->type eq "NS" }
95			  $nspack->answer);
96
97	my @zone = $res->axfr($domain, $class);
98	unless (@zone) {
99		warn "Zone transfer failed: ", $res->errorstring, "\n";
100		return;
101	}
102
103	print "checking PTR records\n";
104	check_ptr($domain, $class, @zone);
105	print "\n";
106
107	print "checking NS records\n";
108	check_ns($domain, $class, @zone);
109	print "\n";
110
111	print "checking MX records\n";
112	check_mx($domain, $class, @zone);
113	print "\n";
114
115	print "checking CNAME records\n";
116	check_cname($domain, $class, @zone);
117	print "\n";
118
119	if ($opt_r) {
120		print "checking subdomains\n\n";
121		my %subdomains;
122		foreach (grep { $_->type eq "NS" and $_->name ne $domain } @zone) {
123			$subdomains{$_->name} = 1;
124		}
125		foreach (sort keys %subdomains) {
126			check_domain($_, $class);
127		}
128	}
129	return;
130}
131
132sub check_ptr {
133	my ($domain, $class, @zone) = @_;
134	my $res = Net::DNS::Resolver->new;
135	my $rr;
136	foreach my $rr (grep { $_->type eq "A" } @zone) {
137		my $host = $rr->name;
138		my $addr = $rr->address;
139		my $ans = $res->send($addr, "A", $class);
140		print "\t$host ($addr) has no PTR record\n"
141			if ($ans->header->ancount < 1);
142	}
143	return;
144}
145
146sub check_ns {
147	my ($domain, $class, @zone) = @_;
148	my $res = Net::DNS::Resolver->new;
149	my $rr;
150	foreach my $rr (grep { $_->type eq "NS" } @zone) {
151		my $ans = $res->send($rr->nsdname, "A", $class);
152		print "\t", $rr->nsdname, " has no A record\n"
153			if ($ans->header->ancount < 1);
154	}
155	return;
156}
157
158sub check_mx {
159	my ($domain, $class, @zone) = @_;
160	my $res = Net::DNS::Resolver->new;
161	my $rr;
162	foreach my $rr (grep { $_->type eq "MX" } @zone) {
163		my $ans = $res->send($rr->exchange, "A", $class);
164		print "\t", $rr->exchange, " has no A record\n"
165			if ($ans->header->ancount < 1);
166	}
167	return;
168}
169
170sub check_cname {
171	my ($domain, $class, @zone) = @_;
172	my $res = Net::DNS::Resolver->new;
173	my $rr;
174	foreach my $rr (grep { $_->type eq "CNAME" } @zone) {
175		my $ans = $res->send($rr->cname, "A", $class);
176		print "\t", $rr->cname, " has no A record\n"
177			if ($ans->header->ancount < 1);
178	}
179	return;
180}
181