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