dwww: tpablo.net

#!/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;
}

Generated by dwww version 1.14 on Sat Aug 16 10:33:46 CEST 2025.