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