Diff of /package/bin/gwhois

Last modified: 2015-08-12 19:36:34

Download viathinksoft-patched | Download 20120626-1

--- /daten/vwhois/gwhois_fork/source_20120626-1/package/gwhois      2015-04-17 23:30:06.000000000 +0200
+++ /daten/vwhois/gwhois_fork/source_patch/package/bin/gwhois      2015-08-12 19:36:34.000000000 +0200
 -2,14 +2,48 
 #
 #  generic Whois
 #
-#  (c) 1998-2010 by Juliane Holzt
+#  (c) 1998-2010 by Juliane Holzt <debiankju.de>
 #  Some early parts by Lutz Donnerhacke <Lutz.DonnerhackeJena.Thur.de>
 #
+#  Modifications (c) 2010-2015 by Daniel Marschall, ViaThinkSoft <infodaniel-marschall.de>
+#
 #  Distribution, usage etc. pp. regulated by the current version of GPL.
 #
 #
 #
 # History:
+# 2015-05-06  mar   pattern.d/* will now be preferred.
+#                   Last resort (.) is now built-in.
+#                   Fixed UTF-8 query input.
+# 2014-08-18  mar   UTF-8 output is now unified.
+# 2014-04-02  mar   Accepting "refer:" which IANA sends.
+# 2013-12-17  mar   Added native OID support. Output will now contain a BOM if whois server did return a UTF-8 string.
+# 2013-05-05  mar   *.dpkg-dist wird nun auch ausgeschlossen.
+# 2012-05-22  mar   "::::" (multiple+notice) is now not splitted by ":::" pattern
+#                   multiple+notice can now be combined. "notice" will output "Additional information" then.
+# 2012-05-22  mar   Output of "cgihttps" and "program" is now anti spam filtered, too
+# 2012-04-26  mar   "--" is now recognized as command line argument seperator
+# 2012-04-25  mar   E-Mail addresses are now anti-spam protected! (Can be disabled with the CLI argument flag -e)
+#                   This allows to add "RIPE -B" as default for public services.
+# 2012-04-13  mar   Changed all &foo() into foo() .
+#                   See: https://www.socialtext.net/perl5/subroutines_called_with_the_ampersand
+# 2012-04-01  mar   New pattern available for recognizing ASN number ranges
+#                   e.g. *AS:123-456 will match AS123, AS124 ... AS456
+# 2012-03-04  mar   Bugfix for IPv6 recognization
+# 2012-02-26  mar   IPv6 is now handled with Net::IP::ip_expand_address()
+# 2012-01-28  mar   rwhois is now accepted as ReferralServer
+#                   GWhoIs::Core::redirectwhois can handle different port than 43
+# 2012-01-17  mar   quotemeta() to avoid shell injections
+#                  TODO: braucht man eigentlich nicht wegen der ursp. filterung
+# 2012-01-10  mar   <pre> and <textarea> use now GWhoIs::Utils::htmlpre(). GWhoIs::Utils::render_html() optimized.
+#                   Uses now STRICT perl code (used "my" everwhere and initialized variables)
+#                   No warning at utf8 output, e.g. for cnnic.cn => UTF8 now possible.
+# 2012-01-09  mar   Now recognizing "001.2.3.4" as "1.2.3.4" (IPv4 and IPv6)
+# 2012-01-07  mar   Now supporting IPv6 subnetting / CIDR
+# 2011-06-09  mar   Added "program" method which invokes a script.
+#                   IPv4/6 detection: IPv6 needs at least one ":"
+#                   -> e.g. "ac" can now be detected as TLD and not as IPv6 anymore.
+#                   "To resolve one of the above handles" cannot be empty now.
 # 2010-07-28  jule  Extend output from verisign-grs by last db update time
 # 2010-05-15  jule  Add locale handling, use libidn for punycode
 # 2008-10-19  jule  throw error on empty query string
 -64,7 +98,7 
 # 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
-#             jule  wwwsgrep with LWP::Simple
+#             jule  GWhoIs::Core::wwwsgrep with LWP::Simple
 #             lutz  multiple options bug fixed
 #             jule  whois access made with LWP::Simple
 #             lutz  Cosmetic changes,
 -76,28 +110,75 
 # 1998-12-17  lutz  Published due to jule
 #
 
-use LWP::Simple;
-use encoding ':locale';
+
+# todo
+# * print whois parameters at "querying..."

+# * regularly check https://bugs.debian.org/cgi-bin/pkgreport.cgi?src=gwhois
+
+# TODO: "%" am Anfang jeder Meldung ausgeben
+

+# TODO: Alle "!!" entfernen
+# TODO: print -> $result .= ?
+
+use warnings;
+use strict;
+
+use lib '/usr/share/gwhois/includes/';
+use GWhoIs::Core;
+use GWhoIs::Utils;
+use GWhoIs::IPv4;
+use GWhoIs::IPv6;
+use GWhoIs::OID;
+
+# install with "cpan Net::IP" or "aptitude install libnet-ip-perl"
+use Net::IP;
+
 use Net::LibIDN;
+use Encode;
+# use Encode::Detect::Detector; # requires Debian package libencode-detect-perl
+
+#use encoding ':locale';
+
+#use utf8;
+
+
+# Examples for output of the different hosts:
+# -------------------------------------------------------------
+# Host                            Example    Output         BOM
+# -------------------------------------------------------------
+# whois.viathinksoft.de           oid:2.999  UTF-8          if required (existing BOMs will be removed)
+# cnnic.cn                        cnnic.cn   UTF-8          no
+# whois.ati.tn                    ati.tn     UTF-8          no
+# whois.kr                        whois.kr   UTF-8          no
+# whois.denic.de                  denic.de   ISO-8859-1     no
+# oldwhois.kisa.or.kr (obsolete)  whois.kr   EUC-KR         no
+# whois.nic.ch                    domian.ch  UTF-8          no
+# (GWHOIS from ViaThinkSoft)                 UTF-8          yes (existing BOMs will be removed?)
+# (old GWHOIS)                               (like server)  (like server)
+# -------------------------------------------------------------
+
+
+# TODO: for this diagram: check if existing BOMs will be removed, e.g. by LWP.
+# TODO: how to stop LWP's auto-detect magic?
+# TODO: only output bom if required? doesn't work, otherwise we would need to buffer stderr and stdout, and then their order is wrong again.
+
 
 $ENV{'HOME'}='/var/home/whois' unless defined $ENV{'HOME'};
 
-$version = '20100728';
+# Nicht nach GWhoIs::Core auslagern
+# TODO: die $version auch von den .pm Modulen anzeigen?
+my $version = '20100728+viathinksoft20150719';
+my $fixwhoishost;
+my $rawoutput = 0;
 
-$| = 1;
-$confdir = '/etc/gwhois';
-$patternfilename = 'pattern';
-$patternfilere = qr/^pattern/;
-$useLWP = 1;
-
-$sendmail = 1;
-if ( -f "/etc/default/gwhois" )
-{
+$| = 1; # buffer flushing = autoflush
+
+if ( -f "/etc/default/gwhois" ) {
   require "/etc/default/gwhois";
 }
 
-$step = 1;
-
 while($ARGV[0]) {
   if($ARGV[0] eq '--help' || $ARGV[0] eq '-?') {
     print "gwhois - generic whois\n",
 -106,616 +187,279 
           " 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",
-        "   -v          output version of pattern table(s)\n",
-        "   -?, --help  printing this text\n\n";
+            "   -C dir                  Setting an alternate configuration directory\n",
+            "                           default: $GWhoIs::Core::confdir\n",
+            "   -h host                 Selecting a fixed whois server for this query\n",
+            "   -m method:host mirror   Defining a mirror for a given method and host.\n",
+            "   -L                      Use lynx -source instead of LWP::Simple\n",
+            "   -e                      Do not protect eMail addresses\n",
+            "   -c                      Do not try to convert to UTF-8. Output server's stream.\n",
+            "   -v                      Output version of pattern table(s)\n",
+            "   -?, --help              Printing this text\n\n";
     exit;
   } elsif($ARGV[0] eq '-C') {
     shift;
-    $confdir = shift;
+            $GWhoIs::Core::confdir = shift;
+      } elsif ($ARGV[0] eq '-c') {
+            shift;
+            $rawoutput = 1;
+            $GWhoIs::Core::useLWP = 0; # TODO: geht irgendwie nicht anders
   } elsif($ARGV[0] eq '-h') {
     shift;
     $fixwhoishost = shift;
   } elsif($ARGV[0] eq '-L') {
     shift;
-    $useLWP = 0;
+            $GWhoIs::Core::useLWP = 0;
   } elsif($ARGV[0] eq '-m') {
     shift;
     $_ = shift;
     s/://;
-    $mirror{$_}=shift;
+            $GWhoIs::Core::mirror{$_} = shift;
+      } elsif ($ARGV[0] eq '-e') {
+            shift;
+            $GWhoIs::Core::antispam = 0;
   } elsif($ARGV[0] eq '-v') {
     print "gwhois - generic whois\n\n",
           "program version:  $version\n",
           "pattern tables:   ";
-    foreach $patternfile (&getpatternfiles()) {
-      $patternfile = "$confdir/$patternfile";
-      if ( open(PATTERN,"<$patternfile") )
-      {
-        $line = <PATTERN>;
+            foreach my $patternfile (GWhoIs::Core::getpatternfiles()) {
+                  if (!open(PATTERN,"<$patternfile")) {
+                        warn "Cannot open $patternfile. STOP.\n";
+                        exit 1;
+                  }
+
+                  my $line = <PATTERN>;
         close(PATTERN);
         
-        ($version) = $line =~ /#:\s+version\s+(\S+)/;
-        $version = 'unknown' if ( $version eq '' );
-        print "$version\t($patternfile)\n                  ";
+                  my $patternversion;
+                  if (defined($line)) {
+                        ($patternversion) = $line =~ /#:\s+version\s+(\S+)/;
+                        $patternversion = 'unknown' if !defined($patternversion);
+                  } else {
+                        $patternversion = 'unknown';
       }
+                  print "$patternversion\t($patternfile)\n                  ";
     }  
     print "\n";
-    exit(0);
-  } else 
-  {
+            exit 0;
+      } elsif ($ARGV[0] eq '--') {
+            shift;
     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.*?Expiration Date:[^\r\n]+)[\r\n]/si;
-    ($relresult) = $queryresult =~
-      /[\r\n]([^\r\n]+\S+\sName:\s+$query\s.*?<<<)[\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;
-}
-
-# ($host, $additional) = &methodpatternregex($query,$host,$additional,$queryline);
-sub methodpatternregex {
-  my ($query,$host,$additional,$line) = _;
-
-  my ($namewotld,$tld) = $query =~ /^(.*)\.([^.]*)$/;
-  my ($p1,$p2) = $query =~ $line;
-  my ($ucq) = uc($query);
-  
-  $host       =~ s/~query~/$query/;
-  $host       =~ s/~ucquery~/$ucq/;
-  $host       =~ s/~namewotld~/$namewotld/;
-  $host       =~ s/~tld~/$tld/;
-  $host       =~ s/~1~/$p1/;
-  $host       =~ s/~2~/$p2/;
-  
-  $additional =~ s/~query~/$query/;
-  $additional =~ s/~ucquery~/$ucq/;
-  $additional =~ s/~namewotld~/$namewotld/;
-  $additional =~ s/~tld~/$tld/;
-  $additional =~ s/~1~/$p1/;
-  $additional =~ s/~2~/$p2/;
-  
-  return ($host,$additional);
-}
-
-# patternfiles = &getpatternfiles()
-sub getpatternfiles {
-  my (files);
-
-  # Find available pattern files
-  opendir(DIR, "$confdir");
-  files = sort(readdir(DIR));
-  closedir(DIR);
-
-  # Move "pattern" (main file) to the end, filter non-pattern files (and old -erx ones).
-  files = grep { ($_ =~ /$patternfilere/) 
-              && ($_ ne $patternfilename) && ($_ !~ /\.dpkg-new$/) && ($_ !~ /\.dpkg-old$/) && ($_ !~ /\.orig$/) && ($_ !~ /-erx/) } files;
-  push files, $patternfilename;
-
-  return (files);
-}
-
-
-# ($method, $host, $additional) = &getmethodother($query);
-sub getmethodother {
-  my ($query) = _;
-  my $found=0;
-  my ($line,$cline,$method,$host,$additional,files);
-
-
-  # Process file until we found a match
-  foreach my $patternfile (&getpatternfiles()) {
-    $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/i ) {
-        $found = 1;
-        ($host,$additional) = &methodpatternregex($query,$host,$additional,$line);
-      }
-    }
-
-  }
-  if (!$found) {
-    return ('','','')
-  }
-  $host = $mirror{$method.$host} if defined $mirror{$method.$host};
-  return ($method,$host,$additional);
-}
-
-
-# %v4pattern = &getpatternv4()
-sub getpatternv4 {
-  my (%pattern);
-  my ($method,$host,$additional,$cline,$line,$rehost,$readditional);
-
-  foreach my $patternfile (&getpatternfiles()) {
-    $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 =~ /^=/ ) {
-        ($rehost,$readditional) = &methodpatternregex($query,$host,$additional,$line);
-        $pattern{$line}{'method'} = $method;
-        $pattern{$line}{'host'}   = $rehost;
-        $pattern{$line}{'add'}    = $readditional;
-      }
-    }
+            last;
   }
-  return (%pattern);
 }
 
-
-# ($method, $host, $additional) = &getmethodv4($query);
-sub getmethodv4 {
-  my ($ipa, $ipb, $ipc, $ipd) = _;
-  my ($ip, $bits, $netmask, $method, $host, $additional, %pattern);
-  
-  $ip      = $ipa<<24|$ipb<<16|$ipc<<8|$ipd;
-  $netmask = 256**4-1;
-  %pattern = &getpatternv4();
-  
-  for ($bits=32;$bits>=0&&$method eq '';$bits--)
-  {
-    $ip        = $ip & $netmask;
-    $netmask <<= 1;
-
-    if ( $bits > 24 ) {
-      $cidr = sprintf("%d.%d.%d.%d/$bits", $ip>>24,($ip>>16)&255,($ip>>8)&255,$ip&255);
-    } elsif ( $bits > 16 ) {
-      $cidr = sprintf("%d.%d.%d/$bits", $ip>>24,($ip>>16)&255,($ip>>8)&255);
-    } elsif ( $bits > 8 ) {
-      $cidr = sprintf("%d.%d/$bits", $ip>>24,($ip>>16)&255);
+if ($rawoutput) {
+      binmode(STDOUT, ":bytes");
+      binmode(STDERR, ":bytes");
     } else {
-      $cidr = sprintf("%d/$bits", $ip>>24);
-    }

-    $method     = $pattern{"=$cidr"}{'method'};
-    $host       = $pattern{"=$cidr"}{'host'};
-    $additional = $pattern{"=$cidr"}{'add'};
+      binmode(STDOUT, ":utf8");
+      binmode(STDERR, ":utf8");
   }
   
-  return ($method,$host,$additional);
-}
-
-  
-# $rendered = &render_html($html);
-sub render_html
-{
-  my ($html) = _;
-
-  $html =~ s|\n||g;
-
-  $html =~ s|<br/{0,1}>|\n|gsi;
-  $html =~ s|<br\s.*?>|\n|gsi;
-
-  $html =~ s|<p/{0,1}>|\n|gsi;
-  $html =~ s|<p\s.*?>|\n|gsi;
-
-  $html =~ s|<tr/{0,1}>|\n|gsi;
-  $html =~ s|<tr\s.*?>|\n|gsi;
-  
-  $html =~ s|<script.*?</script>||gsi;
-  $html =~ s|\<.*?\>||gsi;
-  $html =~ s|&nbsp;| |gsi;
-  $html =~ s| \t| |gsi;
-  $html =~ s|\s*\n\s*\n|\n|gsi;
-  $html =~ s|^\s*||gm;
-  
-  return($html);
+if (defined $ARGV[0]) {
+      $_ = join(' ', ARGV);
+} else {
+      # If no parameter is given, await an input from STDIN
+      $_ = <>;
+      chomp;
 }
 
+print "\x{FEFF}" if !$rawoutput; # BOM
+exit main($_);
 
-sub redirectwhois 
-{
-  my ($query,$host) = _;
-
-  # check for query modifier (if any)
-  my ($modmethod, $modhost, $modadditional) = &getmethodother("redirect:$host");
-
-  return &doquery($query,$modmethod,$modhost,$modadditional)
-    if ( $modmethod ne 'none');
-    
-  return &doquery($query,'whois',$host,'')
-}
+# -----------------------------------------------------------------------------------------
 
+sub main {
+      my $query = shift;
 
-# $result=&doquery($query,$method,$host,$additional);
-sub doquery {
-  my ($query,$method,$host,$additional) = _;
-  my $result;
+      $query = '' if !defined $query;
 
-  if ($method eq 'multiple') {
-    my $triple;
-    foreach $triple ( split(/:::/, $additional) )
-    {
-      ($method,$host,$additional) = split(/::/, $triple);
-      $result .= &doquery($query, $method, $host, $additional);
-      $result .= "\n\n------\n\n";
+      if (GWhoIs::Utils::is_utf8($query)) {
+            $query = Encode::decode('utf8', $query);
     }
+      $query = GWhoIs::Utils::trim($query);
     
-    # done
-    $method = '';
+      if ($query eq '') {
+            warn "Query is empty.\n";
+            exit 2;
   } 
 
+      my ($method,$host,$additional);
 
-  if ($method eq 'wwwgreplv') {
-    my ($a,$b) = split(/#/,$host);
-    my $tmp;
+      my $query_utf8 = GWhoIs::Utils::enforce_utf8($query);
+      print "Process query: '$query_utf8'\n\n";
 
-    if ($b) { 
-      $tmp = uc($b);
-      $tmp = 'Oth' if $tmp !~ /[A-Z]/;
+      if ( $fixwhoishost ) {

+            ($method,$host,$additional) = ('whois',$fixwhoishost,'');
     } else {
-      $tmp = uc($a);
+            # if ($query !~ /[^0-9\.]/) { # ipv4
+            if ($query =~ /^[0-9\.]*$/) {
+                  my ($a, $b, $c, $d, $e) = $query =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(.*)/;
+                  $a = 256 if !defined $a;
+                  $b = 256 if !defined $b;
+                  $c = 256 if !defined $c;
+                  $d = 256 if !defined $d;
+                  $e = ''  if !defined $e;
+                  if ($a > 255 || $b > 255 || $c > 255 || $d > 255 || $e ne '') {
+                        warn "'$query' is no valid IP address, ASN, OID or domain name.\n";
+                        exit 2;
     }
-    $method = "wwwsgrep";
-    $host = "http://www.nic.lv/DNS/list$tmp.htm";
+                  print "Query recognized as IPv4.\n";
+
+                  ($method,$host,$additional) = GWhoIs::IPv4::getmethodv4($a,$b,$c,$d);
+            # } elsif ( lc($query) !~ /[^0-9a-f:]/i ) { # ipv6
+            # } elsif ( $query !~ /[0-9a-f:]*/ ) {
+            } elsif (($query =~ /:/ ) && ( Net::IP::ip_expand_address($query, 6) =~ /^[0-9a-f:]*:[0-9a-f:]*$/ )) { # at least one ":" so that e.g. "ac" is recognized as TLD and not as IPv6
+                  # check and correct v6 address
+                  if ( $query =~ /[0-9a-f]{5}/ || $query =~ /:::/ ) {
+                        warn "'$query' is an invalid IPv6 address.\n";
+                        exit 2;
   }
 
-  if ($method eq 'wwwsgrep') {
-    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
-    my $res;
+                  my $orig_query = $query;
+                  #$query =~ s/:?$/::/ if ( $query !~ /(.*:){7}/ && $query !~ /::/ );
+                  $query = Net::IP::ip_expand_address($query, 6);
 
-    print "Querying $hostname with http.\n\n";
+                  print "Query recognized as IPv6.\n";
+                  print "Address expanded to '$query'.\n" if $orig_query ne $query;
 
-    $res = &wwwsgrep($host,$additional);
+                  ($method,$host,$additional) = GWhoIs::IPv6::getmethodv6($query);
+            } elsif ($query =~ /^(urn:){0,1}oid:/i ) { # OID
+                  print "Query recognized as OID.\n";
  
-    if ($res ne '') { 
-      $result = "Match found:\n$res";
-    } else {
-      $result = "No match found. This probably means that this domain does not exist.";
-    }
-  }
+                  # preliminarily remove urn: and oid: from query
+                  # we need a dot so that we can use "oid:." in our patternfile too
+                  $query = GWhoIs::OID::normalize_oid($query);
 
-  if ($method eq 'wwwpe') {
-    # why does every shitty nic need to invent its own standard?
-    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
-    my $res;
+                  my arcs = split(/\./, $query); # TODO: warum geht split('.',$oid) nicht?
 
-    print "Querying $hostname with http.\n";
+                  ($method,$host,$additional) = GWhoIs::OID::getmethodoid(arcs);
 
-    $res = &wwwsgrep($host,$additional);
+                  # Whois OID query syntax definition by ViaThinkSoft (TODO: Apply for RFC):
+                  # - urn:oid:2.999 or oid:2.999
+                  # - Case insensitive
+                  # - Leading dot should be tolerated (urn:oid:.2.999)
+                  # - Leading zeros should be tolerated (urn:oid:.002.00999)
+                  # Idea: Should "oid:" be optional? Since 2.999 cannot be an IP ... But 1.2.3.4 could be one ...
  
-    if ($res ne '') { 
-      $result = "Match found. Now querying for the domain data.\n\n";
-      $result .= &doquery($query,'cgi','http://www.nic.pe/' . $res, '');
+                  # There are many possibilities. We choose "oid:.2.999"
+                  $query = 'oid:' . GWhoIs::OID::normalize_oid($query);
     } else {
-      $result = "No match found. This probably means that this domain does not exist.";
-    }
-  }
+                  # Last resort: Query is probably a TLD, domain or handle, but we are not sure!
+                  # print "Query recognized as domain.\n";
 
-  if ($method eq 'wwwgh') {
-    # why does every shitty nic need to invent its own standard?
-    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
-    my $res;
+                  # Dot exists?      Type?      Punycode?      Filtering?
+                  # ------------------------------------------------
+                  # Yes            Domain      Yes            Yes
+                  # No            TLD      Yes            Yes
+                  # No            Handle      No*            Maybe
+                  # ------------------------------------------------
+                  # * = but it is unlikely that a handle contains non-latin characters
 
-    ($dom,$sld) = $query =~ /(.*?)\.(com|org|gov|edu|biz)\.gh$/;
-    $res = &doquery('','cgipost','http://www.nic.gh/customer/result_c.php',
-      "r_cdm=$dom&r_dom_slvl=$sld&Submit=Search");
-
-    if ( $res =~ m|(customer/displayresult_c.php\?id=\d+)|s )
-    {
-      $result = "Match found. Now querying for the domain data.\n\n";
-      $result .= &doquery($query,'cgi',"http://www.nic.gh/$1");
+                  # Filtering
+                  $query =~ y/[\x{00A0}-\x{FFFF}]a-zA-Z0-9:.,+_ -//cd;
+                  $query =~ s/\.$//;
+                  my $query_utf8_filtered = GWhoIs::Utils::enforce_utf8($query);
+                  if ( $query_utf8 ne $query_utf8_filtered ) {
+                        # QUE: warn or print?
+                        warn "Attention: Query was filtered to '$query_utf8_filtered'.\n\n";
+                  }
+
+                  # Punycode decoding
+                  # my $ascii_query = Net::LibIDN::idn_to_ascii($query, 'utf-8')
+                  # We separate between spaces, so that "tld <unicode>" can be processed
+                  my query_split = split(' ', $query);
+                  query_split = map { Net::LibIDN::idn_to_ascii($_, 'utf-8') || '' } query_split;
+                  my $ascii_query = join(' ', query_split);
+
+                  # Query valid?
+                  if (!$ascii_query) { # e.g. $query = ".x"
+                        warn "'$query_utf8' is an invalid domain name.\n";
+                        return 2;
+                  }
+
+                  # Just information for the user
+                  if (index($query, ".") != -1) {
+                        print "Query recognized as domain.\n\n"; # TODO: aber wenn kein IDN?
     } else {
-      $result = "No match found. This probably means that this domain does not exist.";
-    }
+                        print "Query is probably a handle or TLD.\n\n";
   }
 
-  if ($method eq 'wwwbi') {
-    # why does every shitty nic need to invent its own standard?
-    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
-    my $res;
-
-    print "Querying $hostname with http.\n";
-
-    # Get session URL
-    $res = &wwwsgrep($host,$additional);
-    
-
-#    print "$res\n"; exit;
-    # Get lookup
-    $result = &doquery($query,'cgi',"$host?card=$res&f_1.qdomain=$query&f_1.type=domain&f_1.q=Search");
+                  ($method,$host,$additional) = GWhoIs::Core::getmethodother($ascii_query);
   }
-
-  if ($method eq 'wwwbm') {
-    # why does every shitty nic need to invent its own standard?
-    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
-    my $res;
-
-    print "Querying $hostname with http.\n";
-
-    # Get session URL
-    $res = &wwwsgrep($host,$additional);
-    
-    # Get lookup
-    $result = &doquery($query,'cgipost',"http://$hostname$res",
-      "ADOM++++++=$query&_PROCESS=BMWHO+&_FUNCTION=BMWHO2+",
-    ); 
   }
 
-
-  if ($method eq 'wwwbz') {
-    # why does every shitty nic need to invent its own standard?
-    my $hexstring;
-    $hexstring = $query;
-    $hexstring =~ s/./sprintf("%02x",ord("$&"))/eg;
-    
-    $result = &doquery($query,'cgi',$host.$hexstring,'');
+      if ($method eq '') {
+            warn "I don't know where to query that.\n";
+            warn "If this is a valid domainname or handle, please file a bug report.\n";
+            return 1;
   }
 
-  if ($method =~ /^whois(|jp|arin)$/) {
-    my ($port,$trailer,$strip,$parameter,$outquery,$prefix);

+      # Grund: Dann kann auch bei redirectwhois() dementsprechend in jedem Zwischenschritt gehandelt werden.
+      # $host = $GWhoIs::Core::mirror{$method.$host} if defined $GWhoIs::Core::mirror{$method.$host};
 
-    $port       = 43;
-    $noipprefix = '';
-    $ipprefix   = '';
-    $trailer    = '';
-    $strip      = '';
+      my ($result, $exitcode) = GWhoIs::Core::doquery($query,$method,$host,$additional);
+      $result = '' if !defined $result; # should not happen!
 
-    foreach $parameter (split('\|', $additional)) {
-      $port       = $1 if ( $parameter =~ /port=(\d+)/ );
-      $trailer    = $1 if ( $parameter =~ /trailer=(.*)/ );
-      $strip      = $1 if ( $parameter =~ /strip=(.*)/ );
-      $prefix     = $1 if ( $parameter =~ /prefix=(.*)/ );
+      my $antispam_replacements = 0;
+      if ($GWhoIs::Core::antispam) {
+            # Protect email addresses (to allow e.g. "RIPE -B" for public services)
+            # Note: eMail addresses have a much more complex structure, see http://code.google.com/p/isemail/
+            # But this Regex should still prevent spammers from filtering eMail addresses,
+            # even if e.g. the "wrong" (e.g. escaped) "" is protected.
+            $antispam_replacements = $result =~ s/(\S+)(\S+)\.([^.\s]+)/$1 (at) $2 (dot) $3/g;
+            # Alternative solution:
+            # $antispam_replacements = $result =~ s/(\S+)(\S+)\.([^.\s]+)/$1&$2.$3/g;
     }
  
-    print "Querying $host:$port with whois.\n";
-    
-    $outquery = $prefix . $query . $trailer . "\n";
-    $outquery =~ s/$strip//g if ( $strip ne '' );
+      # We try to get $result to wide-string. Functions like LWP::Simple automatically convert UTF-8 into Unicode
+      # (even without BOM sent through the whois gopher channel!), while subprograms and other methods are providing
+      # raw UTF-8 data.
+      $result = Encode::decode('utf8', GWhoIs::Utils::trim($result), Encode::FB_CROAK) if !$rawoutput && GWhoIs::Utils::is_utf8($result);
 
-    $result = &whoisaccess($host,$port,$outquery);
+      # Don't allow DOS format
+      $result =~ s/(\012|\015\012?)/\n/g;
 
-    if ( $result =~ /ReferralServer: whois:\/\/(.*):43/mi ||
-         $result =~ /ReferralServer: whois:\/\/(.*)/mi )
-    {
-      $result = &redirectwhois($query,$1);
-      $host = '';
-    } elsif ( $result =~ /ReferralServer: whois:\/\/(.*):(\d+)/mi )
-    {
-      $result = &whoisaccess($1,$2,$query);
-    }
+      # Output everything
+      print GWhoIs::Utils::trim($result), "\n\n";
     
+      if ($antispam_replacements > 0) {
+            print "Note: The output has been modified by GWhoIs.\n";
+            print "$antispam_replacements eMail addresses have been anti-spam protected.\n";
+            print "(Disable protection with \"gwhois -e\")\n";
     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";
-#!!
-#    print "$host\n";
-
-#    $result = `lynx -dump "$host"`;
-  
-    my $html = `lynx -source "$host"`;
-    $result = &render_html($html);
-  } 
-
-  if ($method eq 'cgipost') {
-    my ($hostname) = $host =~ /http:\/\/([^\/]*)\//;
-    print "Querying $hostname with cgi.\n\n";
-#!!   
-#    print "echo -e '$additional\n---' | lynx -dump -post_data '$host'\n";
-
-    $result = `echo -e "$additional\n---" | lynx -dump -post_data "$host"`;
-  } 
-
-  if ($method eq 'cgipostcurl') {
-    my ($hostname) = $host =~ /https{0,1}:\/\/([^\/]*)\//;
-    print "Querying $hostname with cgi.\n\n";
-#    print "$additional\n"; #!!
-#    print "curl --stderr /dev/null -e $host --data '$additional' $host | lynx -dump -stdin\n";
-    $result = `curl --stderr /dev/null -e "$host" --data "$additional" "$host" | lynx -dump -stdin`;
-  } 
-
-  if ($method eq 'cgihttps') {
-    my ($hostname) = $host =~ /https:\/\/([^\/]*)\//;
-    print "Querying $hostname with cgi.\n\n";
-#    print "$additional\n"; #!!
-#    print "curl --stderr /dev/null $host | lynx -dump -stdin\n";
-#    $result = `curl --insecure --stderr /dev/null "$host" | lynx -dump -stdin`;
-    my $html = `curl --insecure --stderr /dev/null "$host"`;
-    print &render_html($html);
-  } 
-
-  if ($method eq 'notice') {
-    $result = "\n\nNo lookup service available for your query '$query'.\ngwhois remarks: " . $additional . "\n\n";
   }
 
-  if ($host =~ /arin/) {
-    if ($result =~ /Maintainer: RIPE/) { 
-      $result = &redirectwhois($query,'whois.ripe.net');
-    } elsif ($result =~ /Maintainer: AP/) { 
-      $result = &redirectwhois($query,'whois.apnic.net');
-    } 
-  }

-  if ($host =~ /apnic/) {
-    if ($result =~ /netname: AUNIC-AU/) { 
-      $result = &redirectwhois($query,'whois.aunic.net');
-    } elsif ($result =~ /netname: JPNIC-JP/) { 
-      $result = &redirectwhois($query,,'whois.nic.ad.jp');
-    } 
-  }

-  if ($host =~ /ripe/ && $result =~ /remarks:\s+whois -h (\S+)/) {
-    $result = &redirectwhois($query,$1);
-  }         
-     
-  if (($host =~ /internic/) && ($result =~ /No match for/) &&
-      ($query !~ /\.(arpa|com|edu|net|org)$/) ) {
-    my $result1=&redirectwhois($query,'whois.ripe.net');
-    if ($result1 !~ /No entries found/) {
-      $result = $result1; 
-    }
-  }
-
-  return $result;
-}
-
-sub main {
-  my $query = shift;
-  chomp $query;
-
-  $query =~ s/^\s+//;
-  $query =~ s/\s+$//;
-  $query =~ y/[\xA0-\xFF]a-zA-Z0-9:.,+_ -//cd;
-  $query =~ s/\.$//;
-
-  my ($method,$host,$additional);
-  print "Process query: '$query'\n";
-  if ( $fixwhoishost )
-  {
-    ($method,$host,$additional) = ('whois',$fixwhoishost,'');
-  } else
-  {
-    if ($query eq ''){
-      die "Query is empty.\n";
-    }
-  
-    if ($query !~ /[^0-9\.]/) { # ipv4
-      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 IPv4-Address and no valid Domainname.\n";
-      }
-      print "Query recognized as IPv4.\n";
-    
-      ($method,$host,$additional) = &getmethodv4($a,$b,$c,$d);
-    } elsif ( lc($query) !~ /[^0-9a-f:]/i ) { # ipv6
-      # check and correct v6 address
-      die "$query is an invalid IPv6-Address.\n" if ( $query =~ /[0-9a-f]{5}/ || $query =~ /:::/ );
-      $query =~ s/:?$/::/ if ( $query !~ /(.*:){7}/ && $query !~ /::/ );
-
-      print "Query recognized as IPv6.\n";
-
-      ($method,$host,$additional) = &getmethodother($query);
-    } else
-    {
-      # PunyCode-encoding. I hate this stuff, users should provide
-      # encoded domain names!
-      $query = Net::LibIDN::idn_to_ascii($query.'', 'utf-8');
-    
-      ($method,$host,$additional) = &getmethodother($query);
-    }
-  }
-
-  die "I don't know where to query that. 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: ";
+      # Footer
+      print "--\n  To resolve one of the above handles:";
  
   if ($method =~ /whois/) {
-    print "whois -h $host";
+            print "\n     whois -h $host";
     print ":$1" if ( $additional =~ /port=(\d+)/ );
-    print " HANDLE\n";
+            print " -- HANDLE\n";
   }
-
-  if ($method eq "cgipost") {
+      elsif ($method eq "cgipost") {
     print "\n     POST $host\n";
     print "     $additional\n";
   }
-
-  if ($method eq "cgi") {
+      elsif ($method eq "cgi") {
     print "\n     $host\n";
   }
-
-  if ($method eq "wwwgrep") {
-    print "\n     hmm. not sure.\n";
+      elsif ($method eq "program") {
+            print "\n     $host HANDLE\n";
   }
-
-  print "  OTOH offical handles should be recognised directly.\n";
-  print "  Please report errors or misfits via the debian bug tracking system.\n";
+      # elsif ($method eq "wwwgrep") {
+      else {
+            # todo: add cgipostcurl etc
+            print "\n     hmm. not sure (method = $method).\n";
 }
 
-if($ARGV[0]) {
-  $_ = join(' ',ARGV);
-} else {
-  $_ = <>;
-  chomp;
+      print "  OTOH globally unique handles should be recognised directly by GWhoIs.\n";
+      print "  Please report errors or misfits via the Debian bug tracking system.\n";
+
+      return $exitcode;
 }
-&main($_);