#! /usr/bin/perl
#  gWhois [debian version]
#  generic Whois
#
#  (c) 1998-2004 by Lutz Donnerhacke <Lutz.Donnerhacke@Jena.Thur.de> and
#                   Michael Holzt <kju@debian.org> 
#
#  Distribution, usage etc. pp. regulated by the current version of GPL.
#  Idea: Erik.Heinz@Jena.Thur.De
#
# History:
# 2004-03-07  kju   Totally changed the ip address handling code, now uses
#                   CIDR blocks.
# 	            Recognized 'ipas a.b.c.d' as a request to ask team
#		    cymru ip->as mapper whois
# 2004-03-03  kju   Integrated smaller fixes and changes done by lutz.
#                   Removed special code for publicinterestregistry, as
#                   transition is over, and referrers are nolonger used.
#                   Changed handling code for generic whois, can now take
#                   some parameters, removing need for special cases.
# 2003-07-29  kju   fixed publicinterestregistry which is now in transition
#		    phase integrating the whois data
# 2003-02-15  kju   fixed handling of dpkg-old pattern versions
# 2003-01-27  kju   whois.publicinterestregistry.net is now authorative for
#                   .org and needs another special treatment... :-(
#                   plus some minor fixes
# 2003-01-02  f2u   Add "+" for IP address queries to ARIN whois.
#                   Support multiple pattern files.
# 2002-11-01  cord  Small workaround for whois-servers that return ^M.
# 2002-01-17  kju   Reporting if query to upstream whois server failed
#		    (Debian Bug#122535)
# 2000-12-08  kju   Braindead answers from nsiregistry excluded (NSI again!)
# 2000-06-29  lutz  Multiple whois queries (kju)
# 2000-02-29  lutz  Removed obsolete cgibr.
#             lutz  Fixed bug in IP queries.
# 2000-02-08  lutz  Braindead answers from nsiregistry excluded
#                   Workaround for bug@internic removed.
# 1999-12-01  kju   Support for new Internic two-step Whois
# 1999-08-04  lutz  Minor fixed
# 1999-07-01  lutz  Allowed spaces, commas and colons
# 1999-04-12  lutz  Hotfix for problems with LWP::Simple
# 1998-12-21  lutz  solving problems with ripe handles.
# 1998-12-18  lutz  Mirrors possible
#             kju   wwwsgrep with LWP::Simple
#             lutz  multiple options bug fixed
#             kju   whois access made with LWP::Simple
#             lutz  Cosmetic changes,
#                   Configurable,
#                   Dies without line numbers,
#                   Direct server access
#             kju   External Configuration File,
#                   Major rewrite
# 1998-12-17  lutz  Published due to kju
#

use LWP::Simple;

$ENV{'HOME'}='/var/home/whois' unless defined $ENV{'HOME'};

$| = 1;
$confdir = '/etc/gwhois';
$patternfilename = 'pattern';
$patternfilere = qr/^pattern/;
$useLWP = 1;

$sendmail = 1;
if ( -f "/etc/default/gwhois" )
{
  require "/etc/default/gwhois";
}

$step = 1;

while($ARGV[0]) {
  if($ARGV[0] eq '--help' || $ARGV[0] eq '-?') {
    print "Usage: gwhois {options} [query]\n",
          " Try find information about the query (might be multiple words).\n",
	  " If no query is given, use the first line from stdin\n\n",
	  " Options:\n",
	  "   -C dir      setting an alternate configuration directory\n",
	  "               default $confdir\n",
	  "   -h host     selecting a fixed whois server for this query\n",
	  "   -m method:host host   Defining a mirror for a given method and host.\n",
	  "   -L          use lynx -source instead of LWP::Simple\n",
	  "   -?, --help  printing this text\n\n";
    exit;
  } elsif($ARGV[0] eq '-C') {
    shift;
    $confdir = shift;
  } elsif($ARGV[0] eq '-h') {
    shift;
    $fixwhoishost = shift;
  } elsif($ARGV[0] eq '-L') {
    shift;
    $useLWP = 0;
  } elsif($ARGV[0] eq '-m') {
    shift;
    $_ = shift;
    s/://;
    $mirror{$_}=shift;
  } else {
    last;
  }
}

# $result = &whoisaccess($host,$port,$query)
sub whoisaccess {
  my ($host,$port,$query) = @_;
  my ($result);

  $query =~ s/ /%20/g;
  if (!defined( $result = $useLWP ? LWP::Simple::get("gopher://$host:$port/0$query")
                    : qx{lynx -source gopher://$host:$port/0$query} ) )
  {
    $result = 'Query to whois server failed.';
  }

  $result =~ s/
//g;
  return $result;
}

# $result = &inicwhoisaccess($host,$port,$query)
sub inicwhoisaccess {
  my ($host,$port,$query) = @_;
  my ($queryresult, $result, $result2);

  $queryresult = whoisaccess($host,$port,"=$query");

  # Result von NSI-Registry auf relevanten Part absuchen
  if ( $queryresult =~ /Name:\s+$query\s/mi ) {
    $result = "-- From: $host:$port\n\n";
    ($host) = $queryresult =~
      /Name:\s+$query\s.*?Whois Server:\s+(.*?)\s/si;
    ($relresult) = $queryresult =~
      /[\r\n]([^\r\n]+\S+\sName:\s+$query\s.*?URL[^\r\n]+)[\r\n]/si;
    
    $result .= "$relresult\n\n-- End --\n\n";
    
    print $step++,". Step: Querying $host:$port with whois.\n\n";
    $port = 43;

    $result .= "-- From: $host:$port\n\n";
    $result .= whoisaccess($host,$port,$query);
  } else {
    $result = "-- From: $host:$port\n\n$queryresult-- End --\n";
  }
  
  return $result;
}

# $result = &wwwsgrep($url,$match)
sub wwwsgrep {
  my ($url,$match) = @_;
  my ($res, $line);
  $line = $useLWP ? LWP::Simple::get($url)
                  : qx(lynx -source $url);
  $line =~ s/\n/ /g;
  if ($line =~ $match) {
    ($res) = $line =~ /$match/s;
  }
  return $res;
}

# ($method, $host, $additional) = &getmethod($query);
sub getmethod {
  my ($query) = @_;
  my $found=0;
  my ($line,$method,$host,$additional,@files);

  return('whois', $fixwhoishost, '') if $fixwhoishost; # direct access
  
  ($namewotld,$tld) = $query =~ /^(.*)\.([^.]*)$/;

  opendir(DIR, "$confdir");
  @files = sort(readdir(DIR));
  closedir(DIR);

  # Move "pattern" to the end, filter non-pattern files.
  @files = grep { ($_ =~ /$patternfilere/) 
		  && ($_ ne $patternfilename) && ($_ !~ /dpkg-old/) } @files;
  push @files, $patternfilename;

  foreach my $patternfile (@files) {
    $patternfile = "$confdir/$patternfile";

    open(PATTERN,"<$patternfile") || die "Cannot open $patternfile. STOP.\n";
  
    while ( defined($line = <PATTERN>) && (!$found) ) {
      chomp $line;

      if ( $line =~ /^#/ ) {                       # comment
      } elsif ( ($cline) = $line =~ /^:(.*)$/ ) {  # method declaration
        ($method,$host,$additional) = split(/\|/,$cline,3);
      } elsif ( $line ne '' && $query =~ $line ) {
        $found = 1;
        ($p1,$p2) = $query =~ $line;
  
        $host       =~ s/~query~/$query/;
        $host       =~ s/~namewotld~/$namewotld/;
        $host       =~ s/~tld~/$tld/;
        $host       =~ s/~1~/$p1/;
        $host       =~ s/~2~/$p2/;
  
        $additional =~ s/~query~/$query/;
        $additional =~ s/~namewotld~/$namewotld/;
        $additional =~ s/~tld~/$tld/;
        $additional =~ s/~1~/$p1/;
        $additional =~ s/~2~/$p2/;
      }
    }

  }
  if (!$found) {
    return ('','','')
  }
  $host = $mirror{$method.$host} if defined $mirror{$method.$host};
  return ($method,$host,$additional);
}

# $result=&doquery($query,$method,$host,$additional);
sub doquery {
  my ($query,$method,$host,$additional) = @_;
  my $result;

  if ($method eq 'wwwgreplv') {
    my ($a,$b) = split(/#/,$host);
    my $tmp;

    if ($b) { 
      $tmp = uc($b);
      $tmp = 'Oth' if $tmp !~ /[A-Z]/;
    } else {
      $tmp = uc($a);
    }
    $method = "wwwsgrep";
    $host = "http://www.nic.lv/DNS/list$tmp.htm";
  }

  if ($method eq 'wwwsgrep') {
    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
    my $res;

    print "Querying $hostname with http.\n\n";

    $res = &wwwsgrep($host,$additional);
 
    if ($res ne '') { 
      $result = "Match found:\n$res";
    } else {
      $result = "No match found. This probably means that this domain does not exist.";
    }
  }

  if ($method =~ /^whois(|jp|arin)$/) {
    my ($port,$noipprefix,$ipprefix,$trailer,$strip,$parameter,$outquery);

    $port       = 43;
    $noipprefix = '';
    $ipprefix   = '';
    $trailer    = '';
    $strip      = '';

    foreach $parameter (split('\|', $additional)) {
      $port       = $1 if ( $parameter =~ /port=(\d+)/ );
      $noipprefix = $1 if ( $parameter =~ /noipprefix=(.*)/ );
      $ipprefix   = $1 if ( $parameter =~ /ipprefix=(.*)/ );
      $trailer    = $1 if ( $parameter =~ /trailer=(.*)/ );
      $strip      = $1 if ( $parameter =~ /strip=(.*)/ );
    }

    print "Querying $host:$port with whois.\n";
    
    if ( $query =~ /^\d+\.\d+\.\d+\.\d+$/ ) 
    {
      $outquery = $ipprefix . $query . $trailer . "\n";
    } else
    {
      $outquery = $noipprefix . $query . $trailer . "\n";
    }
    
    $outquery =~ s/$strip//g if ( $strip ne '' );

    $result = &whoisaccess($host,$port,$outquery);

    if ( $result =~ /ReferralServer: whois:\/\/(.*)/mi )
    {
      print "Requery needed. Querying $1:43 with whois.\n";
      &requery($query);
      $result = &whoisaccess($1,43,$query);
    }

    print "\n";
  } 

  if ($method eq 'inicwhois' ) {
    my $port = $additional || 43;
    print $step++, ". Step: Querying $host:$port with whois.\n";
    $query .= "\n";
    $result = &inicwhoisaccess($host,$port,$query);
  } 

  if ($method eq 'cgi') {
    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
    print "Querying $hostname with cgi.\n\n";

    $result = `lynx -dump "$host"`;
  } 

  if ($method eq 'cgipost') {
    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
    print "Querying $hostname with cgi.\n\n";

    $result = `echo -e "$additional\n---" | lynx -dump -post_data "$host"`;
  } 

  if ($host =~ /arin/) {
    if ($result =~ /Maintainer: RIPE/) { 
      &requery($query);
      $result = &doquery($query,'whois','whois.ripe.net','');
    } elsif ($result =~ /Maintainer: AP/) { 
      &requery($query);
      $result = &doquery($query,'whois','whois.apnic.net','');
    } 
  }
 
  if ($host =~ /apnic/) {
    if ($result =~ /netname: AUNIC-AU/) { 
      &requery($query);
      $result = &doquery($query,'whois','whois.aunic.net','');
    } elsif ($result =~ /netname: JPNIC-JP/) { 
      &requery($query);
      $result = &doquery($query,'whoisjp','whois.nic.ad.jp','');
    } 
  }
 
  if ($host =~ /ripe/ && $result =~ /remarks:\s+whois -h (\S+)/) {
    &requery($query);
    $result = &doquery($query,'whois',$1,'');
  }         
     
  if (($host =~ /internic/) && ($result =~ /No match for/) &&
      ($query !~ /\.(arpa|com|edu|net|org)$/) ) {
    my $result1=&doquery($query,'whois','whois.ripe.net','');
    if ($result1 !~ /No entries found/) {
      &requery($query);
      $result = $result1; 
    }
  }

  return $result;
}

# &requery($query)
sub requery {
  my ($query) = @_;
  
  if ( $sendmail ) 
  {
    open(MAIL,'| mailx -s "Whois Requering" requery@whois.fqdn.org') &&
    print MAIL $query, "\n";
    close(MAIL);
  }
}

sub main {
  my $query = lc shift;
  chomp $query;

  $query =~ s/^\s+//;
  $query =~ s/\s+$//;
  $query =~ y/[\xA0-\xFF]a-z0-9:.,+_ -//cd;
  $query =~ s/\.$//;

  my ($method,$host,$additional);
  print "Process query: '$query'\n";
  if ($query !~ /[^0-9\.]/) { # ip
    my ($a, $b, $c, $d, $e);
    ($a, $b, $c, $d, $e) = $query =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(.*)/;
    if ($a > 255 || $b > 255 || $c > 255 || $d > 255 || $e ne '') {
      die "$query is no valid IP-Address and no valid Domainname.\n";
    }
    print "Query recognized as IP.\n";

    my ($lookupip, $ip, $mask, $cidr);
    $ip   = $a<<24|$b<<16|$c<<8|$d;
    $mask = 256**4;

    for ($a=32;$a>=0&&$method eq '';$a--)
    {
      $lookupip   = $ip & $mask;
      $mask     <<= 1;

      if ( $a > 24 ) 
      {
        $cidr = sprintf("%d.%d.%d.%d/$a", $lookupip>>24, ($lookupip>>16)&0xFF,
          ($lookupip>>8)&0xFF, $lookupip&0xFF);
      } elsif ( $a > 16 )
      {
        $cidr = sprintf("%d.%d.%d/$a", $lookupip>>24, ($lookupip>>16)&0xFF,
          ($lookupip>>8)&0xFF);
      } elsif ( $a > 8 )
      {
        $cidr = sprintf("%d.%d/$a", $lookupip>>24, ($lookupip>>16)&0xFF);
      } else
      {
        $cidr = sprintf("%d/$a", $lookupip>>24);
      }

      ($method,$host,$additional) = &getmethod("=$cidr");
    }
  } else {
    ($method,$host,$additional) = &getmethod($query);
  }

  die "Can't get method for Query. Should not happen. STOP.\n"
    if ($method eq '');  

  my $result = &doquery($query,$method,$host,$additional);
  print $result,"\n\n";

  print "\n-- \n  To resolve one of the above handles: ";
 
  if ($method =~ /whois/) {
    print "whois -h $host";
    print ":$1" if ( $additional =~ /port=(\d+)/ );
    print " HANDLE\n";
  }

  if ($method eq "cgipost") {
    print "\n     POST $host\n";
    print "     $additional\n";
  }

  if ($method eq "cgi") {
    print "\n     $host\n";
  }

  if ($method eq "wwwgrep") {
    print "\n     hmm. not sure.\n";
  }

  print "  OTOH offical handles should be recognised directly.\n";
  print "  Please report errors or misfits via the debian bug tracking system.\n";
}

if($ARGV[0]) {
  $_ = join(' ',@ARGV);
} else {
  $_ = <>;
  chomp;
}
&main($_);

