Subversion Repositories vgwhois

Rev

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

Rev Author Line No. Line
12 daniel-mar 1
#
2
#  VGWhoIs (ViaThinkSoft Global WhoIs, a fork of generic Whois / gwhois)
3
#  Main program
4
#
92 daniel-mar 5
#  (c) 2010-2022 by Daniel Marschall, ViaThinkSoft <info@daniel-marschall.de>
12 daniel-mar 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
 
18 daniel-mar 269
        elsif ($method eq 'whois') {
12 daniel-mar 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
 
92 daniel-mar 337
                print "Querying $hostname ($protocol) with cgi:\n$host\n\n";
12 daniel-mar 338
 
92 daniel-mar 339
                $result = VGWhoIs::Utils::lynxrender($host);
12 daniel-mar 340
 
92 daniel-mar 341
 
342
# Old:
343
 
18 daniel-mar 344
#               $result = `curl --max-time 10 --stderr /dev/null "$host" 2>&1`; # TODO escape
345
 
12 daniel-mar 346
                # TODO: VGWhoIs::Core::getsource ok? war vorher IMMER lynx
92 daniel-mar 347
#               my ($loc_text, $loc_exitcode) = VGWhoIs::Core::getsource($host);
12 daniel-mar 348
 
92 daniel-mar 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
 
12 daniel-mar 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
 
18 daniel-mar 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 
20 daniel-mar 365
                $result = `printf "$additional" | curl --silent -e "$host" -X POST --data-binary \@- "$host" | lynx -dump -stdin 2>&1`; # TODO escape
12 daniel-mar 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;