#! /usr/bin/perl
#  gWhois
#  generic Whois
#
#  (c) 1998, 1999 by Lutz Donnerhacke <Lutz.Donnerhacke@Jena.Thur.de> and
#                    Michael Holzt <kju@flummi.de> 
#
#  Distribution, usage etc. pp. regulated by the current version of GPL.
#  Idea: Erik.Heinz@Jena.Thur.De
#
# History:
# 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;

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

require "$confdir/debconf.inc";

$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.';
  }
  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 ) {
    ($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 = "-- From: $host:$port\n\n$relresult\n\n-- End --\n";
    
    print $step++,". Step: Querying $host:$port with whois.\n\n";
    $port = 43;

    $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 $patternfile = "$confdir/$patternfilename";
  my $found=0;
  my ($line,$method,$host,$additional);

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

  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 eq 'whois' || $method eq 'whoisjp') {
    my $port = 43;
    $port = $1 if $additional =~ s/(\d+)\|//;
    print "Querying $host:$port with whois.\n\n";
    $query .= "/e" if ($method eq 'whoisjp');
    $query .= "\n";
    $result = &whoisaccess($host,$port,$query);
    foreach $host (split('\|', $additional)) {
      print "Querying $host:$port with whois.\n\n";
      $result .= "\n\n----------$host----------\n";
      $result .= &whoisaccess($host,$port,$query);
    }
  } 

  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" lutz@iks-jena.de') &&
    print MAIL $query, "\n";
    close(MAIL);
  }
}

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

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

  my ($method,$host,$additional);
  print "Process query: '$query'\n";
  if ($query !~ /[^0-9\.]/) { # ip
    ($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";
    $query = "~$a.$b.$c.$d";
    ($method,$host,$additional) = &getmethod($query);
    $query =~ s/^~//;
  } 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 ":$additional" if $additional;
    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($_);

