#!/usr/bin/perl

# (c) 2000 Scott W. Gifford <sgifford@tir.com>
#
# TODO
# - Check for lame delegation
# - Allow checking of TTLs.
# - Option to follow CNAMEs, MX records.
# - Parallelize (multithread?)
# - Figure out whether somebody *should* be returning data or not.

use strict;
use Net::DNS;
use Getopt::Std;

use vars qw($debug);
$debug=1;
sub debugf(@);
sub debug(@);

use vars qw(%opt);
getopts("qvd:",\%opt);
if (defined($opt{d}))
{
  $debug=$opt{d};
}
elsif (defined($opt{v}))
{
  $debug=2;
}
elsif (defined($opt{q}))
{
  $debug=0;
}

use vars qw(@hint);

use vars qw(%data_record %pathto %ns_record %checked $timeout %reported %answered);

for (my $i=ord('a');$i<ord('m');$i++)
{
  push(@hint,chr($i).".root-servers.net");
  $pathto{chr($i).".root-servers.net"} = [ [ ] ];
}

use vars qw($res);
$res = new Net::DNS::Resolver
  or die "Error creating new Net::DNS::Resolver: $!\n";

&track_a($ARGV[0],@hint);


sub track_a
{
  my($hostname,@servers) = @_;
  my $query;
  my @moretest;
  local %SIG;
  
  return unless (@servers);
  
  $SIG{ALRM} = \&timeout;
  
  foreach my $s (@servers)
  {
    my @answers;
    my $summary;
    
    next if ($checked{$s});
    $checked{$s}=1;
    
    @answers=();
    
    $res->nameservers($s);
    $res->recurse(0);  # We should really try with and without, maybe.
    $res->dnsrch(0);
    $res->retrans(5);
    $res->retry(2);
    debugf 1, "  Asking %20s about %15s\n",$s,$hostname;
    
    alarm(10);
    $query = $res->send($hostname,"ANY","IN");
    if (!defined($query))
    {
      warn "Error searching for '$hostname' at '$s': ".$res->errorstring."\n";
      next;
    }

    foreach my $rr ($query->answer)
    {
#      if ($rr->type eq "A")
#      {
#	$data_record{$s} = $rr->address;
#	push(@{$reported{$rr->address}},$s);
#	debugf 2, "  %20s reported %15s IN A %16s\n", $s, $hostname, $rr->address;
#      }
      if ($rr->type ne "NS")
      {
	$rr->ttl(0);
	debugf 2, "%20s reported %s\n",$s,$rr->string;
	push(@answers,$rr->string);
      }
    }

    foreach my $rr ($query->authority)
    {
      if ($rr->type eq "NS")
      {
	$ns_record{$s} = $rr->nsdname;
	foreach my $path (@{$pathto{$s}})
	{
	  push(@{$pathto{lc $rr->nsdname}},[@$path, $s])
	      unless (grep(/$s/i,@$path));
	}
	push(@moretest,lc $rr->nsdname);
	debugf 2, "  %20s reported %15s IN NS %20s\n", $s, $hostname, $rr->nsdname;
      }
    }
    if (@answers or $query->header->aa)
    {
      $summary = &summarize(@answers);
      $data_record{$s} = $summary;
      push(@{$reported{$summary}},$s);
      $answered{$s}=1;
    }
  }
  
  &track_a($hostname,@moretest);
}

my %pathcount;
my $totalpaths;

while (my($k,$v) = each %reported)
{
  $pathcount{$k}=0;
  foreach my $h (@$v)
  {
    $pathcount{$k} += scalar(@{$pathto{$h}});
  }
  $totalpaths += $pathcount{$k};
}
if ($totalpaths == 0)
{
  $totalpaths++;
}

if ( scalar(keys %reported) > 1)
{
  print "\n";
  print "WARNING: Found inconsistencies!\n";
  while (my($k,$v) = each %reported)
  {
    my $res;
    print "\n";
    printf "  %5d hosts [%5d/%5d paths = %5.2f%% chance ] (%s) reported:\n",scalar(@$v),$pathcount{$k},$totalpaths,100*$pathcount{$k}/$totalpaths,join(", ",@$v);
    print "  Sample path: ",join(" -> ",(@{$pathto{$v->[0]}[0]}),$v->[0]),"\n";
    ($res = $k) =~ s/\n/\n     /mg;
    print "     ",$res,"\n";
  }
}
else
{
  my $k = (keys %reported)[0];
  my $v = $reported{$k};
  my $res;
  
  if (!$v)
  {
    print "\n";
    print "All hosts returned errors!\n";
  }
  else
  {
    print "\n";
    printf "  %5d hosts [%5d/%5d paths = %5.2f%% chance ] (%s) reported:\n",scalar(@$v),$totalpaths,$totalpaths,100,join(", ",@$v);
    print "  Sample path: ",join(" -> ",(@{$pathto{$v->[0]}[0]}),$v->[0]),"\n";
    ($res = $k) =~ s/\n/\n     /mg;
    print "     ",$res,"\n";
  }
}

print "\n";

print scalar(keys %answered)," different hosts answered for this domain:\n";
print "    ",join("\n    ",keys %answered),"\n";

sub summarize
{
  if (@_)
  {
    return join("\n",sort @_);
  }
  else
  {
    return "(no data)\n";
  }
}

sub debugf(@)
{
  if ($debug >= $_[0])
  {
    shift;
    printf @_;
  }
}

sub print(@)
{
  if ($debug >= $_[0])
  {
    shift;
    print @_;
  }
}