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