line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Whois::Raw; |
2
|
|
|
|
|
|
|
$Net::Whois::Raw::VERSION = '2.99036'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Get Whois information of domains and IP addresses. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
require 5.008_001; |
6
|
4
|
|
|
4
|
|
1737
|
use Net::Whois::Raw::Common (); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
71
|
|
7
|
4
|
|
|
4
|
|
15
|
use Net::Whois::Raw::Data (); |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
46
|
|
8
|
|
|
|
|
|
|
|
9
|
4
|
|
|
4
|
|
13
|
use warnings; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
71
|
|
10
|
4
|
|
|
4
|
|
14
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
64
|
|
11
|
|
|
|
|
|
|
|
12
|
4
|
|
|
4
|
|
14
|
use Carp; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
170
|
|
13
|
4
|
|
|
4
|
|
1621
|
use IO::Socket::IP; |
|
4
|
|
|
|
|
92450
|
|
|
4
|
|
|
|
|
13
|
|
14
|
4
|
|
|
4
|
|
1330
|
use Encode; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
195
|
|
15
|
4
|
|
|
4
|
|
17
|
use utf8; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
15
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our @EXPORT = qw( whois get_whois ); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our ($OMIT_MSG, $CHECK_FAIL, $CHECK_EXCEED, $CACHE_DIR, $TIMEOUT, $DEBUG) = (0) x 7; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $CACHE_TIME = 60; |
22
|
|
|
|
|
|
|
our $SET_CODEPAGE = ''; |
23
|
|
|
|
|
|
|
our $SILENT_MODE = 0; |
24
|
|
|
|
|
|
|
our $QUERY_SUFFIX = ''; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our (%notfound, %strip, @SRC_IPS, %POSTPROCESS); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# internal variable, used for save whois_server->ip relations |
29
|
|
|
|
|
|
|
my $_IPS = {}; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
our $class = __PACKAGE__; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my $last_cache_clear_time; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub whois_config { |
36
|
0
|
|
|
0
|
0
|
0
|
my ($par) = @_; |
37
|
0
|
|
|
|
|
0
|
my @parnames = qw(OMIT_MSG CHECK_FAIL CHECK_EXCEED CACHE_DIR CACHE_TIME TIMEOUT @SRC_IPS); |
38
|
0
|
|
|
|
|
0
|
foreach my $parname (@parnames) { |
39
|
0
|
0
|
|
|
|
0
|
if (exists($par->{$parname})) { |
40
|
4
|
|
|
4
|
|
696
|
no strict 'refs'; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
276
|
|
41
|
0
|
|
|
|
|
0
|
${$parname} = $par->{$parname}; |
|
0
|
|
|
|
|
0
|
|
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub whois_config_data { |
47
|
0
|
|
|
0
|
0
|
0
|
my $net_whois_raw_data = shift; |
48
|
|
|
|
|
|
|
|
49
|
4
|
|
|
4
|
|
20
|
no strict 'refs'; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
8806
|
|
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
0
|
foreach my $k (keys %$net_whois_raw_data) { |
52
|
0
|
|
|
|
|
0
|
%{'Net::Whois::Raw::Data::'.$k} = ( |
53
|
0
|
|
|
|
|
0
|
%{'Net::Whois::Raw::Data::'.$k}, |
54
|
0
|
0
|
|
|
|
0
|
%{ $net_whois_raw_data->{ $k } || {} }, |
|
0
|
|
|
|
|
0
|
|
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# get cached whois |
60
|
|
|
|
|
|
|
sub whois { |
61
|
2
|
|
|
2
|
1
|
787
|
my ($dom, $server, $which_whois) = @_; |
62
|
|
|
|
|
|
|
|
63
|
2
|
|
50
|
|
|
6
|
$which_whois ||= 'QRY_LAST'; |
64
|
|
|
|
|
|
|
|
65
|
2
|
|
|
|
|
20
|
my $res = Net::Whois::Raw::Common::get_from_cache( "$dom-$which_whois", $CACHE_DIR, $CACHE_TIME ); |
66
|
|
|
|
|
|
|
|
67
|
2
|
|
|
|
|
4
|
my ($res_text, $res_srv, $res_text2); |
68
|
|
|
|
|
|
|
|
69
|
2
|
100
|
|
|
|
5
|
if ($res) { |
70
|
1
|
50
|
33
|
|
|
8
|
if ($which_whois eq 'QRY_FIRST') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
71
|
0
|
|
|
|
|
0
|
$res_text = $res->[0]->{text}; |
72
|
0
|
|
|
|
|
0
|
$res_srv = $res->[0]->{srv}; |
73
|
|
|
|
|
|
|
} elsif ($which_whois eq 'QRY_LAST' || !defined($which_whois)) { |
74
|
0
|
|
|
|
|
0
|
$res_text = $res->[-1]->{text}; |
75
|
0
|
|
|
|
|
0
|
$res_srv = $res->[-1]->{srv}; |
76
|
|
|
|
|
|
|
} elsif ($which_whois eq 'QRY_ALL') { |
77
|
1
|
|
|
|
|
4
|
return $res; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
else { |
81
|
1
|
|
|
|
|
2
|
($res_text, $res_srv) = get_whois($dom, $server, $which_whois); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
1
|
50
|
33
|
|
|
5
|
$res_srv = '' if $res_srv && $res_srv eq 'www_whois'; |
85
|
|
|
|
|
|
|
|
86
|
1
|
50
|
33
|
|
|
6
|
if ( defined $res_text && $which_whois ne 'QRY_ALL' ) { |
87
|
0
|
|
|
|
|
0
|
utf8::decode( $res_text ); # Perl whyly loss utf8 flag |
88
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
0
|
$res_text = encode( $SET_CODEPAGE, $res_text ) if $SET_CODEPAGE; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
1
|
50
|
|
|
|
4
|
return wantarray ? ($res_text, $res_srv) : $res_text; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# obtain whois |
96
|
|
|
|
|
|
|
sub get_whois { |
97
|
1
|
|
|
1
|
1
|
2
|
my ($dom, $srv, $which_whois) = @_; |
98
|
1
|
|
50
|
|
|
3
|
$which_whois ||= 'QRY_LAST'; |
99
|
|
|
|
|
|
|
|
100
|
1
|
50
|
|
|
|
2
|
my $whois = get_all_whois( $dom, $srv, $which_whois eq 'QRY_FIRST' ) |
101
|
|
|
|
|
|
|
or return undef; |
102
|
|
|
|
|
|
|
|
103
|
1
|
|
|
|
|
6
|
Net::Whois::Raw::Common::write_to_cache( "$dom-$which_whois", $whois, $CACHE_DIR ); |
104
|
|
|
|
|
|
|
|
105
|
1
|
50
|
|
|
|
5
|
if ($which_whois eq 'QRY_LAST') { |
|
|
50
|
|
|
|
|
|
106
|
0
|
|
|
|
|
0
|
my $thewhois = $whois->[-1]; |
107
|
0
|
0
|
|
|
|
0
|
return wantarray ? ($thewhois->{text}, $thewhois->{srv}) : $thewhois->{text}; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
elsif ($which_whois eq 'QRY_FIRST') { |
110
|
0
|
|
|
|
|
0
|
my $thewhois = $whois->[0]; |
111
|
0
|
0
|
|
|
|
0
|
return wantarray ? ($thewhois->{text}, $thewhois->{srv}) : $thewhois->{text}; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
else { |
114
|
1
|
|
|
|
|
4
|
return $whois; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub get_all_whois { |
119
|
1
|
|
|
1
|
0
|
2
|
my ($dom, $srv, $norecurse) = @_; |
120
|
|
|
|
|
|
|
|
121
|
1
|
|
|
|
|
1
|
my $is_ns = 0; |
122
|
1
|
50
|
|
|
|
4
|
$is_ns = 1 if $dom =~ s/[.]NS$//i; |
123
|
|
|
|
|
|
|
|
124
|
1
|
|
33
|
|
|
6
|
$srv ||= Net::Whois::Raw::Common::get_server( $dom, $is_ns ); |
125
|
|
|
|
|
|
|
|
126
|
1
|
50
|
|
|
|
3
|
if ($srv eq 'www_whois') { |
127
|
0
|
|
|
|
|
0
|
my ($responce, $ishtml) = www_whois_query( $dom ); |
128
|
0
|
0
|
|
|
|
0
|
return $responce ? [ { text => $responce, srv => $srv } ] : $responce; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
1
|
|
|
|
|
2
|
my @whois = recursive_whois( $dom, $srv, [], $norecurse, $is_ns ); |
132
|
|
|
|
|
|
|
|
133
|
1
|
|
|
|
|
4
|
my $whois_answers = process_whois_answers( \@whois, $dom ); |
134
|
|
|
|
|
|
|
|
135
|
1
|
|
|
|
|
5
|
return $whois_answers; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub process_whois_answers { |
139
|
1
|
|
|
1
|
0
|
2
|
my ( $raw_whois, $dom ) = @_; |
140
|
|
|
|
|
|
|
|
141
|
1
|
|
|
|
|
3
|
my @processed_whois; |
142
|
|
|
|
|
|
|
|
143
|
1
|
|
|
|
|
2
|
my $level = 0; |
144
|
1
|
|
|
|
|
3
|
for my $whois_rec ( @$raw_whois ) { |
145
|
2
|
|
|
|
|
3
|
$whois_rec->{level} = $level; |
146
|
|
|
|
|
|
|
my ( $text, $error ) = Net::Whois::Raw::Common::process_whois( |
147
|
|
|
|
|
|
|
$dom, |
148
|
|
|
|
|
|
|
$whois_rec->{srv}, |
149
|
|
|
|
|
|
|
$whois_rec->{text}, |
150
|
2
|
|
|
|
|
8
|
$CHECK_FAIL, $OMIT_MSG, $CHECK_EXCEED, |
151
|
|
|
|
|
|
|
); |
152
|
|
|
|
|
|
|
|
153
|
2
|
0
|
33
|
|
|
6
|
die $error if $error && $error eq 'Connection rate exceeded' |
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
154
|
|
|
|
|
|
|
&& ( $level == 0 || $CHECK_EXCEED == 2 ); |
155
|
|
|
|
|
|
|
|
156
|
2
|
50
|
33
|
|
|
9
|
if ( $text || $level == 0 ) { |
157
|
2
|
|
|
|
|
6
|
$whois_rec->{text} = $text; |
158
|
2
|
|
|
|
|
3
|
push @processed_whois, $whois_rec; |
159
|
|
|
|
|
|
|
} |
160
|
2
|
|
|
|
|
5
|
$level++; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
1
|
|
|
|
|
2
|
return \@processed_whois; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub _referral_server { |
167
|
139
|
|
|
139
|
|
1235
|
/ReferralServer:\s*r?whois:\/\/([-.\w]+(?:\:\d+)?)/ |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub recursive_whois { |
171
|
2
|
|
|
2
|
0
|
5
|
my ( $dom, $srv, $was_srv, $norecurse, $is_ns ) = @_; |
172
|
|
|
|
|
|
|
|
173
|
2
|
|
|
|
|
5
|
my $lines = whois_query( $dom, $srv, $is_ns ); |
174
|
2
|
|
|
|
|
22
|
my $whois = join '', @$lines; |
175
|
|
|
|
|
|
|
|
176
|
2
|
|
|
|
|
4
|
my ( $newsrv, $registrar ); |
177
|
2
|
|
|
|
|
6
|
for ( @$lines ) { |
178
|
139
|
|
66
|
|
|
192
|
$registrar ||= /Registrar/ || /Registered through/; |
|
|
|
100
|
|
|
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# Skip urls as recursive whois servers |
181
|
139
|
100
|
66
|
|
|
510
|
if ( $registrar && !$norecurse && /whois server:\s*([a-z0-9\-_\.]+)\b/i ) { |
|
|
50
|
100
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
182
|
2
|
|
|
|
|
9
|
$newsrv = lc $1; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
elsif ( $whois =~ /To single out one record, look it up with \"xxx\",/s ) { |
185
|
0
|
|
|
|
|
0
|
return recursive_whois( "=$dom", $srv, $was_srv ); |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
elsif ( !$norecurse && ( my ( $rs ) = _referral_server() ) ) { |
188
|
0
|
|
|
|
|
0
|
$newsrv = $rs; |
189
|
0
|
|
|
|
|
0
|
last; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
elsif ( /Contact information can be found in the (\S+)\s+database/ ) { |
192
|
0
|
|
|
|
|
0
|
$newsrv = $Net::Whois::Raw::Data::ip_whois_servers{ $1 }; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
elsif ( ( /OrgID:\s+(\w+)/ || /descr:\s+(\w+)/ ) && Net::Whois::Raw::Common::is_ipaddr( $dom ) ) { |
195
|
0
|
|
|
|
|
0
|
my $val = $1; |
196
|
0
|
0
|
|
|
|
0
|
if ( $val =~ /^(?:RIPE|APNIC|KRNIC|LACNIC)$/ ) { |
197
|
0
|
|
|
|
|
0
|
$newsrv = $Net::Whois::Raw::Data::ip_whois_servers{ $val }; |
198
|
0
|
|
|
|
|
0
|
last; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
elsif ( /^\s+Maintainer:\s+RIPE\b/ && Net::Whois::Raw::Common::is_ipaddr( $dom ) ) { |
202
|
0
|
|
|
|
|
0
|
$newsrv = $Net::Whois::Raw::Data::servers{RIPE}; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
elsif ( $is_ns && $srv ne $Net::Whois::Raw::Data::servers{NS} ) { |
205
|
0
|
|
|
|
|
0
|
$newsrv = $Net::Whois::Raw::Data::servers{NS}; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
2
|
0
|
33
|
|
|
21
|
if ( |
|
|
|
33
|
|
|
|
|
210
|
|
|
|
|
|
|
defined $newsrv && ( |
211
|
|
|
|
|
|
|
# Bypass recursing to custom servers |
212
|
|
|
|
|
|
|
$Net::Whois::Raw::Data::whois_servers_no_recurse{ $newsrv } |
213
|
|
|
|
|
|
|
# Bypass recursing to WHOIS servers with no IDN support |
214
|
|
|
|
|
|
|
|| $dom =~ /^xn--/i && $newsrv && $Net::Whois::Raw::Data::whois_servers_with_no_idn_support{ $newsrv } |
215
|
|
|
|
|
|
|
) |
216
|
|
|
|
|
|
|
) { |
217
|
0
|
|
|
|
|
0
|
$newsrv = undef; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
2
|
|
|
|
|
10
|
my @whois_recs = ( { text => $whois, srv => $srv } ); |
221
|
2
|
100
|
66
|
|
|
16
|
if ( $newsrv && $newsrv ne $srv ) { |
222
|
1
|
50
|
|
|
|
3
|
warn "recurse to $newsrv\n" if $DEBUG; |
223
|
|
|
|
|
|
|
|
224
|
1
|
50
|
|
|
|
69
|
return () if grep { $_ eq $newsrv } @$was_srv; |
|
0
|
|
|
|
|
0
|
|
225
|
|
|
|
|
|
|
|
226
|
1
|
|
|
|
|
4
|
my @new_whois_recs = eval { recursive_whois( $dom, $newsrv, [ @$was_srv, $srv ], 0, $is_ns ) }; |
|
1
|
|
|
|
|
8
|
|
227
|
1
|
50
|
|
|
|
4
|
my $new_whois = scalar @new_whois_recs ? $new_whois_recs[0]->{text} : ''; |
228
|
1
|
|
|
|
|
4
|
my $notfound = $Net::Whois::Raw::Data::notfound{ $newsrv }; |
229
|
|
|
|
|
|
|
|
230
|
1
|
50
|
33
|
|
|
36
|
if ( $new_whois && !$@ && not ( $notfound && $new_whois =~ /$notfound/im ) ) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
231
|
1
|
50
|
|
|
|
3
|
if ( $is_ns ) { |
232
|
0
|
|
|
|
|
0
|
unshift @whois_recs, @new_whois_recs; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
else { |
235
|
1
|
|
|
|
|
3
|
push @whois_recs, @new_whois_recs; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
else { |
239
|
0
|
0
|
|
|
|
0
|
warn "recursive query failed\n" if $DEBUG; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
2
|
|
|
|
|
17
|
return @whois_recs; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub whois_query { |
247
|
2
|
|
|
2
|
0
|
4
|
my ($dom, $srv, $is_ns) = @_; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Prepare query |
250
|
2
|
|
|
|
|
6
|
my $whoisquery = Net::Whois::Raw::Common::get_real_whois_query($dom, $srv, $is_ns); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# Prepare for query |
253
|
|
|
|
|
|
|
|
254
|
2
|
|
|
|
|
3
|
my (@sockparams, $sock); |
255
|
2
|
|
|
|
|
6
|
my (undef, $tld) = Net::Whois::Raw::Common::split_domain($dom); |
256
|
|
|
|
|
|
|
|
257
|
2
|
|
|
|
|
3
|
$tld = uc $tld; |
258
|
2
|
|
|
|
|
3
|
my $rotate_reference = undef; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
### get server for query |
261
|
2
|
|
|
|
|
8
|
my $server4query = Net::Whois::Raw::Common::get_server($dom); |
262
|
|
|
|
|
|
|
|
263
|
2
|
50
|
|
|
|
4
|
if ( Net::Whois::Raw::Common::is_ip6addr( $srv ) ) { |
264
|
0
|
|
|
|
|
0
|
$srv = "[$srv]"; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
2
|
50
|
|
|
|
6
|
my $srv_and_port = $srv =~ /\:\d+$/ ? $srv : "$srv:43"; |
268
|
2
|
50
|
|
|
|
22
|
if ($class->can('whois_query_sockparams')) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
269
|
0
|
|
|
|
|
0
|
@sockparams = $class->whois_query_sockparams ($dom, $srv); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
# hook for outside defined socket |
272
|
|
|
|
|
|
|
elsif ($class->can('whois_query_socket')) { |
273
|
0
|
|
|
|
|
0
|
$sock = $class->whois_query_socket ($dom, $srv); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
elsif (my $ips_arrayref = get_ips_for_query($server4query)) { |
276
|
0
|
|
|
|
|
0
|
$rotate_reference = $ips_arrayref; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
elsif (scalar(@SRC_IPS)) { |
279
|
0
|
|
|
|
|
0
|
$rotate_reference = \@SRC_IPS; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
else { |
282
|
2
|
|
|
|
|
2
|
@sockparams = $srv_and_port; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
|
286
|
2
|
50
|
|
|
|
4
|
if ($rotate_reference) { |
287
|
0
|
|
|
|
|
0
|
my $src_ip = $rotate_reference->[0]; |
288
|
0
|
|
|
|
|
0
|
push @$rotate_reference, shift @$rotate_reference; # rotate ips |
289
|
0
|
|
|
|
|
0
|
@sockparams = (PeerAddr => $srv_and_port, LocalAddr => $src_ip); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
2
|
50
|
|
|
|
6
|
print "QUERY: $whoisquery; SRV: $srv, ". |
293
|
|
|
|
|
|
|
"OMIT_MSG: $OMIT_MSG, CHECK_FAIL: $CHECK_FAIL, CACHE_DIR: $CACHE_DIR, ". |
294
|
|
|
|
|
|
|
"CACHE_TIME: $CACHE_TIME, TIMEOUT: $TIMEOUT\n" if $DEBUG >= 2; |
295
|
|
|
|
|
|
|
|
296
|
2
|
|
|
|
|
2
|
my $prev_alarm = undef; |
297
|
2
|
|
|
|
|
3
|
my $t0 = time(); |
298
|
|
|
|
|
|
|
|
299
|
2
|
|
|
|
|
3
|
my @lines; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# Make query |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
{ |
304
|
2
|
|
|
0
|
|
2
|
local $SIG{'ALRM'} = sub { die "Connection timeout to $srv" }; |
|
2
|
|
|
|
|
45
|
|
|
0
|
|
|
|
|
0
|
|
305
|
2
|
|
|
|
|
4
|
eval { |
306
|
|
|
|
|
|
|
|
307
|
2
|
50
|
|
|
|
9
|
$prev_alarm = alarm $TIMEOUT if $TIMEOUT; |
308
|
|
|
|
|
|
|
|
309
|
2
|
50
|
|
|
|
5
|
unless ( $sock ) { |
310
|
2
|
50
|
|
|
|
11
|
$sock = IO::Socket::IP->new( @sockparams ) |
311
|
|
|
|
|
|
|
or die "$srv: $!: " . join( ', ', @sockparams ); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
2
|
50
|
|
|
|
432758
|
if ($class->can ('whois_socket_fixup')) { |
315
|
0
|
|
|
|
|
0
|
my $new_sock = $class->whois_socket_fixup ($sock); |
316
|
0
|
0
|
|
|
|
0
|
$sock = $new_sock if $new_sock; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
2
|
50
|
|
|
|
21
|
if ($DEBUG > 2) { |
320
|
0
|
|
|
|
|
0
|
require Data::Dumper; |
321
|
0
|
|
|
|
|
0
|
print "Socket: ". Data::Dumper::Dumper($sock); |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
2
|
50
|
|
|
|
10
|
if ($QUERY_SUFFIX) { |
325
|
0
|
|
|
|
|
0
|
$whoisquery .= $QUERY_SUFFIX; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
2
|
|
|
|
|
61
|
$sock->print( $whoisquery, "\r\n" ); |
329
|
|
|
|
|
|
|
# TODO: $soc->read, parameters for read chunk size, max content length |
330
|
|
|
|
|
|
|
# Now you can redefine SOCK_CLASS::getline method as you want |
331
|
2
|
|
|
|
|
357
|
while (my $str = $sock->getline) { |
332
|
139
|
|
|
|
|
322101
|
push @lines, $str; |
333
|
|
|
|
|
|
|
} |
334
|
2
|
|
|
|
|
74
|
$sock->close; |
335
|
|
|
|
|
|
|
}; |
336
|
|
|
|
|
|
|
{ |
337
|
2
|
|
|
|
|
190
|
local $@; # large code block below, so preserve previous exception. |
|
2
|
|
|
|
|
4
|
|
338
|
2
|
50
|
|
|
|
8
|
if (defined $prev_alarm) { # if we ever set new alarm |
339
|
0
|
0
|
|
|
|
0
|
if ($prev_alarm == 0) { # there was no alarm previously |
340
|
0
|
|
|
|
|
0
|
alarm 0; # clear it |
341
|
|
|
|
|
|
|
} else { # there was an alarm previously |
342
|
0
|
|
|
|
|
0
|
$prev_alarm -= (time()- $t0); # try best to substract time elapsed |
343
|
0
|
0
|
|
|
|
0
|
$prev_alarm = 1 if $prev_alarm < 1; # we still need set it to something non-zero |
344
|
0
|
|
|
|
|
0
|
alarm $prev_alarm; # set it |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
} |
348
|
2
|
50
|
|
|
|
43
|
Carp::confess $@ if $@; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
2
|
|
|
|
|
7
|
foreach (@lines) { s/\r//g; } |
|
139
|
|
|
|
|
196
|
|
352
|
|
|
|
|
|
|
|
353
|
2
|
50
|
|
|
|
6
|
print "Received ".scalar(@lines)." lines\n" if $DEBUG >= 2; |
354
|
|
|
|
|
|
|
|
355
|
2
|
|
|
|
|
27
|
return \@lines; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub www_whois_query { |
359
|
0
|
|
|
0
|
0
|
0
|
my ($dom) = (lc shift); |
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
0
|
my ($resp, $url); |
362
|
0
|
|
|
|
|
0
|
my ($name, $tld) = Net::Whois::Raw::Common::split_domain( $dom ); |
363
|
|
|
|
|
|
|
|
364
|
0
|
|
|
|
|
0
|
my $http_query_urls = Net::Whois::Raw::Common::get_http_query_url($dom); |
365
|
|
|
|
|
|
|
|
366
|
0
|
|
|
|
|
0
|
foreach my $qurl ( @{$http_query_urls} ) { |
|
0
|
|
|
|
|
0
|
|
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# load-on-demand |
369
|
0
|
0
|
|
|
|
0
|
unless ($INC{'LWP/UserAgent.pm'}) { |
370
|
0
|
|
|
|
|
0
|
require LWP::UserAgent; |
371
|
0
|
|
|
|
|
0
|
require HTTP::Request; |
372
|
0
|
|
|
|
|
0
|
require HTTP::Headers; |
373
|
0
|
|
|
|
|
0
|
require URI::URL; |
374
|
0
|
|
|
|
|
0
|
import LWP::UserAgent; |
375
|
0
|
|
|
|
|
0
|
import HTTP::Request; |
376
|
0
|
|
|
|
|
0
|
import HTTP::Headers; |
377
|
0
|
|
|
|
|
0
|
import URI::URL; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
0
|
0
|
0
|
|
|
0
|
my $referer = delete $qurl->{form}{referer} if $qurl->{form} && defined $qurl->{form}{referer}; |
381
|
0
|
0
|
0
|
|
|
0
|
my $method = ( $qurl->{form} && scalar(keys %{$qurl->{form}}) ) ? 'POST' : 'GET'; |
382
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
my $ua; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
# hook for outside defined lwp |
386
|
0
|
0
|
|
|
|
0
|
if ($class->can ('whois_query_ua')) { |
387
|
0
|
|
|
|
|
0
|
$ua = $class->whois_query_ua ($dom); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
0
|
0
|
|
|
|
0
|
unless($ua){ |
391
|
0
|
|
|
|
|
0
|
$ua = new LWP::UserAgent( parse_head => 0 ); |
392
|
0
|
|
|
|
|
0
|
$ua->agent('Mozilla/5.0 (X11; U; Linux i686; ru; rv:1.9.0.5) Gecko/2008121622 Fedora/3.0.5-1.fc10 Firefox/3.0.5'); |
393
|
|
|
|
|
|
|
} |
394
|
0
|
|
|
|
|
0
|
my $header = HTTP::Headers->new; |
395
|
0
|
0
|
|
|
|
0
|
$header->header('Referer' => $referer) if $referer; |
396
|
0
|
|
|
|
|
0
|
my $req = new HTTP::Request $method, $qurl->{url}, $header; |
397
|
|
|
|
|
|
|
|
398
|
0
|
0
|
|
|
|
0
|
if ($method eq 'POST') { |
399
|
0
|
|
|
|
|
0
|
require URI::URL; |
400
|
0
|
|
|
|
|
0
|
import URI::URL; |
401
|
|
|
|
|
|
|
|
402
|
0
|
|
|
|
|
0
|
my $curl = url("http:"); |
403
|
0
|
|
|
|
|
0
|
$req->content_type('application/x-www-form-urlencoded'); |
404
|
0
|
|
|
|
|
0
|
$curl->query_form( %{$qurl->{form}} ); |
|
0
|
|
|
|
|
0
|
|
405
|
0
|
|
|
|
|
0
|
$req->content( $curl->equery ); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
0
|
$resp = eval { |
409
|
0
|
|
|
0
|
|
0
|
local $SIG{ALRM} = sub { die "www_whois connection timeout" }; |
|
0
|
|
|
|
|
0
|
|
410
|
0
|
|
|
|
|
0
|
alarm 10; |
411
|
0
|
|
|
|
|
0
|
$ua->request($req)->content; |
412
|
|
|
|
|
|
|
}; |
413
|
0
|
|
|
|
|
0
|
alarm 0; |
414
|
|
|
|
|
|
|
|
415
|
0
|
0
|
0
|
|
|
0
|
if ( !$resp || $@ || $resp =~ /www_whois connection timeout/ || $resp =~ /^500 Can\'t connect/ ) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
416
|
0
|
|
|
|
|
0
|
undef $resp; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
else { |
419
|
0
|
|
|
|
|
0
|
$url = $qurl->{url}; |
420
|
0
|
|
|
|
|
0
|
last; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
0
|
0
|
|
|
|
0
|
return undef unless $resp; |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
0
|
chomp $resp; |
427
|
0
|
|
|
|
|
0
|
$resp =~ s/\r//g; |
428
|
|
|
|
|
|
|
|
429
|
0
|
|
|
|
|
0
|
my $ishtml; |
430
|
|
|
|
|
|
|
|
431
|
0
|
|
|
|
|
0
|
$resp = Net::Whois::Raw::Common::parse_www_content($resp, $tld, $url, $CHECK_EXCEED); |
432
|
|
|
|
|
|
|
|
433
|
0
|
0
|
|
|
|
0
|
return wantarray ? ($resp, $ishtml) : $resp; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub import { |
438
|
2
|
|
|
2
|
|
17
|
my $mypkg = shift; |
439
|
2
|
|
|
|
|
4
|
my $callpkg = caller; |
440
|
|
|
|
|
|
|
|
441
|
4
|
|
|
4
|
|
25
|
no strict 'refs'; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
663
|
|
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# export subs |
444
|
2
|
|
|
|
|
4
|
*{"$callpkg\::$_"} = \&{"$mypkg\::$_"} foreach ((@EXPORT, @_)); |
|
4
|
|
|
|
|
27
|
|
|
4
|
|
|
|
|
12
|
|
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub set_ips_for_server { |
449
|
0
|
|
|
0
|
1
|
0
|
my ($server, $ips) = @_; |
450
|
|
|
|
|
|
|
|
451
|
0
|
0
|
0
|
|
|
0
|
croak "Missing params" if (!$ips || !$server); |
452
|
|
|
|
|
|
|
|
453
|
0
|
|
|
|
|
0
|
$server = lc $server; |
454
|
0
|
|
|
|
|
0
|
$_IPS->{$server} = $ips; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub get_ips_for_query { |
459
|
2
|
|
|
2
|
0
|
4
|
my ($server) = @_; |
460
|
|
|
|
|
|
|
|
461
|
2
|
|
|
|
|
3
|
$server = lc $server; |
462
|
2
|
50
|
|
|
|
4
|
if ($_IPS->{$server}) { |
463
|
0
|
|
|
|
|
0
|
return $_IPS->{$server}; |
464
|
|
|
|
|
|
|
} |
465
|
2
|
|
|
|
|
6
|
return undef; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
1; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
__END__ |