Subversion Repositories vgwhois

Rev

Rev 20 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. #
  2. #  VGWhoIs (ViaThinkSoft Global WhoIs, a fork of generic Whois / gwhois)
  3. #  Main program
  4. #
  5. #  (c) 2010-2022 by Daniel Marschall, ViaThinkSoft <info@daniel-marschall.de>
  6. #  based on the code (c) 1998-2010 by Juliane Holzt <debian@kju.de>
  7. #  Some early parts by Lutz Donnerhacke <Lutz.Donnerhacke@Jena.Thur.de>
  8. #
  9. #  License: https://www.gnu.org/licenses/gpl-2.0.html (GPL version 2)
  10. #
  11.  
  12. package VGWhoIs::Core;
  13.  
  14. use warnings;
  15. use strict;
  16.  
  17. use LWP::Simple;
  18.  
  19. use FindBin;
  20. use lib "$FindBin::RealBin/../";
  21. use VGWhoIs::Utils;
  22.  
  23. use List::Util 'max';
  24.  
  25. $VGWhoIs::Core::confdir = "$FindBin::RealBin/pattern/";
  26.  
  27. # DM 11.09.2017: There is a weird bug: If I use TOR in combination with LWP on a Gopher protocol, I get error 500.
  28. $VGWhoIs::Core::useLWP = 0;
  29.  
  30. $VGWhoIs::Core::antispam = 1; # default: on
  31. $VGWhoIs::Core::step = 1;
  32.  
  33. # Wieso muss das nicht deklariert werden? (Fehlermeldung "useless use")
  34. #%VGWhoIs::Core::mirror;
  35.  
  36. # ($result, $exitcode) = VGWhoIs::Core::getsource($url)
  37. sub VGWhoIs::Core::getsource {
  38.         my ($url) = @_;
  39.         my $text = $VGWhoIs::Core::useLWP ? LWP::Simple::get($url) : VGWhoIs::Utils::lynxsource($url);
  40.         my $exitcode = defined($text) ? 0 : 1; # TODO: a better way to detect an error
  41.         return ($text, $exitcode);
  42. }
  43.  
  44. # ($result, $exitcode) = VGWhoIs::Core::whoisaccess($host,$port,$query)
  45. sub VGWhoIs::Core::whoisaccess {
  46.         my ($host,$port,$query) = @_;
  47.  
  48.         $query =~ s/ /%20/g;
  49.  
  50.         my ($result, $exitcode) = VGWhoIs::Core::getsource("gopher://$host:$port/0$query");
  51.         if ($exitcode) {
  52.                 $result .= "Query to whois server failed.\n";
  53.         }
  54.         $result =~ s/\x0D//g; # remove CR from output
  55.  
  56.         return ($result, $exitcode);
  57. }
  58.  
  59. # ($result, $exitcode) = VGWhoIs::Core::inicwhoisaccess($host,$port,$query)
  60. sub VGWhoIs::Core::inicwhoisaccess { # todo: mehr als 1 redirect möglich, z.b. bei rwhois??
  61. #TODO: hier auch $mirror unterstützung?
  62.         my ($host,$port,$query) = @_;
  63.         my ($queryresult, $result);
  64.         my $exitcode;
  65.  
  66.         ($queryresult, $exitcode) = VGWhoIs::Core::whoisaccess($host,$port,"=$query");
  67.  
  68.         # Result von NSI-Registry auf relevanten Part absuchen
  69.         if ( $queryresult =~ /Name:\s+$query\s/mi ) {
  70.                 $result = "-- From: $host:$port\n\n";
  71.                 ($host) = $queryresult =~
  72.                         /Name:\s+$query\s.*?Whois Server:\s+(.*?)\s/si;
  73.  
  74.                 my $relresult;
  75. #               my ($relresult) = $queryresult =~
  76. #                       /[\r\n]([^\r\n]+\S+\sName:\s+$query\s.*?Expiration Date:[^\r\n]+)[\r\n]/si;
  77. #               $relresult = "(Redirect to $host:$port)" if !defined $relresult;
  78.                 $relresult = $queryresult;
  79.  
  80.                 $result .= "$relresult\n\n-- End --\n\n";
  81.  
  82.                 # $port = 43;
  83.                 my ($host2, $port) = $host =~ /^(.*):(.*)$/;
  84.                 $port = 43     if !defined $port;
  85.                 $host = $host2 if  defined $host2;
  86.  
  87.                 # print $VGWhoIs::Core::step++,". Step: Querying $host:$port with whois.\n\n"; # todo "rwhois"?
  88.                 $result .= ($VGWhoIs::Core::step++).". Step: Querying $host:$port with whois.\n\n"; # todo "rwhois"?
  89.  
  90.                 $result .= "-- From: $host:$port\n\n";
  91.                 # TODO: beim referal whois ist die query ist nicht trimmed. scheint aber nix auszumachen
  92.                 my ($loc_text, $loc_exitcode) = VGWhoIs::Core::whoisaccess($host,$port,$query);
  93.  
  94.                 $exitcode = max($exitcode, $loc_exitcode);
  95.                 $result .= $loc_text;
  96.         } else {
  97.                 $result = "-- From: $host:$port\n\n$queryresult-- End --\n";
  98.         }
  99.  
  100.         return ($result, $exitcode);
  101. }
  102.  
  103. # ($host, $additional) = VGWhoIs::Core::methodpatternregex($query,$host,$additional,$queryline);
  104. sub VGWhoIs::Core::methodpatternregex {
  105.         my ($query,$host,$additional,$line) = @_;
  106.  
  107.         my ($namewotld,$tld) = $query =~ /^([^\.]*)\.(.*)$/;
  108. # TODO: !defined
  109.         my ($p1,$p2,$p3,$p4,$p5,$p6,$p7,$p8,$p9) = $query =~ $line;
  110. # TODO: !defined
  111.         my ($ucq) = uc($query);
  112.  
  113.         $host       =~ s/~query~/$query/;
  114.         $host       =~ s/~ucquery~/$ucq/;
  115.         $host       =~ s/~namewotld~/$namewotld/;
  116.         $host       =~ s/~tld~/$tld/;
  117.         $host       =~ s/~1~/$p1/;
  118.         $host       =~ s/~2~/$p2/;
  119.         $host       =~ s/~2~/$p3/;
  120.         $host       =~ s/~2~/$p4/;
  121.         $host       =~ s/~2~/$p5/;
  122.         $host       =~ s/~2~/$p6/;
  123.         $host       =~ s/~2~/$p7/;
  124.         $host       =~ s/~2~/$p8/;
  125.         $host       =~ s/~2~/$p9/;
  126.  
  127.         $additional =~ s/~query~/$query/;
  128.         $additional =~ s/~ucquery~/$ucq/;
  129.         $additional =~ s/~namewotld~/$namewotld/;
  130.         $additional =~ s/~tld~/$tld/;
  131.         $additional =~ s/~1~/$p1/;
  132.         $additional =~ s/~2~/$p2/;
  133.  
  134.         return ($host,$additional);
  135. }
  136.  
  137. # @patternfiles = VGWhoIs::Core::getpatternfiles()
  138. sub VGWhoIs::Core::getpatternfiles {
  139.         my (@files, @files_new);
  140.  
  141.         opendir(DIR, $VGWhoIs::Core::confdir);
  142.         @files_new = sort(readdir(DIR));
  143.         closedir(DIR);
  144.  
  145.         @files_new = grep {
  146.                             ($_ !~ /^\./)
  147.                         } @files_new;
  148.         @files_new = map { "$VGWhoIs::Core::confdir$_" } @files_new;
  149.  
  150.         @files = grep { -f } (@files_new);
  151.  
  152.         return (@files);
  153. }
  154.  
  155. # ($method, $host, $additional) = VGWhoIs::Core::getmethodother($query);
  156. sub VGWhoIs::Core::getmethodother {
  157.         my ($query) = @_;
  158.         my $found = 0;
  159.         my ($line,$cline,$method,$host,$additional);
  160.         my ($rang_prefix, $rang_beginning, $rang_ending);
  161.         my ($rang_actual_prefix, $rang_number);
  162.  
  163.         # Process file until we found a match
  164.         foreach my $patternfile (VGWhoIs::Core::getpatternfiles()) {
  165.                 open(PATTERN,"<$patternfile") || die "Cannot open $patternfile. STOP.\n";
  166.  
  167.                 while ( defined($line = <PATTERN>) && (!$found) ) {
  168.                         # chomp $line;
  169.                         $line = VGWhoIs::Utils::trim($line);
  170.  
  171.                         if ( $line =~ /^#/ ) {                       # comment
  172.                         } elsif ( ($cline) = $line =~ /^:(.*)$/ ) {  # method declaration
  173.                                 ($method,$host,$additional) = split(/\|/,$cline,3);
  174.                                 $method=''     if !defined $method;
  175.                                 $host=''       if !defined $host;
  176.                                 $additional='' if !defined $additional;
  177.  
  178.                         } elsif ( $line =~ /^\*/ && (($rang_actual_prefix, $rang_number) = $query =~ /^([^0-9]+)([0-9]+)$/) ) {
  179.                                 # e.g. for parsing ASNs
  180.  
  181.                                 if (($rang_prefix, $rang_beginning) = $line =~ /^\*([^0-9]+):([0-9]+)$/) {
  182.                                         # Single number
  183.                                         $rang_ending = $rang_beginning
  184.                                 } else {
  185.                                         # Range
  186.                                         ($rang_prefix, $rang_beginning, $rang_ending) = $line =~ /^\*([^0-9]+):([0-9]+)-([0-9]+)$/;
  187.                                         next if !defined $rang_prefix;
  188.                                         next if !defined $rang_beginning;
  189.                                         next if !defined $rang_ending;
  190.                                 }
  191.  
  192.                                 if ((lc($rang_prefix) eq lc($rang_actual_prefix))
  193.                                   && ($rang_number >= $rang_beginning)
  194.                                   && ($rang_number <= $rang_ending)) {
  195.                                         $found = 1;
  196.                                         # ($host,$additional) = VGWhoIs::Core::methodpatternregex($query,$host,$additional,$line);
  197.                                 }
  198.                         } elsif ( $line ne '' && $line =~ /^[^\*]/ && $query =~ /$line/i ) {
  199.                                 # Regex
  200.                                 $found = 1;
  201.                                 ($host,$additional) = VGWhoIs::Core::methodpatternregex($query,$host,$additional,$line);
  202.                         }
  203.                 }
  204.         }
  205.         if (!$found) {
  206.                 return ('','','')
  207.         }
  208.  
  209.         $host = $VGWhoIs::Core::mirror{$method.$host} if defined $VGWhoIs::Core::mirror{$method.$host};
  210.         return ($method,$host,$additional);
  211. }
  212.  
  213. # ($resulttext, $exitcode) = VGWhoIs::Core::redirectwhois($query,$host,$port)
  214. sub VGWhoIs::Core::redirectwhois {
  215.         my ($query,$host,$port) = @_; # todo: anstelle $port lieber ein $additional zulassen?
  216.         $port = 43 if !defined $port;
  217.  
  218.         # check for query modifier (if any)
  219.         my ($modmethod, $modhost, $modadditional) = VGWhoIs::Core::getmethodother("redirect:$host(:$port){0,1}");
  220.  
  221.         return VGWhoIs::Core::doquery($query,$modmethod,$modhost,$modadditional)
  222.                 if ( $modmethod ne 'none');
  223.  
  224.         return VGWhoIs::Core::doquery($query, 'whois', "$host:$port");
  225. }
  226.  
  227. # ($resulttext, $exitcode) = VGWhoIs::Core::doquery($query,$method,$host,$additional);
  228. sub VGWhoIs::Core::doquery {
  229.         my ($query,$method,$host,$additional,$inside_multiple) = @_;
  230.         my $result = '';
  231.         my $exitcode = 0;
  232.  
  233.         $query = ''          if !defined $query;
  234.         $method = ''         if !defined $method;
  235.         $host = ''           if !defined $host;
  236.         $additional = ''     if !defined $additional;
  237.         $inside_multiple = 0 if !defined $inside_multiple;
  238.  
  239.         if ($method eq 'multiple') {
  240.                 my $triple;
  241.                 # do not match "::::", e.g. used by notice
  242.                 my @triple_split = split(/(?<!:):::(?!:)/, $additional);
  243.                 my $count = 0;
  244.                 foreach $triple (@triple_split) {
  245.                         ($method,$host,$additional) = split(/::/, $triple);
  246.  
  247.                         # We will not get the exact sequence of "prints" and "$result" outputs, but it is better than nothing.
  248.                         # If we would print everything, we would get the warning "print wide char" at nic.es
  249.                         # If we would save all output to $result without buffering the prints inside VGWhoIs::Core::doquery(), the prints would not be in front of their section.
  250.                         my $output = '';
  251.                         open TOOUTPUT, '>', \$output or die "Can't open TOOUTPUT: $!"; # TODO: exitcode
  252.                         my $orig_select = select(TOOUTPUT);
  253.  
  254.                         my ($loc_text, $loc_exitcode) = VGWhoIs::Core::doquery($query, $method, $host, $additional, 1);
  255.                         $exitcode = max($exitcode, $loc_exitcode);
  256.  
  257.                         $output .= VGWhoIs::Utils::trim($loc_text);
  258.                         $output .= "\n\n------\n\n" if $count < $#triple_split;
  259.                         select($orig_select);
  260.                         $result .= $output;
  261.  
  262.                         $count += 1;
  263.                 }
  264.  
  265.                 # done
  266.                 $method = '';
  267.         }
  268.  
  269.         elsif ($method eq 'whois') {
  270.                 my ($parameter,$outquery,$prefix) = ('', '', '');
  271.  
  272.                 my $port       = 43;
  273.                 my $noipprefix = '';
  274.                 my $ipprefix   = '';
  275.                 my $trailer    = '';
  276.                 my $strip      = '';
  277.  
  278.                 $additional = '' if !defined $additional;
  279.  
  280.                 foreach $parameter (split('\|', $additional)) {
  281.                         $trailer    = $1 if ( $parameter =~ /trailer=(.*)/ );
  282.                         $strip      = $1 if ( $parameter =~ /strip=(.*)/ );
  283.                         $prefix     = $1 if ( $parameter =~ /prefix=(.*)/ );
  284.                 }
  285.  
  286.                 $port = $1 if ( $host =~ /.+:(\d+)/ );
  287.                 $host =~ s/:(\d+)//g;
  288.  
  289.                 print "Querying $host:$port with whois.\n"; # todo "rwhois"?
  290.  
  291.                 $outquery = $prefix . $query . $trailer . "\n";
  292.                 $outquery =~ s/$strip//g if ( $strip ne '' );
  293.  
  294.                 my $loc_exitcode;
  295.                 ($result, $loc_exitcode) = VGWhoIs::Core::whoisaccess($host,$port,$outquery);
  296.                 $exitcode = max($exitcode, $loc_exitcode);
  297.  
  298.                 # TODO rwhois:// implementierung ok?
  299.                 if ( $result =~ /ReferralServer: whois:\/\/(.*):43/mi || $result =~ /ReferralServer: whois:\/\/(.*)/mi ) {
  300.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,$1);
  301.                         $host = ''; #TODO???
  302.                         $exitcode = max($exitcode, $loc_exitcode);
  303.                 } elsif ( $result =~ /ReferralServer: r{0,1}whois:\/\/([^:]*):(\d+)/mi ) {
  304. #                       ($result, $loc_exitcode) = VGWhoIs::Core::whoisaccess($1,$2,$query); # TODO rediretwhois ?
  305.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,$1,$2);
  306.                         $exitcode = max($exitcode, $loc_exitcode);
  307.                 } elsif ( $result =~ /ReferralServer: rwhois:\/\/(.*)/mi ) {
  308. #                       ($result, $loc_exitcode) = VGWhoIs::Core::whoisaccess($1,4321,$query); # TODO rediretwhois ?
  309.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,$1,4321);
  310.                         $exitcode = max($exitcode, $loc_exitcode);
  311.                 } elsif ( $result =~ /(refer|whois server):\s+(.*)/m ) {
  312.                         # "refer:" is sent by whois.iana.org (e.g. if you query test.de )
  313.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,$2);
  314.                         $host = ''; #TODO???
  315.                         $exitcode = max($exitcode, $loc_exitcode);
  316.                 }
  317.  
  318.                 # TODO: http://tools.ietf.org/html/rfc1714#section-3.3.2
  319.                 #    %referral<SP><server>[:type]<SP>[authority area]
  320.  
  321.                 print "\n";
  322.         }
  323.  
  324.         elsif ($method eq 'inicwhois' ) {
  325.                 my $port = $additional || 43;
  326.                 $result = ($VGWhoIs::Core::step++).". Step: Querying $host:$port with whois.\n\n"; #todo "rwhois"?
  327.                 $query .= "\n"; # ???
  328.  
  329.                 my ($loc_text, $loc_exitcode) = VGWhoIs::Core::inicwhoisaccess($host,$port,$query);
  330.                 $result .= $loc_text;
  331.                 $exitcode = max($exitcode, $loc_exitcode);
  332.         }
  333.  
  334.         elsif ($method eq 'cgi') {
  335.                 my ($protocol, $hostname) = VGWhoIs::Utils::splitProtocolHost($host);
  336.  
  337.                 print "Querying $hostname ($protocol) with cgi:\n$host\n\n";
  338.  
  339.                 $result = VGWhoIs::Utils::lynxrender($host);
  340.  
  341.  
  342. # Old:
  343.  
  344. #               $result = `curl --max-time 10 --stderr /dev/null "$host" 2>&1`; # TODO escape
  345.  
  346.                 # TODO: VGWhoIs::Core::getsource ok? war vorher IMMER lynx
  347. #               my ($loc_text, $loc_exitcode) = VGWhoIs::Core::getsource($host);
  348.  
  349. #               $exitcode = max($exitcode, $loc_exitcode);
  350. #               if ($loc_exitcode) {
  351. #                       $result .= "Query to web server failed.\n";
  352. #               } else {
  353. #                       $result = VGWhoIs::Utils::render_html($loc_text);
  354. #               }
  355.  
  356.         }
  357.  
  358.         elsif ($method eq 'cgipost') {
  359.                 my ($protocol, $hostname) = VGWhoIs::Utils::splitProtocolHost($host);
  360.  
  361.                 print "Querying $hostname ($protocol) with cgi.\n\n";
  362.  
  363.                 # DM 2019-05-27: Added "-e" (referrer) because www.whois.az needs it
  364.                 # Things we could additionally add:  --max-time 10 --insecure --stderr /dev/null
  365.                 $result = `printf "$additional" | curl --silent -e "$host" -X POST --data-binary \@- "$host" | lynx -dump -stdin 2>&1`; # TODO escape
  366.                 my $loc_exitcode = $?;
  367.                 $exitcode = max($exitcode, $loc_exitcode);
  368.                 $result .= "FAILED with exit code $loc_exitcode\n\n" if $loc_exitcode;
  369.         }
  370.  
  371.         elsif ($method eq 'notice') {
  372.                 if ($inside_multiple) {
  373.                         $result = "\n\nAdditional information for query '$query'.\n\n" . $additional . "\n\n";
  374.                 } else {
  375.                         $result = "\n\nNo lookup service available for your query '$query'.\n\nvgwhois remarks: " . $additional . "\n\n";
  376.                 }
  377.                 # $exitcode = 0;
  378.         }
  379.  
  380.         elsif ($method eq 'program') {
  381.                 my ($program) = VGWhoIs::Utils::trim($host);
  382.                 $program =~ s/\$vgwhois\$/$FindBin::RealBin/;
  383.                 print "Querying script $program\n\n";
  384.                 $result = `$program $additional "$query" 2>&1`;
  385.                 my $loc_exitcode = $?;
  386.                 $exitcode = max($exitcode, $loc_exitcode);
  387.                 $result .= "FAILED with exit code $loc_exitcode\n\n" if $loc_exitcode;
  388.         }
  389.  
  390.         if ($host =~ /arin/) {
  391.                 my $loc_exitcode;
  392.                 if ($result =~ /Maintainer: RIPE/) {
  393.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.ripe.net');
  394.                         $exitcode = max($exitcode, $loc_exitcode);
  395.                 } elsif ($result =~ /Maintainer: AP/) {
  396.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.apnic.net');
  397.                         $exitcode = max($exitcode, $loc_exitcode);
  398.                 }
  399.         }
  400.         elsif ($host =~ /apnic/) {
  401.                 my $loc_exitcode;
  402.                 if ($result =~ /netname: AUNIC-AU/) {
  403.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.aunic.net');
  404.                         $exitcode = max($exitcode, $loc_exitcode);
  405.                 } elsif ($result =~ /netname: JPNIC-JP/) {
  406.                         ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.nic.ad.jp');
  407.                         $exitcode = max($exitcode, $loc_exitcode);
  408.                 }
  409.         }
  410.         elsif ($host =~ /ripe/ && $result =~ /remarks:\s+whois -h (\S+)/) {
  411.                 my $loc_exitcode;
  412.                 ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,$1);
  413.                 $exitcode = max($exitcode, $loc_exitcode);
  414.         }
  415.         # TODO: internic gibts doch gar nicht mehr, oder?
  416.         elsif (($host =~ /internic/) && ($result =~ /No match for/) && ($query !~ /\.(arpa|com|edu|net|org)$/) ) {
  417.                 my ($result1, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.ripe.net');
  418.                 $result = $result1 if $result1 !~ /No entries found/;
  419.                 $exitcode = max($exitcode, $loc_exitcode);
  420.         }
  421.  
  422.         return ($result, $exitcode);
  423. }
  424.  
  425. 1;
  426.