Re: [Omaha.pm] Testing DNS servers

[Jay Hannah <jay@jays.net>]

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");
         }
      }
   }
}