#!/usr/bin/env perl

=head1 NAME

 mwhois - multi-plexing whois client

=head1 SYNOPSIS

  A domain name information gathering tool that looks up whois records
  with the authorative WHOIS server and common DNS records.

=head1 USAGE

  mwhois domain.com

=cut

use IO::Socket;
BEGIN {
  eval "require Net::DNS" ;
  $netdns = 1 unless $@ ;
}
use Carp ;

my $dom = shift ;
my %server_addrs = () ;

# root whois server query
if ( $dom =~ /\d+\.\d+\.\d+\.\d+/ ) {
  $start      = 'whois.arin.net' ;
  $prefix     = '' ;
  $dnslookup  = join(".", reverse split /\./, $dom) ;
  $dnslookup .= ".in-addr.arpa" ;
} else {
  $start      = 'whois.internic.net' ;
  $prefix     = 'domain ' ;
  $dom        =~ s/^www\.// ;
  $dom        =~ s/^.*@// ;
  $dnslookup  = $dom ;
}

my( $whois, );
$_ = query( "$prefix$dom", $start ) ;
if ( ( $whois ) = /Whois Server:\s*(.*)/i ) {
  print "Refering to $whois for details:\n" ;
  $_ = query( "$dom", $whois ) ;
  if ( $whois eq 'whois.networksolutions.com' ) {
    s/.*?(?=\nRegistrant:\n)//s ;
  }
  $domainfound = 1 ;
}
print ;

sub query {
  my( $dom, $server_name ) = @_ ;
  my( $a, $text, $server_addr ) ;

  unless ( $server_addr = $server_addrs{$server_name} ) {
    $a = gethostbyname $server_name or croak "no address: $server_name" ;
    $server_addrs{$server_name} = $server_addr = join( ".", unpack "C4", $a) ;
  }
  $server_addr or croak "no server: $a" ;
  
  $sock = IO::Socket::INET->new(
      PeerAddr => $server_addr, PeerPort => 'whois', Proto => 'tcp')
    or croak "Can't connect to $server_name: $@";

  $sock->autoflush;

  print $sock "$dom\x0d\x0a";

  { local $/; $text = <$sock>; }
  undef $sock;
  $text || carp "No data returned from server";
}

if ( $netdns ) {
  $res = new Net::DNS::Resolver ;
  $res->dnsrch(0);
  $res->recurse(0);
  @regns = $res->nameservers() ;
  $res->nameservers( '198.41.0.4', '128.9.0.107', '192.33.4.12' ) ;

  RECURSE:
  # loop through name servers until we get a final ANSWER section
  for ( $i = 0 ; $i < 7 ; $i++ ) {
    $query = $res->send($dnslookup, "NS") ;
    # check for a NScount aka an authority section
    if ( $query->header->nscount() ) {
      # grab the address from the additional section of the packet
      # did we get an A record for the name server in the additional section???
      if ( $query->header->arcount() ) {
        $rr = ( $query->additional() )[ rand($query->header->arcount()) ] ; 
        die "NS query failure: wrong record type\n" unless $rr->type eq 'A' ;
        # set name servers to next level
        $res->nameservers( $rr->address() );
      } else {
        # check for NS or SOA records...
        $rr = ( $query->authority() )[ rand($query->header->nscount()) ] ;
        if ( $rr->type eq 'NS' ) {
          $res->nameservers( $rr->nsdname() );
        } else {
          # we got some other kind of record, print it and exit...
          print $rr->print() ;
          exit 1 ;
        }
      }
    # if we got an answer we're done...
    } elsif ( $query->header->ancount() ) {
      last RECURSE ;
    }
  }
  if ( $i == 7 ) {
    die "NS query failed: Name server recursion too deep.\n"
  }

  # need to handle return of wrong type better throughout
  if ( $query->header->ancount() ) {
    print "Root delegation is to the following name servers:\n" ;
    foreach $rr ( $query->answer() ) {
      next unless $rr->type eq 'NS' ;
      printf "   %-s\n", $rr->nsdname() ;
    }
    foreach $rr ( $query->additional ) {
      push @auth, $rr->address() ;
    }
  } else {
    print "NS query failed: ", $res->errorstring, "\n";
  }

  if ( $prefix eq 'domain ' && @auth ) {
    # print "@regns @auth\n" ;
    $res->nameservers( @auth ) 
      or die "Can't change nameservers to @regns: ", $res->errorstring, "\n" ;
    $res->dnsrch(1);
    $res->recurse(1);

    print "Checking with authoritative name servers for common A records:\n" ;
    foreach $host ( '', 'www', ) {
      $fqdn  = $host ? "$host.$dnslookup" : $dnslookup ;
      $query = $res->query( $fqdn, "A");
      if ( $query ) {
        foreach $rr ( $query->answer ) {
          next unless $rr->type eq 'A' ;
          printf "  %-35s %-s\n", $host || $fqdn, $rr->address() ;
        }
      } else {
        printf "  %-35s %-s\n", $host || $fqdn, $res->errorstring ;
      }
    }

    print "Checking with authoritative name servers for MX records:\n" ;
    $query = $res->query($dnslookup, "MX");
    if ( $query ) {
      foreach $rr ( $query->answer ) {
        next unless $rr->type eq 'MX' ;
        printf "  %-35s %ld\n", $rr->exchange(), $rr->preference(), ;
      }
    } else {
      print "  MX query failed: ", $res->errorstring, "\n";
    }
  }
} else {
  warn "Net::DNS not installed.  Skipping DNS checks.\n" ;
}