Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/vgwhois/trunk/main/lib/VGWhoIs/Core.pm
Revision: 20
Committed: Mon May 27 23:40:30 2019 UTC (16 months ago) by daniel-marschall
Content type: text/x-perl
File size: 14673 byte(s)
Log Message:
Fixed .my and .co.zw

File Contents

# User Rev Content
1 daniel-marschall 12 #
2     # VGWhoIs (ViaThinkSoft Global WhoIs, a fork of generic Whois / gwhois)
3     # Main program
4     #
5     # (c) 2010-2019 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 daniel-marschall 18 elsif ($method eq 'whois') {
270 daniel-marschall 12 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\n";
338     #!!
339     # print "$host\n";
340    
341     # TODO: lynx seems to be better in some ways!
342     # For example, a website that outputs "text/plain" will be rendered correct in lynx!
343     # $result = `lynx -connect_timeout=10 -dump "$host" 2>&1`;
344     # $result .= "FAILED with exit code $?\n\n" if $?;
345    
346 daniel-marschall 18 # $result = `curl --max-time 10 --stderr /dev/null "$host" 2>&1`; # TODO escape
347    
348 daniel-marschall 12 # TODO: VGWhoIs::Core::getsource ok? war vorher IMMER lynx
349     my ($loc_text, $loc_exitcode) = VGWhoIs::Core::getsource($host);
350    
351     $exitcode = max($exitcode, $loc_exitcode);
352     if ($loc_exitcode) {
353     $result .= "Query to web server failed.\n";
354     } else {
355     $result = VGWhoIs::Utils::render_html($loc_text);
356     }
357     }
358    
359     elsif ($method eq 'cgipost') {
360     my ($protocol, $hostname) = VGWhoIs::Utils::splitProtocolHost($host);
361    
362     print "Querying $hostname ($protocol) with cgi.\n\n";
363    
364 daniel-marschall 18 # DM 2019-05-27: Added "-e" (referrer) because www.whois.az needs it
365     # Things we could additionally add: --max-time 10 --insecure --stderr /dev/null
366 daniel-marschall 20 $result = `printf "$additional" | curl --silent -e "$host" -X POST --data-binary \@- "$host" | lynx -dump -stdin 2>&1`; # TODO escape
367 daniel-marschall 12 my $loc_exitcode = $?;
368     $exitcode = max($exitcode, $loc_exitcode);
369     $result .= "FAILED with exit code $loc_exitcode\n\n" if $loc_exitcode;
370     }
371    
372     elsif ($method eq 'notice') {
373     if ($inside_multiple) {
374     $result = "\n\nAdditional information for query '$query'.\n\n" . $additional . "\n\n";
375     } else {
376     $result = "\n\nNo lookup service available for your query '$query'.\n\nvgwhois remarks: " . $additional . "\n\n";
377     }
378     # $exitcode = 0;
379     }
380    
381     elsif ($method eq 'program') {
382     my ($program) = VGWhoIs::Utils::trim($host);
383     $program =~ s/\$vgwhois\$/$FindBin::RealBin/;
384     print "Querying script $program\n\n";
385     $result = `$program $additional "$query" 2>&1`;
386     my $loc_exitcode = $?;
387     $exitcode = max($exitcode, $loc_exitcode);
388     $result .= "FAILED with exit code $loc_exitcode\n\n" if $loc_exitcode;
389     }
390    
391     if ($host =~ /arin/) {
392     my $loc_exitcode;
393     if ($result =~ /Maintainer: RIPE/) {
394     ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.ripe.net');
395     $exitcode = max($exitcode, $loc_exitcode);
396     } elsif ($result =~ /Maintainer: AP/) {
397     ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.apnic.net');
398     $exitcode = max($exitcode, $loc_exitcode);
399     }
400     }
401     elsif ($host =~ /apnic/) {
402     my $loc_exitcode;
403     if ($result =~ /netname: AUNIC-AU/) {
404     ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.aunic.net');
405     $exitcode = max($exitcode, $loc_exitcode);
406     } elsif ($result =~ /netname: JPNIC-JP/) {
407     ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.nic.ad.jp');
408     $exitcode = max($exitcode, $loc_exitcode);
409     }
410     }
411     elsif ($host =~ /ripe/ && $result =~ /remarks:\s+whois -h (\S+)/) {
412     my $loc_exitcode;
413     ($result, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,$1);
414     $exitcode = max($exitcode, $loc_exitcode);
415     }
416     # TODO: internic gibts doch gar nicht mehr, oder?
417     elsif (($host =~ /internic/) && ($result =~ /No match for/) && ($query !~ /\.(arpa|com|edu|net|org)$/) ) {
418     my ($result1, $loc_exitcode) = VGWhoIs::Core::redirectwhois($query,'whois.ripe.net');
419     $result = $result1 if $result1 !~ /No entries found/;
420     $exitcode = max($exitcode, $loc_exitcode);
421     }
422    
423     return ($result, $exitcode);
424     }
425    
426     1;