line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# $Id$ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# client::whois Brik |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
package Metabrik::Client::Whois; |
7
|
1
|
|
|
1
|
|
852
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
8
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
6
|
use base qw(Metabrik); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1110
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub brik_properties { |
13
|
|
|
|
|
|
|
return { |
14
|
0
|
|
|
0
|
1
|
|
revision => '$Revision$', |
15
|
|
|
|
|
|
|
tags => [ qw(unstable) ], |
16
|
|
|
|
|
|
|
author => 'GomoR ', |
17
|
|
|
|
|
|
|
license => 'http://opensource.org/licenses/BSD-3-Clause', |
18
|
|
|
|
|
|
|
attributes => { |
19
|
|
|
|
|
|
|
use_normalization => [ qw(0|1) ], |
20
|
|
|
|
|
|
|
}, |
21
|
|
|
|
|
|
|
attributes_default => { |
22
|
|
|
|
|
|
|
use_normalization => 1, |
23
|
|
|
|
|
|
|
}, |
24
|
|
|
|
|
|
|
commands => { |
25
|
|
|
|
|
|
|
from_ip => [ qw(ip_address) ], |
26
|
|
|
|
|
|
|
from_domain => [ qw(domain) ], |
27
|
|
|
|
|
|
|
is_available_domain => [ qw(domain) ], |
28
|
|
|
|
|
|
|
parse_raw_ip_whois => [ qw($lines_list) ], |
29
|
|
|
|
|
|
|
normalize_raw_ip_whois => [ qw($chunks $lines_list) ], |
30
|
|
|
|
|
|
|
is_ip_from_owner => [ qw(ip_address owner) ], |
31
|
|
|
|
|
|
|
}, |
32
|
|
|
|
|
|
|
require_modules => { |
33
|
|
|
|
|
|
|
'Metabrik::Network::Address' => [ ], |
34
|
|
|
|
|
|
|
'Metabrik::Network::Whois' => [ ], |
35
|
|
|
|
|
|
|
'Metabrik::String::Parse' => [ ], |
36
|
|
|
|
|
|
|
}, |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub parse_raw_ip_whois { |
41
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
42
|
0
|
|
|
|
|
|
my ($lines) = @_; |
43
|
|
|
|
|
|
|
|
44
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('parse_raw_ip_whois', $lines) or return; |
45
|
|
|
|
|
|
|
|
46
|
0
|
0
|
|
|
|
|
my $sp = Metabrik::String::Parse->new_from_brik_init($self) or return; |
47
|
0
|
0
|
|
|
|
|
my $chunks = $sp->split_by_blank_line($lines) or return; |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
my @abuse = (); |
50
|
0
|
|
|
|
|
|
my @chunks = (); |
51
|
0
|
|
|
|
|
|
for my $this (@$chunks) { |
52
|
0
|
|
|
|
|
|
my $new = {}; |
53
|
0
|
|
|
|
|
|
for (@$this) { |
54
|
|
|
|
|
|
|
# Some whois prefix every line by 'network:' |
55
|
0
|
|
|
|
|
|
s/^\s*network\s*:\s*//; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# If an abuse email adress can be found, we gather it. |
58
|
0
|
0
|
0
|
|
|
|
if (/abuse/i && /\@/) { |
59
|
0
|
|
|
|
|
|
my ($new) = $_ =~ /([A-Za-z0-9\._-]+\@[A-Za-z0-9\._-]+)/; |
60
|
0
|
0
|
|
|
|
|
if (defined($new)) { |
61
|
0
|
0
|
|
|
|
|
defined($new) ? ($new =~ s/['"]//g) : (); |
62
|
0
|
|
|
|
|
|
push @abuse, $new; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
0
|
0
|
|
|
|
|
if (/^\s*%error 230 No objects found/i) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$new->{match} = 0; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
elsif (/^\s*%error 350 Invalid Query Syntax/i) { |
70
|
0
|
|
|
|
|
|
$new->{has_error} = 1; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
elsif (/^\s*%error 501 Service Not Available: exceeded max client sessions/i) { |
73
|
0
|
|
|
|
|
|
$new->{has_error} = 1; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
elsif (/^\s*%ok\s*$/) { |
76
|
0
|
|
|
|
|
|
$new->{has_error} = 1; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
0
|
0
|
|
|
|
|
next if (/^\s*%/); # Skip comments |
80
|
0
|
0
|
|
|
|
|
next if (/^\s*#/); # Skip comments |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# We default to split by the first encountered : char |
83
|
0
|
0
|
|
|
|
|
if (/^\s*([^:]+?)\s*:\s*(.*)\s*$/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
84
|
0
|
0
|
0
|
|
|
|
if (defined($1) && defined($2)) { |
85
|
0
|
|
|
|
|
|
my $k = lc($1); |
86
|
0
|
|
|
|
|
|
my $v = $2; |
87
|
0
|
|
|
|
|
|
$k =~ s{[ /-]}{_}g; |
88
|
0
|
0
|
|
|
|
|
if (exists($new->{$k})) { |
89
|
0
|
|
|
|
|
|
$new->{$k} .= "\n$v"; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
else { |
92
|
0
|
|
|
|
|
|
$new->{$k} = $v; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
# We try to guess an inetnum. Example: |
97
|
|
|
|
|
|
|
# Akamai Technologies, Inc. AKAMAI (NET-104-64-0-0-1) 104.64.0.0 - 104.127.255.255 |
98
|
|
|
|
|
|
|
elsif (/^\s*([^\(]+)\(([^\)]+)\)\s*(\S+\s*-\s*\S+)$/) { |
99
|
0
|
|
|
|
|
|
my $description = $1; |
100
|
0
|
|
|
|
|
|
my $netname = $2; |
101
|
0
|
|
|
|
|
|
my $inetnum = $3; |
102
|
0
|
|
|
|
|
|
$new->{description} = $description; |
103
|
0
|
|
|
|
|
|
$new->{netname} = $netname; |
104
|
0
|
|
|
|
|
|
$new->{inetnum} = $inetnum; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
# Nothing known. Exemple: |
107
|
|
|
|
|
|
|
# No match found for aaa |
108
|
|
|
|
|
|
|
elsif (/^\s*No match found for /i) { |
109
|
0
|
|
|
|
|
|
$new->{match} = 0; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# If we found some email address along with 'abuse' string, we add this email address |
114
|
0
|
0
|
|
|
|
|
if (@abuse > 0) { |
115
|
0
|
|
|
|
|
|
$new->{abuse} = join("\n", @abuse); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
0
|
0
|
0
|
|
|
|
if (keys %$new > 0 && ! exists($new->{match})) { |
119
|
0
|
|
|
|
|
|
$new->{match} = 1; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
|
if (keys %$new > 0) { |
123
|
0
|
|
|
|
|
|
push @chunks, $new; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
|
return \@chunks; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub _ip_lookup { |
131
|
0
|
|
|
0
|
|
|
my $self = shift; |
132
|
0
|
|
|
|
|
|
my ($this, $key, $normalize, $result) = @_; |
133
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
return $self->_domain_lookup($this, $key, $normalize, $result); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub normalize_raw_ip_whois { |
138
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
139
|
0
|
|
|
|
|
|
my ($chunks, $lines) = @_; |
140
|
|
|
|
|
|
|
|
141
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('normalize_raw_ip_whois', $chunks) or return; |
142
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('normalize_raw_ip_whois', $lines) or return; |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
my $r = { raw => $lines }; |
145
|
|
|
|
|
|
|
#my $r = {}; |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
my $n_chunks = @$chunks; |
148
|
0
|
0
|
|
|
|
|
if (@$chunks <= 0) { |
149
|
0
|
|
|
|
|
|
return $self->log->error("normalize_raw_ip_whois: nothing to normalize"); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# We search for the first chunk with an inetnum. |
153
|
0
|
|
|
|
|
|
my $general; |
154
|
0
|
|
|
|
|
|
for (@$chunks) { |
155
|
0
|
0
|
0
|
|
|
|
if (exists($_->{inetnum}) || exists($_->{netrange}) || exists($_->{network}) || exists($_->{ip_network})) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
156
|
0
|
|
|
|
|
|
$general = $_; |
157
|
0
|
|
|
|
|
|
last; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
0
|
0
|
|
|
|
|
if (! defined($general)) { |
161
|
1
|
|
|
1
|
|
9
|
use Data::Dumper; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
1675
|
|
162
|
0
|
|
|
|
|
|
print Dumper($chunks)."\n"; |
163
|
0
|
|
|
|
|
|
return $self->log->error("normalize_raw_ip_whois: no inetnum found in this record"); |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# inetnum,netrange,network,ip_network |
167
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'inetnum', 'inetnum', $r); |
168
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'netrange', 'inetnum', $r); |
169
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'network', 'inetnum', $r); |
170
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'ip_network', 'inetnum', $r); |
171
|
|
|
|
|
|
|
# cidr, |
172
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'cidr', 'cidr', $r); |
173
|
|
|
|
|
|
|
# nethandle, |
174
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'nethandle', 'nethandle', $r); |
175
|
|
|
|
|
|
|
# created, |
176
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'created', 'date_created', $r); |
177
|
|
|
|
|
|
|
# updated,last_modified, |
178
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'updated', 'date_updated', $r); |
179
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'last_modified', 'date_updated', $r); |
180
|
|
|
|
|
|
|
# originas,origin, |
181
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'originas', 'originas', $r); |
182
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'origin', 'originas', $r); |
183
|
|
|
|
|
|
|
# netname,ownerid, |
184
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'netname', 'netname', $r); |
185
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'ownerid', 'netname', $r); |
186
|
|
|
|
|
|
|
# descr, |
187
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'descr', 'description', $r); |
188
|
|
|
|
|
|
|
# parent, |
189
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'parent', 'netparent', $r); |
190
|
|
|
|
|
|
|
# nettype, |
191
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'nettype', 'nettype', $r); |
192
|
|
|
|
|
|
|
# organization,org,owner,org_name, |
193
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'organization', 'organization', $r); |
194
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'org', 'organization', $r); |
195
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'owner', 'organization', $r); |
196
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'org_name', 'organization', $r); |
197
|
|
|
|
|
|
|
# regdate, |
198
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'regdate', 'date_registered', $r); |
199
|
|
|
|
|
|
|
# ref, |
200
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'ref', 'ref', $r); |
201
|
|
|
|
|
|
|
# country, |
202
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'country', 'country', $r); |
203
|
|
|
|
|
|
|
# source, |
204
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'source', 'source', $r); |
205
|
|
|
|
|
|
|
# status, |
206
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'status', 'status', $r); |
207
|
|
|
|
|
|
|
# abuse,abuse_c, |
208
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'abuse', 'abuse', $r); |
209
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'abuse_c', 'abuse', $r); |
210
|
|
|
|
|
|
|
# nserver, |
211
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'nserver', 'nserver', $r); |
212
|
|
|
|
|
|
|
# phone, |
213
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'phone', 'phone', $r); |
214
|
|
|
|
|
|
|
# responsible, |
215
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'responsible', 'responsible', $r); |
216
|
|
|
|
|
|
|
# address, |
217
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'address', 'address', $r); |
218
|
|
|
|
|
|
|
# city, |
219
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'city', 'city', $r); |
220
|
|
|
|
|
|
|
# sponsoring_org, |
221
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'sponsoring_org', 'sponsoring_org', $r); |
222
|
|
|
|
|
|
|
# route,inetnum-up, |
223
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'route', 'route', $r); |
224
|
0
|
|
|
|
|
|
$self->_ip_lookup($general, 'inetnum_up', 'route', $r); |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# We search for a chunk with AS information (usually the last chunk) |
227
|
0
|
|
|
|
|
|
my $asinfo; |
228
|
0
|
|
|
|
|
|
for (reverse @$chunks) { |
229
|
0
|
0
|
0
|
|
|
|
if (exists($_->{origin}) && exists($_->{route})) { |
230
|
0
|
|
|
|
|
|
$asinfo = $_; |
231
|
0
|
|
|
|
|
|
last; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
$self->_ip_lookup($asinfo, 'route', 'route', $r); |
236
|
0
|
|
|
|
|
|
$self->_ip_lookup($asinfo, 'origin', 'originas', $r); |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
my @fields = qw( |
239
|
|
|
|
|
|
|
inetnum |
240
|
|
|
|
|
|
|
cidr |
241
|
|
|
|
|
|
|
nethandle |
242
|
|
|
|
|
|
|
date_created |
243
|
|
|
|
|
|
|
date_updated |
244
|
|
|
|
|
|
|
originas |
245
|
|
|
|
|
|
|
netname |
246
|
|
|
|
|
|
|
description |
247
|
|
|
|
|
|
|
netparent |
248
|
|
|
|
|
|
|
nettype |
249
|
|
|
|
|
|
|
organization |
250
|
|
|
|
|
|
|
date_registered |
251
|
|
|
|
|
|
|
ref |
252
|
|
|
|
|
|
|
country |
253
|
|
|
|
|
|
|
source |
254
|
|
|
|
|
|
|
status |
255
|
|
|
|
|
|
|
abuse |
256
|
|
|
|
|
|
|
nserver |
257
|
|
|
|
|
|
|
phone |
258
|
|
|
|
|
|
|
responsible |
259
|
|
|
|
|
|
|
address |
260
|
|
|
|
|
|
|
city |
261
|
|
|
|
|
|
|
sponsoring_org |
262
|
|
|
|
|
|
|
route |
263
|
|
|
|
|
|
|
); |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# Put default values for missing fields |
266
|
0
|
|
|
|
|
|
for (@fields) { |
267
|
0
|
|
0
|
|
|
|
$r->{$_} ||= 'undef'; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Dedups lines |
271
|
0
|
|
|
|
|
|
for (keys %$r) { |
272
|
0
|
0
|
|
|
|
|
next if $_ eq 'raw'; |
273
|
0
|
0
|
|
|
|
|
if (my @toks = split(/\n/, $r->{$_})) { |
274
|
0
|
|
|
|
|
|
my %uniq = map { $_ => 1 } @toks; |
|
0
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
$r->{$_} = join("\n", sort { $a cmp $b } keys %uniq); # With a sort |
|
0
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
0
|
|
|
|
|
|
return $r; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub from_ip { |
283
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
284
|
0
|
|
|
|
|
|
my ($ip) = @_; |
285
|
|
|
|
|
|
|
|
286
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('ip', $ip) or return; |
287
|
|
|
|
|
|
|
|
288
|
0
|
0
|
|
|
|
|
my $na = Metabrik::Network::Address->new_from_brik_init($self) or return; |
289
|
0
|
0
|
|
|
|
|
if (! $na->is_ip($ip)) { |
290
|
0
|
|
|
|
|
|
return $self->log->error("ip: not a valid IP address [$ip]"); |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
0
|
0
|
|
|
|
|
my $nw = Metabrik::Network::Whois->new_from_brik_init($self) or return; |
294
|
0
|
0
|
|
|
|
|
my $lines = $nw->target($ip) or return; |
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
|
|
|
my $r = {}; |
297
|
0
|
0
|
|
|
|
|
if ($self->use_normalization) { |
298
|
0
|
0
|
|
|
|
|
my $chunks = $self->parse_raw_ip_whois($lines) or return; |
299
|
0
|
0
|
|
|
|
|
$r = $self->normalize_raw_ip_whois($chunks, $lines) or return; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
0
|
|
|
|
|
|
$r->{date_queried} = localtime(); |
303
|
0
|
|
|
|
|
|
$r->{whois_server} = $nw->last_server; |
304
|
0
|
|
|
|
|
|
$r->{raw} = $lines; |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
return $r; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub _domain_lookup { |
310
|
0
|
|
|
0
|
|
|
my $self = shift; |
311
|
0
|
|
|
|
|
|
my ($this, $key, $normalize, $result) = @_; |
312
|
|
|
|
|
|
|
|
313
|
0
|
0
|
|
|
|
|
if (exists($this->{$key})) { |
314
|
|
|
|
|
|
|
exists($result->{$normalize}) |
315
|
|
|
|
|
|
|
? ($result->{$normalize} .= "\n".$this->{$key}) |
316
|
0
|
0
|
|
|
|
|
: ($result->{$normalize} = $this->{$key}); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
return $this; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub from_domain { |
323
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
324
|
0
|
|
|
|
|
|
my ($domain) = @_; |
325
|
|
|
|
|
|
|
|
326
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('domain', $domain) or return; |
327
|
|
|
|
|
|
|
|
328
|
0
|
0
|
|
|
|
|
my $na = Metabrik::Network::Address->new_from_brik_init($self) or return; |
329
|
0
|
0
|
|
|
|
|
if ($na->is_ip($domain)) { |
330
|
0
|
|
|
|
|
|
return $self->log->error("domain: domain [$domain] must not be an IP address"); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
0
|
0
|
|
|
|
|
my $nw = Metabrik::Network::Whois->new_from_brik_init($self) or return; |
334
|
0
|
0
|
|
|
|
|
my $lines = $nw->target($domain) or return; |
335
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
|
my $r = { raw => $lines }; |
337
|
0
|
|
|
|
|
|
$r->{date_queried} = localtime(); |
338
|
0
|
|
|
|
|
|
$r->{whois_server} = $nw->last_server; |
339
|
|
|
|
|
|
|
|
340
|
0
|
0
|
|
|
|
|
if ($self->use_normalization) { |
341
|
0
|
|
|
|
|
|
my $chunks = $self->parse_raw_ip_whois($lines); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# 4 categories: general, registrant, admin, tech |
344
|
0
|
|
|
|
|
|
for (@$chunks) { |
345
|
|
|
|
|
|
|
# Registrar,Sponsoring Registrar, |
346
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrar', 'registrar', $r); |
347
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'sponsoring_registrar', 'registrar', $r); |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# Whois Server, |
350
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'whois_server', 'whois_server', $r); |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# Domain Name,Dominio,domain, |
353
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'domain_name', 'domain_name', $r); |
354
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'dominio', 'domain_name', $r); |
355
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'domain', 'domain_name', $r); |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# Creation Date,Fecha de registro,created, |
358
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'creation_date', 'creation_date', $r); |
359
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'fecha_de_registro', 'creation_date', $r); |
360
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'created', 'creation_date', $r); |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
# Updated Date,last-update, |
363
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'updated_date', 'updated_date', $r); |
364
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'last_update', 'updated_date', $r); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# Registrar Registration Expiration Date,Expiration Date,Registry Expiry Date,Fecha de vencimiento,Expiry Date, |
367
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrar_registration_expiration_date', 'expiration_date', $r); |
368
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'expiration_date', 'expiration_date', $r); |
369
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registry_expiry_date', 'expiration_date', $r); |
370
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'fecha_de_vencimiento', 'expiration_date', $r); |
371
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'expiry_date', 'expiration_date', $r); |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
# Registrar URL,Referral URL, |
374
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrar_url', 'registrar_url', $r); |
375
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'referral_url', 'registrar_url', $r); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# DNSSEC, |
378
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'dnssec', 'dnssec', $r); |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
# Domain Status,Status, |
381
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'domain_status', 'domain_status', $r); |
382
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'status', 'domain_status', $r); |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# Name Server,nserver, |
385
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'name_server', 'name_server', $r); |
386
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'nserver', 'name_server', $r); |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# Registrant Name, |
389
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_name', 'registrant_name', $r); |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# Registrant Organization,Organizacion, |
392
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_organization', 'registrant_organization', $r); |
393
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'organizacion', 'registrar', $r); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# Registrant Street, |
396
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_street', 'registrant_street', $r); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
# Registrant City,Ciudad, |
399
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_city', 'registrant_city', $r); |
400
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'ciudad', 'registrant_city', $r); |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Registrant Postal Code, |
403
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_postal_code', 'registrant_postal_code', $r); |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# Registrant State/Province, |
406
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_state_province', 'registrant_state_province', $r); |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# Registrant Country,Pais, |
409
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_country', 'registrant_country', $r); |
410
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'pais', 'registrant_country', $r); |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
# Registrant Email, |
413
|
0
|
|
|
|
|
|
$self->_domain_lookup($_, 'registrant_email', 'registrant_email', $r); |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# Dedups lines |
417
|
0
|
|
|
|
|
|
for (keys %$r) { |
418
|
0
|
0
|
|
|
|
|
next if $_ eq 'raw'; |
419
|
0
|
0
|
|
|
|
|
if (my @toks = split(/\n/, $r->{$_})) { |
420
|
0
|
|
|
|
|
|
my %uniq = map { $_ => 1 } @toks; |
|
0
|
|
|
|
|
|
|
421
|
0
|
|
|
|
|
|
$r->{$_} = join("\n", sort { $a cmp $b } keys %uniq); # With a sort |
|
0
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
# If there is more than the raw key, domain exists |
426
|
0
|
0
|
|
|
|
|
if (keys %$r > 1) { |
427
|
0
|
|
|
|
|
|
$r->{domain_exists} = 1; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
else { |
430
|
0
|
|
|
|
|
|
$r->{domain_exists} = 0; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
|
return $r; |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
sub is_available_domain { |
438
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
439
|
0
|
|
|
|
|
|
my ($domain) = shift; |
440
|
|
|
|
|
|
|
|
441
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('is_available_domain', $domain) or return; |
442
|
|
|
|
|
|
|
|
443
|
0
|
0
|
|
|
|
|
my $info = $self->domain($domain) or return; |
444
|
|
|
|
|
|
|
|
445
|
0
|
|
|
|
|
|
return $info->{domain_exists}; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub is_ip_from_owner { |
449
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
450
|
0
|
|
|
|
|
|
my ($ip, $owner) = @_; |
451
|
|
|
|
|
|
|
|
452
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('is_ip_from_owner', $ip) or return; |
453
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('is_ip_from_owner', $owner) or return; |
454
|
|
|
|
|
|
|
|
455
|
0
|
0
|
|
|
|
|
my $r = $self->ip($ip) or return; |
456
|
0
|
0
|
0
|
|
|
|
if ((exists($r->{description}) && $r->{description} =~ m{$owner}i) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
457
|
|
|
|
|
|
|
|| (exists($r->{organization}) && $r->{organization} =~ m{$owner}i)) { |
458
|
0
|
|
|
|
|
|
return 1; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
0
|
|
|
|
|
|
return 0; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
1; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
__END__ |