1#!/usr/bin/perl
2#
3# $Id: SOA.pm 749 2009-03-20 09:22:13Z calle $
4#
5# Copyright (c) 2007 .SE (The Internet Infrastructure Foundation).
6#                    All rights reserved.
7#
8# Redistribution and use in source and binary forms, with or without
9# modification, are permitted provided that the following conditions
10# are met:
11# 1. Redistributions of source code must retain the above copyright
12#    notice, this list of conditions and the following disclaimer.
13# 2. Redistributions in binary form must reproduce the above copyright
14#    notice, this list of conditions and the following disclaimer in the
15#    documentation and/or other materials provided with the distribution.
16#
17# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
18# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
25# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
26# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
27# IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28#
29######################################################################
30
31package DNSCheck::Test::SOA;
32
33require 5.008;
34use warnings;
35use strict;
36
37our $SVN_VERSION = '$Revision: 749 $';
38
39use base 'DNSCheck::Test::Common';
40
41use Net::IP 1.25 qw(ip_get_version);
42
43######################################################################
44
45sub test {
46    my $self = shift;
47    my $zone = shift;
48
49    return unless $self->parent->config->should_run;
50
51    my $logger = $self->parent->logger;
52
53    $logger->module_stack_push();
54    $logger->auto("SOA:BEGIN", $zone);
55
56    my ($errors, $packet) = $self->test_soa_existence($zone);
57
58    my $soa;
59    if (defined($packet)) {
60        $soa = ($packet->answer)[0];
61    }
62
63    if (defined($soa)) {
64        $errors += $self->test_soa_mname($soa, $zone);
65        $errors += $self->test_soa_rname($soa, $zone);
66        $errors += $self->test_soa_values($soa, $zone);
67    }
68
69    $logger->auto("SOA:END", $zone);
70    $logger->module_stack_pop();
71
72    return $errors;
73}
74
75################################################################
76# Utility function(s)
77################################################################
78
79sub mname_is_ns {
80    my $soa    = shift;
81    my $logger = shift;
82    my @ns     = @_;
83
84    foreach my $rr (@ns) {
85        if ($rr->type eq 'CNAME') {
86            $logger->auto('SOA:MNAME_IS_CNAME', $rr->name, $rr->cname);
87        } elsif (lc($rr->nsdname) eq lc($soa->mname)) {
88            return 1;
89        }
90    }
91
92    return 0;
93}
94
95################################################################
96# Tests
97################################################################
98
99sub test_soa_existence {
100    my $self = shift;
101    my $zone = shift;
102
103    return unless $self->parent->config->should_run;
104
105    my $packet =
106      $self->parent->dns->query_child($zone, $zone, $self->qclass, "SOA");
107
108    my $errors = 0;
109
110    # REQUIRE: SOA record must exist
111
112    # Shouldn't this check that the returned SOA record actually is for the
113    # requested zone? As it's written now, any SOA record at all will make the
114    # test pass. /Calle
115    if (   $packet
116        && ($packet->header->ancount > 0)
117        && (($packet->answer)[0]->type eq "SOA"))
118    {
119        $self->logger->auto("SOA:FOUND", $zone);
120    } else {
121        $errors += $self->logger->auto("SOA:NOT_FOUND", $zone);
122        return ($errors, undef);
123    }
124
125    # REQUIRE: only ONE SOA record may exist
126    unless ($packet->header->ancount == 1) {
127        $errors += $self->logger->auto("SOA:MULTIPLE_SOA", $zone);
128    }
129
130    return ($errors, $packet);
131}
132
133sub test_soa_mname {
134    my $self = shift;
135    my $soa  = shift;
136    my $zone = shift;
137
138    my $parent = $self->parent;
139    my $logger = $self->logger;
140
141    return unless $parent->config->should_run;
142
143    my $errors = 0;
144
145    # REQUIRE: SOA MNAME must exist as a valid hostname
146    if ($parent->host->test($soa->mname) > 0) {
147        $errors += $logger->auto("SOA:MNAME_ERROR", $zone, $soa->mname);
148    } else {
149        $logger->auto("SOA:MNAME_VALID", $zone, $soa->mname);
150    }
151
152    my $packet;
153    $packet = $parent->dns->query_resolver($zone, $self->qclass, "NS");
154
155    unless ($packet && $packet->header->ancount) {
156        $errors += $logger->auto("SOA:NS_NOT_FOUND", $zone);
157        return $errors;
158    }
159
160    # REQUIRE: SOA MNAME may not be in the list of nameservers
161    unless (mname_is_ns($soa, $logger, $packet->answer)) {
162        $logger->auto("SOA:MNAME_STEALTH", $zone, $soa->mname);
163    } else {
164        $logger->auto("SOA:MNAME_PUBLIC", $zone, $soa->mname);
165    }
166
167    # REQUIRE: SOA MNAME may be unreachable
168    # REQUIRE: SOA MNAME must be authoritative
169    # FIXME: discuss how to handle timeouts
170    my @addresses = $parent->dns->find_addresses($soa->mname, $soa->class);
171    foreach my $address (@addresses) {
172
173        if (ip_get_version($address) == 4
174            && !$parent->config->get('net')->{ipv4})
175        {
176            $logger->auto("SOA:SKIPPED_IPV4", $address);
177            next;
178        }
179
180        if (ip_get_version($address) == 6
181            && !$parent->config->get('net')->{ipv6})
182        {
183            $logger->auto("SOA:SKIPPED_IPV6", $address);
184            next;
185        }
186
187        my $error =
188          $parent->dns->address_is_authoritative($address, $soa->name,
189            $soa->class);
190
191        if ($error == 0) {
192            $logger->auto("SOA:MNAME_IS_AUTH", $zone, $soa->mname);
193        } else {
194            $logger->auto("SOA:MNAME_NOT_AUTH", $zone, $soa->mname);
195        }
196    }
197    return $errors;
198}
199
200sub test_soa_rname {
201    my $self = shift;
202    my $soa  = shift;
203    my $zone = shift;
204
205    my $errors = 0;
206
207    my $parent = $self->parent;
208    my $logger = $self->logger;
209
210    return unless $parent->config->should_run;
211
212    # REQUIRE: SOA RNAME must have a valid syntax (@ vs .)
213    # REQUIRE: SOA RNAME address should be deliverable
214    if ($soa->rname =~ /^(.+?)(?<!\\)\.(.+)$/)
215    {    # Check for existence if unescaped dot
216        my $mailaddr = $soa->rname;
217        $mailaddr =~ s/(?<!\\)\./@/;    # Replace unescaped dot with at-sign
218        $mailaddr =~ s/\\\././g;        # De-escape escaped dots.
219
220        if ($parent->config->get('net')->{smtp}) {
221            if ($parent->mail->test($mailaddr, $zone)) {
222                $logger->auto("SOA:RNAME_UNDELIVERABLE",
223                    $zone, $soa->rname, $mailaddr);
224            } else {
225                $logger->auto("SOA:RNAME_DELIVERABLE",
226                    $zone, $soa->rname, $mailaddr);
227            }
228        }
229
230    } else {
231        $errors += $logger->auto("SOA:RNAME_SYNTAX", $zone, $soa->rname);
232    }
233
234    return $errors;
235}
236
237sub test_soa_values {
238    my $self = shift;
239    my $soa  = shift;
240    my $zone = shift;
241
242    my $errors = 0;
243
244    my $parent = $self->parent;
245    my $logger = $self->logger;
246
247    return unless $parent->config->should_run;
248
249    my $params = $parent->config->get("params");
250
251    # REQUIRE: SOA TTL advistory, min 1 hour
252    my $min_soa_ttl = $params->{"SOA:MIN_TTL"};
253    if ($soa->ttl < $min_soa_ttl) {
254        $logger->auto("SOA:TTL_SMALL", $zone, $soa->ttl, $min_soa_ttl);
255    } else {
256        $logger->auto("SOA:TTL_OK", $zone, $soa->ttl, $min_soa_ttl);
257    }
258
259    # REQUIRE: SOA 'refresh' at least 4 hours
260    my $min_soa_refresh = $params->{"SOA:MIN_REFRESH"};
261    if ($soa->refresh < $min_soa_refresh) {
262        $logger->auto("SOA:REFRESH_SMALL", $zone, $soa->refresh,
263            $min_soa_refresh);
264    } else {
265        $logger->auto("SOA:REFRESH_OK", $zone, $soa->refresh, $min_soa_refresh);
266    }
267
268    # REQUIRE: SOA 'retry' lower than 'refresh'
269    unless ($soa->retry < $soa->refresh) {
270        $logger->auto("SOA:RETRY_VS_REFRESH", $zone, $soa->refresh,
271            $soa->retry);
272    }
273
274    # REQUIRE: SOA 'retry' at least 1 hour
275    my $min_soa_retry = $params->{"SOA:MIN_RETRY"};
276    if ($soa->retry < $min_soa_retry) {
277        $logger->auto("SOA:RETRY_SMALL", $zone, $soa->retry, $min_soa_retry);
278    } else {
279        $logger->auto("SOA:RETRY_OK", $zone, $soa->retry, $min_soa_retry);
280    }
281
282    # REQUIRE: SOA 'expire' at least 7 days
283    my $min_soa_expire = $params->{"SOA:MIN_EXPIRE"};
284    if ($soa->expire < $min_soa_expire) {
285        $logger->auto("SOA:EXPIRE_SMALL", $zone, $soa->expire, $min_soa_expire);
286    } else {
287        $logger->auto("SOA:EXPIRE_OK", $zone, $soa->expire, $min_soa_expire);
288    }
289
290    # REQUIRE: SOA 'expire' at least 7 times 'refresh'
291    if ($soa->expire < $soa->refresh * $params->{"SOA:EXPIRE_VS_REFRESH"}) {
292        $logger->auto("SOA:EXPIRE_VS_REFRESH", $zone);
293    }
294
295    # REQUIRE: SOA 'minimum' less than 1 day
296    my $max_soa_minimum = $params->{"SOA:MAX_MINIMUM"};
297    my $min_soa_minimum = $params->{"SOA:MIN_MINIMUM"};
298    if ($soa->minimum > $max_soa_minimum) {
299        $logger->auto("SOA:MINIMUM_LARGE", $zone, $soa->minimum,
300            $max_soa_minimum);
301    } elsif ($soa->minimum < $min_soa_minimum) {
302        $logger->auto("SOA:MINIMUM_SMALL", $zone, $soa->minimum,
303            $min_soa_minimum);
304    } else {
305        $logger->auto("SOA:MINIMUM_OK", $zone, $soa->minimum, $min_soa_minimum,
306            $max_soa_minimum);
307    }
308
309    # RFC 2136 says serial should not be zero
310    if ($soa->serial == 0) {
311        $logger->auto('SOA:SERIAL_IS_ZERO', $zone);
312    }
313
314    return $errors;
315}
316
3171;
318
319__END__
320
321
322=head1 NAME
323
324DNSCheck::Test::SOA - Test SOA record
325
326=head1 DESCRIPTION
327
328Test the zone SOA record. The following tests are made:
329
330=over 4
331
332=item *
333The SOA record must exist.
334
335=item *
336Only ONE SOA record may exist.
337
338=item *
339SOA MNAME must exist as a valid hostname.
340
341=item *
342SOA MNAME does not have to be in the list of nameservers.
343
344=item *
345SOA MNAME does not have to be reachable.
346
347=item *
348SOA MNAME must be authoritative for the zone.
349
350=item *
351SOA RNAME must have a valid syntax .
352
353=item *
354SOA RNAME address should be deliverable.
355
356=item *
357SOA TTL should be at least 1 hour.
358
359=item *
360SOA 'refresh' should be at least 4 hours.
361
362=item *
363SOA 'retry' should be lower than SOA 'refresh'.
364
365=item *
366SOA 'retry' shoule be at least 1 hour.
367
368=item *
369SOA 'expire' should be at least 7 days.
370
371=item *
372SOA 'expire' should be at least 7 times SOA 'refresh'.
373
374=item *
375SOA 'minimum' should be less than 1 day.
376
377=back
378
379=head1 METHODS
380
381=over
382
383=item ->test($zonename)
384
385Runs all the tests specified above.
386
387=item ->test_soa_existence($zonename)
388
389Tests that one and only one SOA record exists.
390
391=item ->test_soa_mname($soapacket, $zonename)
392
393Runs the MNAME-related tests.
394
395C<$soapacket> must be a L<Net::DNS::RR::SOA> object suitably filled in.
396
397=item ->test_soa_rname($soapacket, $zonename)
398
399Runs the RNAME-related tests.
400
401=item ->test_soa_values($soapacket, $zonename)
402
403Runs the tests checking the values in the given SOA record.
404
405=back
406
407=head1 SEE ALSO
408
409L<DNSCheck>, L<DNSCheck::Logger>, L<DNSCheck::Test::Host>,
410L<DNSCheck::Test::Mail>
411
412=cut
413