1#!/usr/bin/perl 2# 3# $Id: DNSCheck.pm 886 2010-06-22 08:15:12Z 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; 32 33require 5.008; 34use warnings; 35use strict; 36 37use DBI; 38use Carp; 39use List::Util qw[reduce max min]; 40 41use DNSCheck::Config; 42use DNSCheck::Test::Common; 43use DNSCheck::Test::Host; 44use DNSCheck::Test::Address; 45use DNSCheck::Test::SOA; 46use DNSCheck::Test::Zone; 47use DNSCheck::Test::Connectivity; 48use DNSCheck::Test::Consistency; 49use DNSCheck::Test::Delegation; 50use DNSCheck::Test::Nameserver; 51use DNSCheck::Test::DNSSEC; 52use DNSCheck::Test::Mail; 53use DNSCheck::Test::SMTP; 54use DNSCheck::Lookup::DNS; 55use DNSCheck::Lookup::Resolver; 56use DNSCheck::Lookup::ASN; 57use DNSCheck::Logger; 58 59our $VERSION = "1.1"; 60our $SVN_VERSION = '$Revision: 886 $'; 61 62###################################################################### 63 64sub new { 65 my $proto = shift; 66 my $class = ref($proto) || $proto; 67 my $self = {}; 68 bless $self, $class; 69 70 my $config_args = shift; 71 if ($config_args->{with_config_object}) { 72 $self->{config} = $config_args->{with_config_object}; 73 } else { 74 $self->{config} = DNSCheck::Config->new(%{$config_args}); 75 $self->config->put( 76 'root_zone_data', 77 DNSCheck::Lookup::Resolver->get_preload_data( 78 $config_args->{rootsource} 79 ) 80 ); 81 } 82 83 return $self; 84} 85 86###################################################################### 87 88sub flush { 89 my $self = shift; 90 91 # Dump the DNS cache. 92 $self->{dns}->flush(); 93 94 # Dump all cached test objects. 95 $self->{test_zone} = undef; 96 $self->{test_host} = undef; 97 $self->{test_address} = undef; 98 $self->{test_soa} = undef; 99 $self->{test_connectivity} = undef; 100 $self->{test_consistency} = undef; 101 $self->{test_delegation} = undef; 102 $self->{test_nameserver} = undef; 103 $self->{test_dnssec} = undef; 104 $self->{test_mail} = undef; 105 $self->{test_smtp} = undef; 106 $self->{faked} = []; 107 108 # should the ASN cache be flushed as well? 109 #$self->{context}->{asn}->flush(); 110} 111 112###################################################################### 113 114sub add_fake_glue { 115 my $self = shift; 116 my $zone = shift; 117 my $ns_name = shift; 118 my $ns_ip = shift; 119 120 unless (defined($ns_ip)) { 121 my @ip = $self->dns->find_addresses($ns_name, 'IN'); 122 if (@ip == 0) { 123 $self->logger->auto("FAKEGLUE:NO_ADDRESS"); 124 return; 125 } else { 126 $self->resolver->add_fake_glue($zone, $ns_name, $_) for @ip; 127 } 128 } else { 129 unless ($self->resolver->add_fake_glue($zone, $ns_name, $ns_ip)) { 130 $self->logger->auto('FAKEGLUE:BROKEN_INFO', $ns_name, $ns_ip); 131 } 132 } 133 134 $self->{faked} = 1; 135 136 return 1; 137} 138 139sub undelegated_test { 140 my $self = shift; 141 142 return $self->{faked}; 143} 144 145###################################################################### 146 147sub logger { 148 my $self = shift; 149 150 unless (defined($self->{logger})) { 151 $self->{logger} = DNSCheck::Logger->new($self); 152 } 153 154 return $self->{logger}; 155} 156 157sub dns { 158 my $self = shift; 159 160 unless (defined($self->{dns})) { 161 $self->{dns} = DNSCheck::Lookup::DNS->new($self); 162 } 163 164 return $self->{dns}; 165} 166 167sub resolver { 168 my $self = shift; 169 170 unless (defined($self->{resolver})) { 171 $self->{resolver} = DNSCheck::Lookup::Resolver->new($self); 172 } 173 174 return $self->{resolver}; 175} 176 177sub asn { 178 my $self = shift; 179 180 unless (defined($self->{asn})) { 181 $self->{asn} = DNSCheck::Lookup::ASN->new($self); 182 } 183 184 return $self->{asn}; 185} 186 187sub config { 188 my $self = shift; 189 return $self->{config}; 190} 191 192sub locale { 193 my $self = shift; 194 195 unless (defined($self->{locale})) { 196 $self->{locale} = DNSCheck::Locale->new($self->config->get("locale")); 197 } 198 return $self->{locale}; 199} 200 201sub dbh { 202 my $self = shift; 203 my $tries = 0; 204 my $dbh; 205 206 unless (defined($self->config->get("dbi"))) { 207 return; 208 } 209 210 unless (defined($self->{"dbh"}) && $self->{"dbh"}->ping) { 211 until (defined($dbh) or ($tries > 5)) { 212 $tries += 1; 213 my $conf = $self->config->get("dbi"); 214 my $dsn = sprintf("DBI:mysql:database=%s;hostname=%s;port=%s", 215 $conf->{"database"}, $conf->{"host"}, $conf->{"port"}); 216 217 eval { 218 $dbh = 219 DBI->connect($dsn, $conf->{"user"}, $conf->{"password"}, 220 { RaiseError => 1, AutoCommit => 1, PrintError => 0 }); 221 }; 222 if ($@) { 223 carp "Failed to connect to database: $@"; 224 } 225 } 226 227 if (defined($dbh)) { 228 $self->{"dbh"} = $dbh; 229 } else { 230 croak "Cannot connect to database."; 231 } 232 } 233 234 return $self->{"dbh"}; 235} 236 237sub revision_string { 238 my @tmp; 239 my %revs = ( 240 DNSCheck => '$Revision: 886 $', 241 Config => $DNSCheck::Config::SVN_VERSION, 242 Locale => $DNSCheck::Locale::SVN_VERSION, 243 Logger => $DNSCheck::Logger::SVN_VERSION, 244 DNS => $DNSCheck::Lookup::DNS::SVN_VERSION, 245 ASN => $DNSCheck::Lookup::ASN::SVN_VERSION, 246 Resolver => $DNSCheck::Lookup::Resolver::SVN_VERSION, 247 Address => $DNSCheck::Test::Address::SVN_VERSION, 248 Common => $DNSCheck::Test::Common::SVN_VERSION, 249 Connectivity => $DNSCheck::Test::Connectivity::SVN_VERSION, 250 Consistency => $DNSCheck::Test::Consistency::SVN_VERSION, 251 Delegation => $DNSCheck::Test::Delegation::SVN_VERSION, 252 DNSSEC => $DNSCheck::Test::DNSSEC::SVN_VERSION, 253 Host => $DNSCheck::Test::Host::SVN_VERSION, 254 Mail => $DNSCheck::Test::Mail::SVN_VERSION, 255 SMTP => $DNSCheck::Test::SMTP::SVN_VERSION, 256 SOA => $DNSCheck::Test::SOA::SVN_VERSION, 257 Zone => $DNSCheck::Test::Zone::SVN_VERSION, 258 ); 259 260 foreach my $k (sort keys %revs) { 261 my $rev; 262 if ($revs{$k} =~ m|\$Revision: (\d+) \$|) { 263 $rev = $1; 264 } else { 265 $rev = '(none)'; 266 } 267 push @tmp, "$k:$rev"; 268 } 269 270 return join '; ', @tmp; 271} 272 273sub _stddev { 274 my @values = @_; 275 276 my $avg = (reduce { $a + $b } @values) / scalar(@values); 277 my $dev = reduce { $a + $b } map { $_ * $_ } map { $_ - $avg } @values; 278 279 return sqrt($dev / scalar(@values)); 280} 281 282sub log_nameserver_times { 283 my $self = shift; 284 285 while (my ($k, $v) = each %{ $self->resolver->times }) { 286 my $sum = reduce { $a + $b } @$v; 287 $self->logger->auto( 288 'NSTIME:AVERAGE', 289 $k, 290 scalar(@$v), 291 sprintf('%0.3f', 1000 * ($sum / @$v)), 292 sprintf('%0.3f', 1000 * min(@$v)), 293 sprintf('%0.3f', 1000 * max(@$v)), 294 sprintf('%0.3f', 1000 * _stddev(@$v)), 295 ); 296 } 297} 298 299###################################################################### 300# Test objects 301###################################################################### 302 303sub zone { 304 my $self = shift; 305 unless (defined($self->{test_zone})) { 306 $self->{test_zone} = DNSCheck::Test::Zone->new($self); 307 } 308 309 return $self->{test_zone}; 310} 311 312sub host { 313 my $self = shift; 314 315 unless (defined($self->{test_host})) { 316 $self->{test_host} = DNSCheck::Test::Host->new($self); 317 } 318 319 return $self->{test_host}; 320} 321 322sub address { 323 my $self = shift; 324 325 unless (defined($self->{test_address})) { 326 $self->{test_address} = DNSCheck::Test::Address->new($self); 327 } 328 329 return $self->{test_address}; 330} 331 332sub soa { 333 my $self = shift; 334 335 unless (defined($self->{test_soa})) { 336 $self->{test_soa} = DNSCheck::Test::SOA->new($self); 337 } 338 339 return $self->{test_soa}; 340} 341 342sub connectivity { 343 my $self = shift; 344 345 unless (defined($self->{test_connectivity})) { 346 $self->{test_connectivity} = DNSCheck::Test::Connectivity->new($self); 347 } 348 349 return $self->{test_connectivity}; 350} 351 352sub consistency { 353 my $self = shift; 354 355 unless (defined($self->{test_consistency})) { 356 $self->{test_consistency} = DNSCheck::Test::Consistency->new($self); 357 } 358 359 return $self->{test_consistency}; 360} 361 362sub delegation { 363 my $self = shift; 364 365 unless (defined($self->{test_delegation})) { 366 $self->{test_delegation} = DNSCheck::Test::Delegation->new($self); 367 } 368 369 return $self->{test_delegation}; 370} 371 372sub nameserver { 373 my $self = shift; 374 375 unless (defined($self->{test_nameserver})) { 376 $self->{test_nameserver} = DNSCheck::Test::Nameserver->new($self); 377 } 378 379 return $self->{test_nameserver}; 380} 381 382sub dnssec { 383 my $self = shift; 384 385 unless (defined($self->{test_dnssec})) { 386 $self->{test_dnssec} = DNSCheck::Test::DNSSEC->new($self); 387 } 388 389 return $self->{test_dnssec}; 390} 391 392sub mail { 393 my $self = shift; 394 395 unless (defined($self->{test_mail})) { 396 $self->{test_mail} = DNSCheck::Test::Mail->new($self); 397 } 398 399 return $self->{test_mail}; 400} 401 402sub smtp { 403 my $self = shift; 404 405 unless (defined($self->{test_smtp})) { 406 $self->{test_smtp} = DNSCheck::Test::SMTP->new($self); 407 } 408 409 return $self->{test_smtp}; 410} 411 412###################################################################### 413 4141; 415 416__END__ 417 418 419=head1 NAME 420 421DNSCheck - DNS Check Tools 422 423=head1 DESCRIPTION 424 425This module provides the external interface to the actual tests in the 426DNSCheck system. 427 428=head1 METHODS 429 430=over 431 432=item ->new($confighashref); 433 434C<confighashref> is a reference to a hash holding configuration keys. 435They will be blindly used to create a L<DNSCheck::Config> object, 436unless one key is C<with_config_object>. If there is such a key, its 437value will be used as the L<DNSCheck::Config> object. No check to see 438if it actually I<is> such an object will be done, so anything that 439responds to the right methods can be used. 440 441Providing a pre-created config object can be useful when creating and 442discarding a large number of L<DNSCheck> objects, since config object 443creation normally stands for the majority of the time it takes to 444create such an object. Creating the config object once and then 445providing it to every L<DNSCheck> may save considerable time in the 446long run. An example if this use can be found in the 447C<dnscheck-dispatcher> application. 448 449=item ->flush() 450 451Flush the internal DNS cache. 452 453=item ->logger() 454 455Return the logger object. It is of type L<DNSCheck::Logger>. 456 457=item ->dns() 458 459Return the DNS lookup object. It is of type L<DNSCeck::Lookup::DNS>. 460 461=item ->asn() 462 463Return the ASN lookup object. It is of type L<DNSCheck::Lookup::ASN>. 464 465=item ->config() 466 467Return the config object. It will be of type L<DNSCheck::Config> unless 468something different was given to C<new> as described above. 469 470=item ->dbh() 471 472Return a live database connection (L<DBI>) object, if database access is 473configured. If not, returns C<undef>. If a database connection is configured, 474it should point at a database with the dnscheck schema loaded, or the first 475sub-module here to try and use the database will throw an exception and cause 476the script to die. 477 478This method uses L<DBI::ping()> to determine if a connection is alive 479or not, so make sure to use a DBI adapter where that isn't a null 480operation (as it used to be in older versions of L<DBD::mysql>). Also, 481since the included database schema assumes that the database is MySQL, 482this method will try to connect to the server five times before it 483gives up and dies. 484 485=item ->add_fake_glue($zone, $nsname, [$nsip]) 486 487Add an item of "fake" glue data. For the given zone, the provided information 488will be used instead of what can be found live in DNS (if any). If an IP 489address is provided, it will be used. If not, an attempt to look up addresses 490for the name will be made. If that attempt fails, the name will be ignored. 491 492=item ->undelegated_test() 493 494This method returns true of any "fake" glue information has been provided. 495 496=item ->zone() 497 498=item ->host() 499 500=item ->address() 501 502=item ->soa() 503 504=item ->connectivity() 505 506=item ->consistency() 507 508=item ->delegation() 509 510=item ->nameserver() 511 512=item ->dnssec() 513 514=item ->mail() 515 516=item ->smtp() 517 518These eleven methods all return properly configured objects of the 519respective test classes. For more details on how to use the objects, 520see the documentation on the modules in question. Generally, though, 521they have a main entry method called C<test> that runs all available 522tests with the arguments given. 523 524The objects returned are created on first request and cached for 525future use. Use the C<flush()> method to discard the existing objects, 526so that new ones will be created on next request. 527 528=back 529 530=head1 EXAMPLES 531 532 use DNSCheck; 533 534 my $dc = DNSCheck->new; 535 $dc->zone->test("iis.se"); 536 $dc->logger->dump; 537 538=head1 SEE ALSO 539 540L<DNSCheck::Config.pm>, L<DNSCheck::Locale.pm>, 541L<DNSCheck::Logger.pm>, L<DNSCheck::Lookup::ASN.pm>, 542L<DNSCheck::Lookup::DNS.pm>, L<DNSCheck::Test::Address.pm>, 543L<DNSCheck::Test::Common.pm>, L<DNSCheck::Test::Connectivity.pm>, 544L<DNSCheck::Test::Consistency.pm>, L<DNSCheck::Test::Delegation.pm>, 545L<DNSCheck::Test::DNSSEC.pm>, L<DNSCheck::Test::Host.pm>, 546L<DNSCheck::Test::Mail.pm>, L<DNSCheck::Test::Nameserver.pm>, 547L<DNSCheck::Test::SMTP.pm>, L<DNSCheck::Test::SOA.pm>, 548L<DNSCheck::Test::Zone.pm> 549 550=cut 551