The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

NLNETLABS / Net-DNS-1.50 / demo / check_soa 

            

              
1
2
—
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

              
#!/usr/bin/perl
# $Id: check_soa 1815 2020-10-14 21:55:18Z willem $
=head1 NAME
check_soa - Check a domain's nameservers
=head1 SYNOPSIS
B<check_soa> I<domain>
=head1 DESCRIPTION
B<check_soa> queries each of a domain's nameservers for the Start
of Authority (SOA) record and prints the serial number.  Errors
are printed for nameservers that couldn't be reached or didn't
answer authoritatively.
=head1 AUTHOR
The original Bourne Shell and C versions were printed in
I<DNS and BIND> by Paul Albitz & Cricket Liu.
This Perl version was written by Michael Fuhr <mike@fuhr.org>.
=head1 SEE ALSO
L<perl(1)>, L<axfr>, L<check_zone>, L<mresolv>, L<mx>, L<perldig>, L<Net::DNS>
=cut
use strict;
use warnings;
use File::Basename;
use Net::DNS;
#------------------------------------------------------------------------------
# Get the domain from the command line.
#------------------------------------------------------------------------------
die "Usage: ", basename($0), " domain\n" unless @ARGV == 1;
my ($domain) = @ARGV;
#------------------------------------------------------------------------------
# Find all the nameservers for the domain.
#------------------------------------------------------------------------------
my $res = Net::DNS::Resolver->new();
$res->defnames(0);
$res->retry(2);
my $ns_req = $res->query($domain, "NS");
die "No nameservers found for $domain: ", $res->errorstring, "\n"
        unless defined($ns_req) and ($ns_req->header->ancount > 0);
# Send out non-recursive queries
$res->recurse(0);
# Do not buffer standard out
local $| = 1;
#------------------------------------------------------------------------------
# Check the SOA record on each nameserver.
#------------------------------------------------------------------------------
foreach my $nsrr (grep {$_->type eq "NS" } $ns_req->answer) {
         
        #----------------------------------------------------------------------
        # Set the resolver to query this nameserver.
        #----------------------------------------------------------------------
        my $ns = $nsrr->nsdname;
         
        # In order to lookup the IP(s) of the nameserver, we need a Resolver
        # object that is set to our local, recursive nameserver.  So we create
        # a new object just to do that.
         
        my $local_res = Net::DNS::Resolver->new();
         
        my $a_req = $local_res->query($ns, 'A');
        unless ($a_req) {
                warn "Can not find address for $ns: ", $res->errorstring, "\n";
                next;
        }
         
        foreach my $ip (map { $_->address } grep { $_->type eq 'A' } $a_req->answer) {
                #----------------------------------------------------------------------
                # Ask this IP.
                #----------------------------------------------------------------------
                $res->nameservers($ip);      
         
                print "$ns ($ip): ";
                #----------------------------------------------------------------------
                # Get the SOA record.
                #----------------------------------------------------------------------
         
                my $soa_req = $res->send($domain, 'SOA', 'IN');
                 
                unless (defined($soa_req)) {
                        warn $res->errorstring, "\n";
                        next;
                }
                #----------------------------------------------------------------------
                # Is this nameserver authoritative for the domain?
                #----------------------------------------------------------------------
                unless ($soa_req->header->aa) {
                        warn "isn't authoritative for $domain\n";
                        next;
                }
                #----------------------------------------------------------------------
                # We should have received exactly one answer.
                #----------------------------------------------------------------------
                unless ($soa_req->header->ancount == 1) {
                        warn "expected 1 answer, got ", $soa_req->header->ancount, "\n";
                        next;
                }
                 
                #----------------------------------------------------------------------
                # Did we receive an SOA record?
                #----------------------------------------------------------------------
         
                unless (($soa_req->answer)[0]->type eq "SOA") {
                        warn "expected SOA, got ", ($soa_req->answer)[0]->type, "\n";
                        next;
                }
                 
                #----------------------------------------------------------------------
                # Print the serial number.
                #----------------------------------------------------------------------
                print "has serial number ", ($soa_req->answer)[0]->serial, "\n";
        }
}
0;