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

# Content
1 #
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 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\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 # $result = `curl --max-time 10 --stderr /dev/null "$host" 2>&1`; # TODO escape
347
348 # 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 # 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 $result = `printf "$additional" | curl --silent -e "$host" -X POST --data-binary \@- "$host" | lynx -dump -stdin 2>&1`; # TODO escape
367 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;