#!/usr/local/bin/perl -w

use Net::DNS;

$|++;
$topdomain="ie";
$hostperdot=10;
$hostdir="hosts";

$version="0.02 beta";
my %self;

printf("Toplevel Domain Scanner (%s) by knight\@phunc.com.\n",$version);

if ($#ARGV >= 0) {
  $topdomain = $ARGV[0];
} else {
  print "Using default toplevel domain '$topdomain'\n";
}

$domainfile="domains-toplevel.$topdomain";
$domainstatus="domain-status.$topdomain";


printf("Scanning toplevel domain '$topdomain'\n");

if (-e $domainfile)
{
  printf("Domain file exists, reading.\n");
  open(HOSTIN, "<$domainfile") ||
        die "cannot open $domainfile for reading";
  while(<HOSTIN>)
  {
      chop;
      $final[$x++]=$_;
  }
  printf("%d domains scanned from file.\n\n",$x);
}
else
{
  print "Retrieving domain listing\n";
  print "A dot represents $hostperdot domains.\n";
  @zone = query($topdomain,"AXFR","IN");

  $x=0;
  if (@zone) {
    foreach $rr (@zone) {
      $domains[$x++]=lc $rr->name;    
    }
  }

  printf("\nSorting domains\n");
  @sorted = sort @domains;
  printf("Removing duplicate entries\n");
  $prev='noprevyet';
  @final=grep($_ ne $prev && ($prev = $_),@sorted);
  printf("%d domains scanned.\n",scalar(@final));
  printf("Saving to file '%s'.\n",$domainfile);
  open(HOSTOUT,">$domainfile") ||
        die "cannot open $domainfile for writing savefile.";
  foreach $blah (@final)
  {
    print HOSTOUT "$blah\n";
  }
}

$go=0;
mkdir "$hostdir",0755 unless -d $hostdir;
mkdir "$hostdir/$topdomain",0755 unless -d "$hostdir/$topdomain";
if (-e $domainstatus)
{
  printf("Reading domain status file.\n");
  open(STATUS,"<$domainstatus") ||
        die "cannot open $domainstatus for reading last domain.";
  while(<STATUS>)
  {
    chop;
    $lastdomain=$_;
  }
  printf("Last domain scanned was %s\n",$lastdomain);
  $go=1;
}

foreach $dom (@final) {
  if ($go eq 1) {
     if ($dom eq $lastdomain) {
	$go=0;
     }
  next;
  }

  print "\nRetrieving domain '$dom'\n";
  @domzone = query($dom,"A","IN");

  $x=0;
  undef @hosts;
  if (@domzone) {
    foreach $rr (@domzone) {
	if ($rr ne 2) {
           $hosts[$x++]=lc $rr->name;
	}
    }
  }

  if ($x ne 0) {
    open(HOSTOUT,">$hostdir/$topdomain/$dom") ||
             die "can not open $hostdir/$topdomain/$dom for writing";
    my $oldfh = select(HOSTOUT);
    $|++;
    select($oldfh);

    printf("Sorting hosts\n");
    @sorted = sort @hosts;
    printf("Removing duplicate entries\n");
    $prev='noprevyet';
    @hostfinal=grep($_ ne $prev && ($prev = $_),@sorted);
    printf("%d hosts scanned.\n",scalar(@hostfinal));
    foreach $hostname (@hostfinal) {
       print HOSTOUT "$hostname\n";
    }
    close(HOSTOUT);
  }
  open(STATUS,">>$domainstatus") ||
        die "cannot open $domainstatus for writing status.";
  my $oldfh = select(STATUS);
  $|++;
  select($oldfh);
  print STATUS "$dom\n";
  close(STATUS);
}





sub nmserv {
  my ($dname) = @_;

  $res= new Net::DNS::Resolver;
  $query=$res->send($dname, "NS");
  if ($query) {
     foreach $rr ($query->answer) {
        next unless $rr->type eq "NS";
        $nameserver=$rr->nsdname;
        last;
     }
  }
  else {
      print "send failed: ", $res->errorstring, "\n";
  }
  $res->nameservers($nameserver);
  $res->debug(1);
  return $res;
}


sub query {
  my ($dname, $class, $type) = @_;
  my $pkt  = new Net::DNS::Packet($dname,"AXFR",$type);
  my $data = $pkt->data;

  my $old_wflag = $^W;
  $^W = 0;

  $j=0;

  $nsres = nmserv($dname);
  $ns = $nsres->{"nameservers"}->[0];
#  print "ns $ns\n";
  my $sock = new IO::Socket::INET(PeerAddr => $ns,
                                PeerPort => 53,
                                Proto    => "tcp",
                                Timeout  => 10);
  $^W = $old_wflag;

  unless ($sock) {
    print "couldn't connect\n";
    return;
  }                                      

  my $lenmsg = pack("n", length($data));

  unless ($sock->send($lenmsg)) {
    $self->errorstring($!);
    return;
  }

  unless ($sock->send($data)) {
    $self->errorstring($!);
    return;
  }

  my $sel = new IO::Select;
  $sel->add($sock);

  my @zone;
  my $soa_count = 0;
  my $timeout = 10;

  while (1) {
     my @ready = $sel->can_read($timeout);
     unless (@ready) {
         print "timeout\n";
         return;
     }

     my $buf = read_tcp($sock, &Net::DNS::INT16SZ);
     last unless length($buf);
     my ($len) = unpack("n", $buf);
     last unless $len;

     @ready = $sel->can_read($timeout);
     unless (@ready) {
         $self->errorstring("timeout");
         return;
     }

     $buf = read_tcp($sock, $len);

     #print ";; received ", length($buf), " bytes\n";

     unless (length($buf) == $len) {
        $self->errorstring("expected $len bytes, " .
                           "received " . length($buf));
        return;
     }

     my ($ans, $err) = new Net::DNS::Packet(\$buf);

     if (defined $ans) {
       if ($ans->header->ancount < 1) {
	     print $ans->header->rcode,"\n";
	     if ($ans->header->rcode eq "SERVFAIL") {
                return 2;
             }
       }
     }
     elsif (defined $err) {
       $self->errorstring($err);
       last;
     }

     foreach ($ans->answer) {
  #      $_->print;
       if ($_->type eq "SOA") {
             ++$soa_count;
             push @zone, $_ unless $soa_count >= 2;
#	     print $_->name, "\n" if $debug;
       } else {
         if ($class eq "AXFR") {
           if ($_->type eq "NS") {
               printf(".") unless( ++$j % $hostperdot);
  	       push @zone, $_;
	   }
         } elsif ($class eq "A") {
           if ($_->type eq "A") {
	       printf(".") unless( ++$j % $hostperdot);
	       push @zone, $_;
           }
         }
       }	     
   }
  
  last if $soa_count >= 2;
  }
  print "\n" if ($j > 0);
  return @zone;
}



#
# Usage:  $data = read_tcp($socket, $nbytes);
#
sub read_tcp {
        my ($sock, $nbytes) = @_;
        my $buf = "";
        my $buf2;

        while (length($buf) < $nbytes) {
                $sock->recv($buf2, $nbytes - length($buf));
                last unless length($buf2);
                $buf .= $buf2;
        }
        return $buf;
}


