45 use Net::DNS; |
46 use Net::DNS; |
46 use Pod::Usage; |
47 use Pod::Usage; |
47 use if $ENV{DEBUG} => 'Smart::Comments'; |
48 use if $ENV{DEBUG} => 'Smart::Comments'; |
48 |
49 |
49 sub uniq { my %h; @h{@_} = (); return keys %h; } |
50 sub uniq { my %h; @h{@_} = (); return keys %h; } |
|
51 my @extns = qw(8.8.8.8 8.8.4.4); |
|
52 |
|
53 package Net::DNS::Resolver { |
|
54 use Storable qw(freeze); |
|
55 sub new { |
|
56 my $class = shift; |
|
57 state %cache; |
|
58 return $cache{freeze \@_} //= $class->SUPER::new(@_); |
|
59 } |
|
60 } |
50 |
61 |
51 # return a list of the zones known to the local |
62 # return a list of the zones known to the local |
52 # bind |
63 # bind |
53 sub get_local_zones { |
64 sub get_local_zones { |
54 my @conf; |
65 my @conf; |
95 |
106 |
96 # return a list of "official" nameservers |
107 # return a list of "official" nameservers |
97 sub ns { |
108 sub ns { |
98 my $domain = shift; |
109 my $domain = shift; |
99 ### assert: @_ % 2 == 0 |
110 ### assert: @_ % 2 == 0 |
100 my %resflags = (nameservers => [qw/8.8.8.8/], @_); |
111 my %resflags = (nameservers => \@extns, @_); |
101 my $aa = delete $resflags{aa}; |
112 my $aa = delete $resflags{aa}; |
102 my $nameservers = $resflags{nameservers}; |
113 my $nameservers = join ',' => @{$resflags{nameservers}}; |
103 my @ns; |
114 my @ns; |
104 |
115 |
105 my $r = Net::DNS::Resolver->new(%resflags); |
116 my $r = Net::DNS::Resolver->new(%resflags); |
106 my $q = $r->query($domain, 'NS') or die $r->errorstring, "\@@$nameservers\n"; |
117 my $q; |
107 |
118 |
108 die "no aa @@$nameservers\n" if $aa and not $q->header->aa; |
119 for (my $i = 3; $i; --$i) { |
|
120 $q = $r->query($domain, 'NS') and last; |
|
121 } |
|
122 die $r->errorstring . "\@$nameservers\n" if not $q; |
|
123 |
|
124 die "no aa \@$nameservers\n" if $aa and not $q->header->aa; |
109 push @ns, map { $_->nsdname } grep { $_->type eq 'NS' } $q->answer; |
125 push @ns, map { $_->nsdname } grep { $_->type eq 'NS' } $q->answer; |
110 |
126 |
111 return sort @ns; |
127 return sort @ns; |
112 } |
128 } |
113 |
129 |
114 sub serial { |
130 sub serial { |
115 my $domain = shift; |
131 my $domain = shift; |
116 my %resflags = (nameservers => [qw/8.8.8.8/], @_); |
132 my %resflags = (nameservers => \@extns, @_); |
117 my $nameservers = $resflags{nameservers}; |
133 my $nameservers = join ',' => @{$resflags{nameservers}}; |
118 |
134 |
119 my $r = Net::DNS::Resolver->new(%resflags); |
135 my $r = Net::DNS::Resolver->new(%resflags); |
120 my $q = $r->query($domain, 'SOA') or die $r->errorstring, "\@@$nameservers\n"; |
136 my $q; |
|
137 |
|
138 for (my $i = 3; $i; --$i) { |
|
139 $q = $r->query($domain, 'SOA') and last; |
|
140 } |
|
141 die $r->errorstring, "\@$nameservers\n" if not $q; |
|
142 |
121 return (map { $_->serial } grep { $_->type eq 'SOA' } $q->answer)[0]; |
143 return (map { $_->serial } grep { $_->type eq 'SOA' } $q->answer)[0]; |
122 } |
144 } |
123 |
145 |
124 # - the nameservers known from the ns records |
146 # - the nameservers known from the ns records |
125 # - from the primary master if this is not one of the |
147 # - from the primary master if this is not one of the |
137 my @our = eval { sort +ns($domain, nameservers => [$reference], aa => 1) }; |
159 my @our = eval { sort +ns($domain, nameservers => [$reference], aa => 1) }; |
138 push @errs, $@ if $@; |
160 push @errs, $@ if $@; |
139 my @their = eval { sort +ns($domain) }; |
161 my @their = eval { sort +ns($domain) }; |
140 push @errs, $@ if $@; |
162 push @errs, $@ if $@; |
141 |
163 |
142 if (!@errs) { |
164 if (@errs) { |
|
165 chomp @errs; |
|
166 die join(', ' => @errs) . "\n"; |
|
167 } |
|
168 |
|
169 if ("@our" ne "@their") { |
143 local $" = ', '; |
170 local $" = ', '; |
144 if ("@our" eq "@their") { |
|
145 return 1; |
|
146 } |
|
147 die "NS differ (our @our) vs (their @their)\n"; |
171 die "NS differ (our @our) vs (their @their)\n"; |
148 } |
172 } |
149 chomp @errs; |
173 |
150 die join(', ', @errs) . "\n"; |
174 return uniq sort @our, @their; |
151 |
175 } |
|
176 |
|
177 sub serial_ok { |
|
178 my ($domain, @ns) = @_; |
|
179 my @serials = map { my $s = serial $domain, nameservers => [$_]; "$s\@$_" } @ns; |
|
180 |
|
181 if (uniq(map { /(\d+)/ } @serials) != 1) { |
|
182 die "serials do not match: @serials\n"; |
|
183 } |
|
184 |
|
185 $serials[0] =~ /(\d+)/; |
|
186 return $1; |
152 } |
187 } |
153 |
188 |
154 sub main { |
189 sub main { |
155 my @argv = @_; |
190 my @argv = @_; |
156 my $opt_reference = '127.0.0.1'; |
191 my $opt_reference = '127.0.0.1'; |
174 my @domains = get_domains(@argv); |
209 my @domains = get_domains(@argv); |
175 |
210 |
176 my (@OK, %CRITICAL); |
211 my (@OK, %CRITICAL); |
177 foreach my $domain (@domains) { |
212 foreach my $domain (@domains) { |
178 print STDERR "$domain " if $opt_progress; |
213 print STDERR "$domain " if $opt_progress; |
179 eval { ns_ok($domain, $opt_reference) }; |
214 |
180 if ($@) { $CRITICAL{$domain} = $@ } |
215 my @ns = eval { ns_ok($domain, $opt_reference) }; |
181 else { push @OK, $domain } |
216 if ($@) { |
182 say STDERR $@ ? 'not ok' : 'ok' if $opt_progress; |
217 $CRITICAL{$domain} = $@; |
|
218 say STDERR 'ns not ok' if $opt_progress; |
|
219 next; |
|
220 } |
|
221 print STDERR 'ok(ns) '; |
|
222 |
|
223 my @serial = eval { serial_ok($domain, @ns) }; |
|
224 if ($@) { |
|
225 $CRITICAL{$domain} = $@; |
|
226 say STDERR 'serial not ok' if $opt_progress; |
|
227 next; |
|
228 } |
|
229 say STDERR 'ok(serial)' if $opt_progress; |
|
230 push @OK, $domain; |
|
231 |
183 } |
232 } |
184 |
233 |
185 # use DDP; |
234 # use DDP; |
186 # p @OK; |
235 # p @OK; |
187 # p %CRITICAL; |
236 # p %CRITICAL; |