[Omaha.pm] Testing DNS servers

[Jay Hannah]

revision 1.2
date: 2007/01/16 16:28:42;  author: jhannah;  state: Exp;  lines: +65 -17
I discovered a problem with my testing robot. The answers coming from the
servers were not necessarily authoritative. This was a fatal design flaw
because when the target server recurses to find the correct answer the
test robot must detect that behavior and report it as a failure.

I switched from parsing dig output to Net::DNS where I can explicitly
check the aa (authoritative answer) bit to make sure that the answer I'm
receiving isn't from cache.

Also, in this version if you're expecting multiple responses (e.g.: 3 MX 
servers)
you can pass an array reference in and the test will check all values.
(There may be a sorting bug here that I haven't fixed.)





use strict;
use Test::More;

eval { require Sys::HostIP };
plan skip_all => "Sys::HostIP required" if $@;
eval { require Net::DNS::Resolver };
plan skip_all => "Net::DNS::Resolver required" if $@;

my $ip_address = Sys::HostIP->ip;
if ($ip_address =~ /^10\./) {
    plan skip_all => "You can only run these tests from the Internet. Your IP: [$ip_address]";
} else {
    plan tests => 102;
}

my @servers = (
    '63.174.225.42',   # omares-netservices's Internet IP
    '63.251.92.193',   # dns3.corporatedomains.com
);

my @expect = qw(
    omnihotels.com                    A   63.241.199.252
    www.omnihotels.com                A   63.241.199.252
    # You can also pass array references like this:
    #'676restaurant.com',         'NS',    [ 'ns.panomedia.net', 'ns1.panomedia.net' ],
);

run_tests(\@servers, \@expect);


exit;



# -------------

sub run_tests {
    my ($servers, $expect) = @_;

    # Set up our resolver objects...
    my %resolvers;
    foreach my $server (@$servers) {
       my $res = Net::DNS::Resolver->new(
          nameservers => [ $server ],
          recurse     => 0,
          #debug       => 1
       );
       $resolvers{$server} = $res;
    }



    for (my $j = 0; $j < @$expect; $j += 3) {
       foreach my $server (@$servers) {
          my ($q, $type, $a) = @$expect[$j .. $j + 2];

          my $res = $resolvers{$server};
          my $packet = $res->search($q, $type);   # Net::DNS::Packet object
          my @response;
          if ($packet) {
             ### Hmm... This NS theory is unproven, so I'm commenting it out.
             ###if ($type eq "NS") {
             ###   # These don't have to be authoritative. When we delgate NS for a server
             ###   # apparently named does not set the aa (authoritative answer) flag.
             ###} else {
                if ($packet->header->aa) {
                   # Good. It's authoritative.
                } else {
                   # Ack! Non-authoritative answer??
                   push @response, "ERROR! Server returned non-authoritative answer!";
                }
             ###}

             foreach my $rr ($packet->answer) {
                next unless $rr->type eq $type;
                #print $rr->address, "\n";
                if ($type eq "A") {
                   push @response, $rr->address;
                } elsif ($type eq "NS") {
                   push @response, $rr->nsdname;
                } elsif ($type eq "MX") {
                   push @response, $rr->exchange;
                } elsif ($type eq "TXT") {
                   push @response, $rr->txtdata;
                }
             }
          }
          if (ref $a eq "ARRAY") {
             # The test requested we check multiple values...
             is_deeply([@response], $a,      "\@$server $q $type -> $a");
          } else {
             is_deeply([@response], [$a],    "\@$server $q $type -> $a");
          }
       }
    }
}