line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Google::SafeBrowsing4; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
108614
|
use strict; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
46
|
|
4
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
50
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
8
|
use Carp; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
93
|
|
7
|
2
|
|
|
2
|
|
830
|
use Digest::SHA qw(sha256); |
|
2
|
|
|
|
|
4665
|
|
|
2
|
|
|
|
|
146
|
|
8
|
2
|
|
|
2
|
|
22
|
use Exporter qw(import); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
55
|
|
9
|
2
|
|
|
2
|
|
9
|
use HTTP::Message; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
34
|
|
10
|
2
|
|
|
2
|
|
537
|
use JSON::XS; |
|
2
|
|
|
|
|
3906
|
|
|
2
|
|
|
|
|
98
|
|
11
|
2
|
|
|
2
|
|
10
|
use List::Util qw(first); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
122
|
|
12
|
2
|
|
|
2
|
|
9
|
use LWP::UserAgent; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
43
|
|
13
|
2
|
|
|
2
|
|
784
|
use MIME::Base64; |
|
2
|
|
|
|
|
941
|
|
|
2
|
|
|
|
|
86
|
|
14
|
2
|
|
|
2
|
|
709
|
use Text::Trim; |
|
2
|
|
|
|
|
924
|
|
|
2
|
|
|
|
|
92
|
|
15
|
2
|
|
|
2
|
|
787
|
use Time::HiRes qw(time); |
|
2
|
|
|
|
|
1997
|
|
|
2
|
|
|
|
|
6
|
|
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
1005
|
use Net::Google::SafeBrowsing4::URI; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
130
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our @EXPORT = qw(DATABASE_RESET INTERNAL_ERROR SERVER_ERROR NO_UPDATE NO_DATA SUCCESSFUL); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $VERSION = '0.7'; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 NAME |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
Net::Google::SafeBrowsing4 - Perl extension for the Google Safe Browsing v4 API. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 SYNOPSIS |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
use Net::Google::SafeBrowsing4; |
30
|
|
|
|
|
|
|
use Net::Google::SafeBrowsing4::Storage::File; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $storage = Net::Google::SafeBrowsing4::Storage::File->new(path => '.'); |
33
|
|
|
|
|
|
|
my $gsb = Net::Google::SafeBrowsing4->new( |
34
|
|
|
|
|
|
|
key => "my key", |
35
|
|
|
|
|
|
|
storage => $storage, |
36
|
|
|
|
|
|
|
logger => Log::Log4perl->get_logger(); |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
$gsb->update(); |
40
|
|
|
|
|
|
|
my @matches = $gsb->lookup(url => 'http://ianfette.org/'); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
if (scalar(@matches) > 0) { |
43
|
|
|
|
|
|
|
print("http://ianfette.org/ is flagged as a dangerous site\n"); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
$storage->close(); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DESCRIPTION |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Net::Google::SafeBrowsing4 implements the Google Safe Browsing v4 API. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
The Google Safe Browsing database must be stored and managed locally. L uses files as the storage back-end. Other storage mechanisms (databases, memory, etc.) can be added and used transparently with this module. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
The source code is available on github at L. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
If you do not need to inspect more than 10,000 URLs a day, you can use Net::Google::SafeBrowsing4::Lookup with the Google Safe Browsing v4 Lookup API which does not require to store and maintain a local database. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
IMPORTANT: Google Safe Browsing v4 requires an API key from Google: https://developers.google.com/safe-browsing/v4/get-started. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 CONSTANTS |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Several constants are exported by this module: |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=over 4 |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=item DATABASE_RESET |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Google requested to reset (empty) the local database. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=item INTERNAL_ERROR |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
An internal error occurred. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=item SERVER_ERROR |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
The server sent an error back to the client. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item NO_UPDATE |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
No update was performed, probably because it is too early to make a new request to Google Safe Browsing. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item NO_DATA |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
No data was sent back by Google to the client, probably because the database is up to date. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=item SUCCESSFUL |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
The update operation was successful. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=back |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=cut |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
use constant { |
98
|
2
|
|
|
|
|
5959
|
DATABASE_RESET => -6, # local database too old |
99
|
|
|
|
|
|
|
INTERNAL_ERROR => -3, # internal/parsing error |
100
|
|
|
|
|
|
|
SERVER_ERROR => -2, # server sent an error back |
101
|
|
|
|
|
|
|
NO_UPDATE => -1, # no update (too early) |
102
|
|
|
|
|
|
|
NO_DATA => 0, # no data sent |
103
|
|
|
|
|
|
|
SUCCESSFUL => 1, # data sent |
104
|
2
|
|
|
2
|
|
12
|
}; |
|
2
|
|
|
|
|
4
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 new() |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Create a Net::Google::SafeBrowsing4 object |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
my $gsb = Net::Google::SafeBrowsing4->new( |
115
|
|
|
|
|
|
|
key => "my key", |
116
|
|
|
|
|
|
|
storage => Net::Google::SafeBrowsing4::Storage::File->new(path => '.'), |
117
|
|
|
|
|
|
|
lists => ["*/ANY_PLATFORM/URL"], |
118
|
|
|
|
|
|
|
); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Arguments |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=over 4 |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=item base |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Safe Browsing base URL. https://safebrowsing.googleapis.com by default |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=item key |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
Required. Your Google Safe Browsing API key |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=item storage |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Required. Object which handles the storage for the Google Safe Browsing database. See L for more details. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=item lists |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Optional. The Google Safe Browsing lists to handle. By default, handles all lists. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item logger |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Optional. L compatible object reference. By default this option is unset, making Net::Google::SafeBrowsing4 silent. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=item perf |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Optional. Set to 1 to enable performance information logging. Needs a I, performance information will be logged on DEBUG level. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=item version |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Optional. Google Safe Browsing version. 4 by default |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item http_agent |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Optional. L to use for HTTPS requests. Use this option for advanced networking options, |
155
|
|
|
|
|
|
|
like L. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=item http_timeout |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Optional. Network timeout setting for L (60 seconds by default) |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=item http_compression |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Optional. List of accepted compressions for HTTP response. Enabling all supported compressions reported by L by default. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=item max_hash_request |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Optional. maximum number of full hashes to request. (500 by default) |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=back |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub new { |
175
|
13
|
|
|
13
|
1
|
874
|
my ($class, %args) = @_; |
176
|
|
|
|
|
|
|
|
177
|
13
|
|
|
|
|
58
|
my $self = { |
178
|
|
|
|
|
|
|
base => 'https://safebrowsing.googleapis.com', |
179
|
|
|
|
|
|
|
lists => [], |
180
|
|
|
|
|
|
|
all_lists => [], |
181
|
|
|
|
|
|
|
key => '', |
182
|
|
|
|
|
|
|
version => '4', |
183
|
|
|
|
|
|
|
last_error => '', |
184
|
|
|
|
|
|
|
perf => 0, |
185
|
|
|
|
|
|
|
logger => undef, |
186
|
|
|
|
|
|
|
storage => undef, |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
http_agent => LWP::UserAgent->new(), |
189
|
|
|
|
|
|
|
http_timeout => 60, |
190
|
|
|
|
|
|
|
http_compression => '' . HTTP::Message->decodable(), |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
max_hash_request => 500, |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
%args, |
195
|
|
|
|
|
|
|
}; |
196
|
|
|
|
|
|
|
|
197
|
13
|
100
|
|
|
|
87935
|
if (!$self->{key}) { |
198
|
2
|
50
|
|
|
|
5
|
$self->{logger} && $self->{logger}->error("Net::Google::SafeBrowsing4 needs an API key!"); |
199
|
2
|
|
|
|
|
47
|
return undef; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
11
|
100
|
|
|
|
39
|
if (!$self->{http_agent}) { |
203
|
1
|
50
|
|
|
|
4
|
$self->{logger} && $self->{logger}->error("Net::Google::SafeBrowsing4 needs an LWP::UserAgent!"); |
204
|
1
|
|
|
|
|
4
|
return undef; |
205
|
|
|
|
|
|
|
} |
206
|
10
|
|
|
|
|
37
|
$self->{http_agent}->timeout($self->{http_timeout}); |
207
|
10
|
|
|
|
|
143
|
$self->{http_agent}->default_header("Content-Type" => "application/json"); |
208
|
10
|
|
|
|
|
442
|
$self->{http_agent}->default_header("Accept-Encoding" => $self->{http_compression}); |
209
|
|
|
|
|
|
|
|
210
|
10
|
100
|
|
|
|
362
|
if (!$self->{storage}) { |
211
|
1
|
50
|
|
|
|
3
|
$self->{logger} && $self->{logger}->error("Net::Google::SafeBrowsing4 needs a Storage object!"); |
212
|
1
|
|
|
|
|
11
|
return undef; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
9
|
50
|
|
|
|
25
|
if (ref($self->{lists}) ne 'ARRAY') { |
216
|
0
|
|
|
|
|
0
|
$self->{lists} = [$self->{lists}]; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
9
|
|
|
|
|
32
|
$self->{base} = join("/", $self->{base}, "v" . $self->{version}); |
220
|
|
|
|
|
|
|
|
221
|
9
|
|
|
|
|
18
|
bless($self, $class); |
222
|
9
|
|
|
|
|
32
|
return $self; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 PUBLIC FUNCTIONS |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 update() |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Performs a database update. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
$gsb->update(); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Returns the status of the update (see the list of constants above): INTERNAL_ERROR, SERVER_ERROR, NO_UPDATE, NO_DATA or SUCCESSFUL |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
This function can handle multiple lists at the same time. If one of the lists should not be updated, it will automatically skip it and update the other one. It is faster to update all lists at once rather than doing them one by one. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Arguments |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=over 4 |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=item lists |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Optional. Update specific lists. Use the list(s) from new() by default. List are in the format "MALWARE/WINDOWS/URLS" or "*/WINDOWS/*" where * means all possible values. |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item force |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Optional. Force the update (1). Disabled by default (0). |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Be careful if you set this option to 1 as too frequent updates might result in the blacklisting of your API key. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=back |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=cut |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub update { |
259
|
0
|
|
|
0
|
1
|
0
|
my ($self, %args) = @_; |
260
|
0
|
|
0
|
|
|
0
|
my $lists = $args{lists} || $self->{lists} || []; |
261
|
0
|
|
0
|
|
|
0
|
my $force = $args{force} || 0; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# Check if it is too early |
264
|
0
|
|
|
|
|
0
|
my $time = $self->{storage}->next_update(); |
265
|
0
|
0
|
0
|
|
|
0
|
if ($time > time() && $force == 0) { |
266
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->debug("Too early to update the local storage"); |
267
|
0
|
|
|
|
|
0
|
return NO_UPDATE; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
else { |
270
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->debug("time for update: $time / ", time()); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
0
|
|
|
|
|
0
|
my $all_lists = $self->make_lists(lists => $lists); |
274
|
0
|
|
|
|
|
0
|
my $info = { |
275
|
|
|
|
|
|
|
client => { |
276
|
|
|
|
|
|
|
clientId => 'Net::Google::SafeBrowsing4', |
277
|
|
|
|
|
|
|
clientVersion => $VERSION |
278
|
|
|
|
|
|
|
}, |
279
|
|
|
|
|
|
|
listUpdateRequests => [ $self->make_lists_for_update(lists => $all_lists) ] |
280
|
|
|
|
|
|
|
}; |
281
|
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
0
|
my $last_update = time(); |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
my $response = $self->{http_agent}->post( |
285
|
|
|
|
|
|
|
$self->{base} . "/threatListUpdates:fetch?key=" . $self->{key}, |
286
|
0
|
|
|
|
|
0
|
"Content-Type" => "application/json", |
287
|
|
|
|
|
|
|
Content => encode_json($info) |
288
|
|
|
|
|
|
|
); |
289
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->trace($response->request()->as_string()); |
291
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->trace($response->as_string()); |
292
|
|
|
|
|
|
|
|
293
|
0
|
0
|
|
|
|
0
|
if (! $response->is_success()) { |
294
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->error("Update request failed"); |
295
|
0
|
|
|
|
|
0
|
$self->update_error('time' => time()); |
296
|
0
|
|
|
|
|
0
|
return SERVER_ERROR; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
0
|
|
|
|
|
0
|
my $result = NO_DATA; |
300
|
0
|
|
|
|
|
0
|
my $json = decode_json($response->decoded_content(encoding => 'none')); |
301
|
0
|
|
|
|
|
0
|
my @data = @{ $json->{listUpdateResponses} }; |
|
0
|
|
|
|
|
0
|
|
302
|
0
|
|
|
|
|
0
|
foreach my $list (@data) { |
303
|
0
|
|
|
|
|
0
|
my $threat = $list->{threatType}; # MALWARE |
304
|
0
|
|
|
|
|
0
|
my $threatEntry = $list->{threatEntryType}; # URL |
305
|
0
|
|
|
|
|
0
|
my $platform = $list->{platformType}; # ANY_PLATFORM |
306
|
0
|
|
|
|
|
0
|
my $update = $list->{responseType}; # FULL_UPDATE |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# save and check the update |
309
|
0
|
|
|
|
|
0
|
my @hex = (); |
310
|
0
|
|
|
|
|
0
|
foreach my $addition (@{ $list->{additions} }) { |
|
0
|
|
|
|
|
0
|
|
311
|
0
|
|
|
|
|
0
|
my $hashes_b64 = $addition->{rawHashes}->{rawHashes}; # 4 bytes |
312
|
0
|
|
|
|
|
0
|
my $size = $addition->{rawHashes}->{prefixSize}; |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
0
|
my $hashes = decode_base64($hashes_b64); # hexadecimal |
315
|
0
|
|
|
|
|
0
|
push(@hex, unpack("(a$size)*", $hashes)); |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
0
|
|
|
|
|
0
|
my @remove = (); |
319
|
0
|
|
|
|
|
0
|
foreach my $removal (@{ $list->{removals} }) { |
|
0
|
|
|
|
|
0
|
|
320
|
0
|
|
|
|
|
0
|
push(@remove, @{ $removal->{rawIndices}->{indices} }); |
|
0
|
|
|
|
|
0
|
|
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
0
|
0
|
|
|
|
0
|
if (scalar(@hex) > 0) { |
324
|
0
|
0
|
|
|
|
0
|
$result = SUCCESSFUL if ($result >= 0); |
325
|
0
|
|
|
|
|
0
|
@hex = sort {$a cmp $b} @hex; # lexical sort |
|
0
|
|
|
|
|
0
|
|
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
my @hashes = $self->{storage}->save( |
328
|
|
|
|
|
|
|
list => { |
329
|
|
|
|
|
|
|
threatType => $threat, |
330
|
|
|
|
|
|
|
threatEntryType => $threatEntry, |
331
|
|
|
|
|
|
|
platformType => $platform |
332
|
|
|
|
|
|
|
}, |
333
|
|
|
|
|
|
|
override => ($list->{responseType} eq "FULL_UPDATE") ? 1 : 0, |
334
|
|
|
|
|
|
|
add => [@hex], |
335
|
|
|
|
|
|
|
remove => [@remove], |
336
|
|
|
|
|
|
|
'state' => $list->{newClientState}, |
337
|
0
|
0
|
|
|
|
0
|
); |
338
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
0
|
my $check = trim encode_base64 sha256(@hashes); |
340
|
0
|
0
|
|
|
|
0
|
if ($check ne $list->{checksum}->{sha256}) { |
341
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->error("$threat/$platform/$threatEntry update error: checksum does not match: ", $check, " / ", $list->{checksum}->{sha256}); |
342
|
|
|
|
|
|
|
$self->{storage}->reset( |
343
|
|
|
|
|
|
|
list => { |
344
|
|
|
|
|
|
|
threatType => $list->{threatType}, |
345
|
|
|
|
|
|
|
threatEntryType => $list->{threatEntryType}, |
346
|
|
|
|
|
|
|
platformType => $list->{platformType} |
347
|
|
|
|
|
|
|
} |
348
|
0
|
|
|
|
|
0
|
); |
349
|
|
|
|
|
|
|
|
350
|
0
|
|
|
|
|
0
|
$result = DATABASE_RESET; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
else { |
353
|
0
|
0
|
|
|
|
0
|
$self->{logger} && $self->{logger}->debug("$threat/$platform/$threatEntry update: checksum match"); |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# TODO: handle caching |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
|
361
|
0
|
|
|
|
|
0
|
my $wait = $json->{minimumWaitDuration}; |
362
|
0
|
|
|
|
|
0
|
my $next = time(); |
363
|
0
|
0
|
|
|
|
0
|
if ($wait =~ /(\d+)(\.\d+)?s/i) { |
364
|
0
|
|
|
|
|
0
|
$next += $1; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
|
|
|
0
|
$self->{storage}->updated('time' => $last_update, 'next' => $next); |
368
|
|
|
|
|
|
|
|
369
|
0
|
|
|
|
|
0
|
return $result; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=head2 get_lists() |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
Gets all threat list names from Google Safe Browsing and save them. |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
my $lists = $gsb->get_lists(); |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Returns an array reference of all the lists: |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
[ |
382
|
|
|
|
|
|
|
{ |
383
|
|
|
|
|
|
|
'threatEntryType' => 'URL', |
384
|
|
|
|
|
|
|
'threatType' => 'MALWARE', |
385
|
|
|
|
|
|
|
'platformType' => 'ANY_PLATFORM' |
386
|
|
|
|
|
|
|
}, |
387
|
|
|
|
|
|
|
{ |
388
|
|
|
|
|
|
|
'threatEntryType' => 'URL', |
389
|
|
|
|
|
|
|
'threatType' => 'MALWARE', |
390
|
|
|
|
|
|
|
'platformType' => 'WINDOWS' |
391
|
|
|
|
|
|
|
}, |
392
|
|
|
|
|
|
|
... |
393
|
|
|
|
|
|
|
] |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
or C on error. This method updates C<$gsb->{last_error}> field. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=cut |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub get_lists { |
400
|
6
|
|
|
6
|
1
|
921
|
my ($self) = @_; |
401
|
|
|
|
|
|
|
|
402
|
6
|
|
|
|
|
10
|
$self->{last_error} = ''; |
403
|
|
|
|
|
|
|
my $response = $self->{http_agent}->get( |
404
|
|
|
|
|
|
|
$self->{base} . "/threatLists?key=" . $self->{key}, |
405
|
6
|
|
|
|
|
28
|
"Content-Type" => "application/json" |
406
|
|
|
|
|
|
|
); |
407
|
6
|
50
|
|
|
|
14775
|
$self->{logger} && $self->{logger}->trace('Request:' . $response->request->as_string()); |
408
|
6
|
50
|
|
|
|
11
|
$self->{logger} && $self->{logger}->trace('Response:' . $response->as_string()); |
409
|
|
|
|
|
|
|
|
410
|
6
|
100
|
|
|
|
14
|
if (!$response->is_success()) { |
411
|
1
|
|
|
|
|
12
|
$self->{last_error} = "get_lists: " . $response->status_line(); |
412
|
1
|
|
|
|
|
17
|
return undef; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
5
|
|
|
|
|
31
|
my $info; |
416
|
5
|
|
|
|
|
9
|
eval { |
417
|
5
|
|
|
|
|
16
|
$info = decode_json($response->decoded_content(encoding => 'none')); |
418
|
|
|
|
|
|
|
}; |
419
|
5
|
100
|
100
|
|
|
570
|
if ($@ || ref($info) ne 'HASH') { |
420
|
3
|
|
100
|
|
|
11
|
$self->{last_error} = "get_lists: Invalid Response: " . ($@ || "Data is an array and not an object"); |
421
|
3
|
|
|
|
|
9
|
return undef; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
2
|
100
|
|
|
|
6
|
if (!exists($info->{threatLists})) { |
425
|
1
|
|
|
|
|
3
|
$self->{last_error} = "get_lists: Invalid Response: Data missing the right key"; |
426
|
1
|
|
|
|
|
4
|
return undef; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
1
|
|
|
|
|
9
|
$self->{storage}->save_lists($info->{threatLists}); |
430
|
|
|
|
|
|
|
|
431
|
1
|
|
|
|
|
234
|
return $info->{threatLists}; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=head2 lookup() |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Looks up URL(s) against the Google Safe Browsing database. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Returns the list of hashes along with the list and any metadata that matches the URL(s): |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
( |
443
|
|
|
|
|
|
|
{ |
444
|
|
|
|
|
|
|
'lookup_url' => '...', |
445
|
|
|
|
|
|
|
'hash' => '...', |
446
|
|
|
|
|
|
|
'metadata' => { |
447
|
|
|
|
|
|
|
'malware_threat_type' => 'DISTRIBUTION' |
448
|
|
|
|
|
|
|
}, |
449
|
|
|
|
|
|
|
'list' => { |
450
|
|
|
|
|
|
|
'threatEntryType' => 'URL', |
451
|
|
|
|
|
|
|
'threatType' => 'MALWARE', |
452
|
|
|
|
|
|
|
'platformType' => 'ANY_PLATFORM' |
453
|
|
|
|
|
|
|
}, |
454
|
|
|
|
|
|
|
'cache' => '300s' |
455
|
|
|
|
|
|
|
}, |
456
|
|
|
|
|
|
|
... |
457
|
|
|
|
|
|
|
) |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
Arguments |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=over 4 |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=item lists |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
Optional. Lookup against specific lists. Use the list(s) from new() by default. |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
=item url |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
Required. URL to lookup. |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=back |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=cut |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub lookup { |
477
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
478
|
0
|
|
0
|
|
|
|
my $list_expressions = $args{lists} || $self->{lists} || []; |
479
|
|
|
|
|
|
|
# List expressions may contain wildcards which need to be expanded |
480
|
0
|
|
|
|
|
|
my $list_names = $self->make_lists(lists => $list_expressions); |
481
|
|
|
|
|
|
|
|
482
|
0
|
0
|
|
|
|
|
if (!$args{url}) { |
483
|
0
|
|
|
|
|
|
return (); |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
0
|
0
|
|
|
|
|
if (ref($args{url}) eq '') { |
|
|
0
|
|
|
|
|
|
487
|
0
|
|
|
|
|
|
$args{url} = [ $args{url} ]; |
488
|
|
|
|
|
|
|
} elsif (ref($args{url}) ne 'ARRAY') { |
489
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->error('Lookup() method accepts a single URI or list of URIs'); |
490
|
0
|
|
|
|
|
|
return (); |
491
|
|
|
|
|
|
|
} |
492
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->debug(sprintf("Requested to look up %d URIs", scalar(@{$args{url}}))); |
|
0
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Parse URI(s) and calculate hashes |
496
|
0
|
|
|
|
|
|
my $start; |
497
|
0
|
0
|
|
|
|
|
$self->{perf} && ($start = time()); |
498
|
0
|
|
|
|
|
|
my $urls = {}; |
499
|
0
|
|
|
|
|
|
foreach my $url (@{$args{url}}) { |
|
0
|
|
|
|
|
|
|
500
|
0
|
|
|
|
|
|
my $gsb_uri = Net::Google::SafeBrowsing4::URI->new($url); |
501
|
0
|
0
|
|
|
|
|
if (!$gsb_uri) { |
502
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->error('Failed to parse URI: ' . $url); |
503
|
0
|
|
|
|
|
|
next; |
504
|
|
|
|
|
|
|
} |
505
|
0
|
|
|
|
|
|
my $main_uri_hash = $gsb_uri->hash(); |
506
|
|
|
|
|
|
|
|
507
|
0
|
|
|
|
|
|
foreach my $sub_url ($gsb_uri->generate_lookupuris()) { |
508
|
0
|
|
|
|
|
|
my $uri_hash = $sub_url->hash(); |
509
|
0
|
|
|
|
|
|
$urls->{$uri_hash} = $sub_url; |
510
|
0
|
|
|
|
|
|
$urls->{$uri_hash}{hash} = $uri_hash; |
511
|
0
|
|
|
|
|
|
$urls->{$uri_hash}{parent} = $main_uri_hash; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
} |
514
|
0
|
0
|
0
|
|
|
|
$self->{perf} && $self->{logger} && $self->{logger}->debug("Full hashes from URL(s): ", time() - $start, "s "); |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# Lookup hash prefixes in the local database |
517
|
0
|
0
|
|
|
|
|
$self->{perf} && ($start = time()); |
518
|
0
|
|
|
|
|
|
my $lookup_hashes = { map { $_ => '' } keys(%$urls) }; |
|
0
|
|
|
|
|
|
|
519
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->debug(sprintf("Looking up prefixes for %d hashes in local db", scalar(keys(%$lookup_hashes)))); |
520
|
0
|
|
|
|
|
|
my @matched_prefixes = $self->{storage}->get_prefixes(hashes => [keys(%$lookup_hashes)], lists => $list_names); |
521
|
0
|
0
|
|
|
|
|
if (scalar(@matched_prefixes) == 0) { |
522
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->debug("No hit on local hash prefix lookup"); |
523
|
0
|
|
|
|
|
|
return (); |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
$self->{logger} && $self->{logger}->debug(sprintf( |
526
|
|
|
|
|
|
|
"%d hits by %d prefixes in local database", |
527
|
|
|
|
|
|
|
scalar(@matched_prefixes), |
528
|
0
|
0
|
|
|
|
|
scalar(keys(%{ { map { $_->{prefix} => 1 } @matched_prefixes } }) ) |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
)); |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# Mark hashes that were found in prefix db, drop others |
532
|
0
|
|
|
|
|
|
map { $lookup_hashes->{$_->{hash}} = $_->{prefix} } @matched_prefixes; |
|
0
|
|
|
|
|
|
|
533
|
0
|
0
|
|
|
|
|
map { delete($lookup_hashes->{$_}) if ($lookup_hashes->{$_} eq '') } keys(%$lookup_hashes); |
|
0
|
|
|
|
|
|
|
534
|
0
|
0
|
0
|
|
|
|
$self->{perf} && $self->{logger} && $self->{logger}->debug("Find hash prefixes in local db: ", time() - $start, "s "); |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# Lookup full hashes in the local database |
538
|
0
|
0
|
|
|
|
|
$self->{perf} && ($start = time()); |
539
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->debug(sprintf("Looking up %d full hashes in local db", scalar(keys(%$lookup_hashes)))); |
540
|
0
|
|
|
|
|
|
my @results = (); |
541
|
0
|
|
|
|
|
|
foreach my $lookup_hash (keys(%$lookup_hashes)) { |
542
|
|
|
|
|
|
|
# @TODO get_full_hashes should be able to look up multiple hashes at once (it could be faster) |
543
|
0
|
|
|
|
|
|
my @hash_matches = $self->{storage}->get_full_hashes(hash => $lookup_hash, lists => $list_names); |
544
|
0
|
0
|
|
|
|
|
if (scalar(@hash_matches) > 0) { |
545
|
0
|
|
|
|
|
|
push(@results, @hash_matches); |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# Delete all URI hashes that are based of a URI that was found on GSB |
548
|
0
|
|
|
|
|
|
my %found_hashes = map { $_->{hash} => 1 } @hash_matches; |
|
0
|
|
|
|
|
|
|
549
|
0
|
|
|
|
|
|
foreach my $found_hash (keys(%found_hashes)) { |
550
|
|
|
|
|
|
|
map { |
551
|
0
|
|
|
|
|
|
delete($lookup_hashes->{$_}) if ($urls->{$_}{parent} eq $urls->{$found_hash}{parent}) |
552
|
0
|
0
|
|
|
|
|
} keys(%$lookup_hashes); |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
} |
556
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->debug(sprintf("%d unknown full hashes remained after local lookup", scalar(keys(%$lookup_hashes)))); |
557
|
0
|
0
|
0
|
|
|
|
$self->{perf} && $self->{logger} && $self->{logger}->debug("Stored hashes lookup: ", time() - $start, "s "); |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# Download full hashes for the remaining prefixes if needed |
561
|
0
|
0
|
|
|
|
|
$self->{perf} && ($start = time()); |
562
|
0
|
|
|
|
|
|
my %needed_prefixes = map { $_ => 1 } values(%$lookup_hashes); |
|
0
|
|
|
|
|
|
|
563
|
0
|
0
|
|
|
|
|
if (scalar(keys(%needed_prefixes)) > 0) { |
564
|
0
|
|
|
|
|
|
my @lookup_prefixes = grep { exists($needed_prefixes{$_->{prefix}}) } @matched_prefixes; |
|
0
|
|
|
|
|
|
|
565
|
0
|
|
|
|
|
|
my @retrieved_hashes = $self->request_full_hash(prefixes => [@lookup_prefixes]); |
566
|
0
|
0
|
0
|
|
|
|
$self->{perf} && $self->{logger} && $self->{logger}->debug("Full hash request: ", time() - $start, "s "); |
567
|
|
|
|
|
|
|
|
568
|
0
|
|
|
|
|
|
$start = time(); |
569
|
0
|
|
|
|
|
|
my @matches = grep { exists($lookup_hashes->{$_->{hash}}) } @retrieved_hashes; |
|
0
|
|
|
|
|
|
|
570
|
0
|
0
|
|
|
|
|
push(@results, @matches) if (scalar(@matches) > 0); |
571
|
0
|
0
|
0
|
|
|
|
$self->{perf} && $self->{logger} && $self->{logger}->debug("Full hash check: ", time() - $start, "s "); |
572
|
|
|
|
|
|
|
|
573
|
0
|
|
|
|
|
|
$start = time(); |
574
|
0
|
|
|
|
|
|
$self->{storage}->add_full_hashes(hashes => [@retrieved_hashes], timestamp => time()); |
575
|
0
|
0
|
0
|
|
|
|
$self->{perf} && $self->{logger} && $self->{logger}->debug("Save full hashes: ", time() - $start, "s "); |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# Map urls to hashes in the resultset |
580
|
0
|
|
|
|
|
|
foreach my $entry (@results) { |
581
|
0
|
|
|
|
|
|
$entry->{lookup_url} = $urls->{$entry->{hash}}->as_string(); |
582
|
0
|
|
|
|
|
|
$entry->{original_url} = $urls->{$urls->{$entry->{hash}}->{parent}}->as_string(); |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
0
|
|
|
|
|
|
return @results; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=pod |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=head1 PRIVATE FUNCTIONS |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
These functions are not intended to be used externally. |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=head2 make_lists() |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
Transforms a list from a string expression (eg.: "MALWARE/*/*") into a list object. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=cut |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub make_lists { |
602
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
603
|
0
|
0
|
0
|
|
|
|
my @lists = @{ $args{lists} || $self->{lists} || [] }; |
|
0
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
|
605
|
0
|
0
|
|
|
|
|
if (scalar(@lists) == 0) { |
606
|
0
|
0
|
|
|
|
|
if (scalar(@{ $self->{all_lists} }) == 0) { |
|
0
|
|
|
|
|
|
|
607
|
0
|
|
|
|
|
|
my $lists = $self->{storage}->get_lists(); |
608
|
0
|
0
|
|
|
|
|
if (scalar(@$lists) == 0) { |
609
|
0
|
|
|
|
|
|
$lists = $self->get_lists(); |
610
|
|
|
|
|
|
|
} |
611
|
0
|
|
|
|
|
|
$self->{all_lists} = $lists; |
612
|
|
|
|
|
|
|
} |
613
|
0
|
|
|
|
|
|
return $self->{all_lists}; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
|
616
|
0
|
|
|
|
|
|
my @all = (); |
617
|
0
|
|
|
|
|
|
foreach my $list (@lists) { |
618
|
0
|
|
|
|
|
|
$list = uc(trim($list)); |
619
|
0
|
0
|
|
|
|
|
if ($list !~ /^[*_A-Z]+\/[*_A-Z]+\/[*_A-Z]+$/) { |
620
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->error("List expression is in invalid format: $list - It must be in the form of MALWARE/WINDOWS/URL or MALWARE/*/*"); |
621
|
0
|
|
|
|
|
|
next; |
622
|
|
|
|
|
|
|
} |
623
|
0
|
0
|
|
|
|
|
if ($list =~ /\*/) { |
|
|
0
|
|
|
|
|
|
624
|
0
|
|
|
|
|
|
my ($threat, $platform, $threatEntry) = split(/\//, $list); |
625
|
|
|
|
|
|
|
|
626
|
0
|
0
|
|
|
|
|
if (scalar(@{ $self->{all_lists} }) == 0) { |
|
0
|
|
|
|
|
|
|
627
|
0
|
|
|
|
|
|
$self->{all_lists} = $self->get_lists(); |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
0
|
|
|
|
|
|
foreach my $original (@{ $self->{all_lists} }) { |
|
0
|
|
|
|
|
|
|
631
|
0
|
0
|
0
|
|
|
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
632
|
|
|
|
|
|
|
($threat eq "*" || $original->{threatType} eq $threat) && |
633
|
|
|
|
|
|
|
($platform eq "*" || $original->{platformType} eq $platform) && |
634
|
|
|
|
|
|
|
($threatEntry eq "*" || $original->{threatEntryType} eq $threatEntry)) |
635
|
|
|
|
|
|
|
{ |
636
|
0
|
|
|
|
|
|
push(@all, $original); |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
elsif ($list =~ /^([_A-Z]+)\/([_A-Z]+)\/([_A-Z]+)$/) { |
641
|
0
|
|
|
|
|
|
my ($threat, $platform, $threatEntry) = split(/\//, $list); |
642
|
|
|
|
|
|
|
|
643
|
0
|
|
|
|
|
|
push(@all, { |
644
|
|
|
|
|
|
|
threatType => $threat, |
645
|
|
|
|
|
|
|
platformType => $platform, |
646
|
|
|
|
|
|
|
threatEntryType => $threatEntry, |
647
|
|
|
|
|
|
|
}); |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
|
651
|
0
|
|
|
|
|
|
return [@all]; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=head2 update_error() |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
Handle server errors during a database update. |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=cut |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub update_error { |
662
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
663
|
0
|
|
0
|
|
|
|
my $time = $args{'time'} || time(); |
664
|
|
|
|
|
|
|
|
665
|
0
|
|
|
|
|
|
my $info = $self->{storage}->last_update(); |
666
|
0
|
0
|
|
|
|
|
$info->{errors} = 0 if (!exists($info->{errors})); |
667
|
0
|
|
|
|
|
|
my $errors = $info->{errors} + 1; |
668
|
0
|
|
|
|
|
|
my $wait = 0; |
669
|
|
|
|
|
|
|
|
670
|
0
|
0
|
|
|
|
|
$wait = $errors == 1 ? 60 |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
671
|
|
|
|
|
|
|
: $errors == 2 ? int(30 * 60 * (rand(1) + 1)) # 30-60 mins |
672
|
|
|
|
|
|
|
: $errors == 3 ? int(60 * 60 * (rand(1) + 1)) # 60-120 mins |
673
|
|
|
|
|
|
|
: $errors == 4 ? int(2 * 60 * 60 * (rand(1) + 1)) # 120-240 mins |
674
|
|
|
|
|
|
|
: $errors == 5 ? int(4 * 60 * 60 * (rand(1) + 1)) # 240-480 mins |
675
|
|
|
|
|
|
|
: $errors > 5 ? 480 * 60 |
676
|
|
|
|
|
|
|
: 0; |
677
|
|
|
|
|
|
|
|
678
|
0
|
|
|
|
|
|
$self->{storage}->update_error('time' => $time, 'wait' => $wait, errors => $errors); |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=head2 make_lists_for_update() |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
Formats the list objects for update requests. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub make_lists_for_update { |
689
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
690
|
0
|
|
|
|
|
|
my @lists = @{ $args{lists} }; |
|
0
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
|
692
|
0
|
|
|
|
|
|
for(my $i = 0; $i < scalar(@lists); $i++) { |
693
|
0
|
|
|
|
|
|
$lists[$i]->{'state'} = $self->{storage}->get_state(list => $lists[$i]); |
694
|
|
|
|
|
|
|
$lists[$i]->{constraints} = { |
695
|
0
|
|
|
|
|
|
supportedCompressions => ["RAW"] |
696
|
|
|
|
|
|
|
}; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
0
|
|
|
|
|
|
return @lists; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=head2 request_full_hash() |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Requests full full hashes for specific prefixes from Google. |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=cut |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
sub request_full_hash { |
709
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
710
|
0
|
0
|
|
|
|
|
my @prefixes = @{ $args{prefixes} || [] }; |
|
0
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
|
712
|
0
|
|
|
|
|
|
my $info = { |
713
|
|
|
|
|
|
|
client => { |
714
|
|
|
|
|
|
|
clientId => 'Net::Google::SafeBrowsing4', |
715
|
|
|
|
|
|
|
clientVersion => $VERSION |
716
|
|
|
|
|
|
|
}, |
717
|
|
|
|
|
|
|
}; |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
|
720
|
0
|
|
|
|
|
|
my @full_hashes = (); |
721
|
0
|
|
|
|
|
|
while (scalar @prefixes > 0) { |
722
|
0
|
|
|
|
|
|
my @send = splice(@prefixes, 0, $self->{max_hash_request}); |
723
|
|
|
|
|
|
|
|
724
|
0
|
|
|
|
|
|
my @lists = (); |
725
|
0
|
|
|
|
|
|
my %hashes = (); |
726
|
0
|
|
|
|
|
|
my %threats = (); |
727
|
0
|
|
|
|
|
|
my %platforms = (); |
728
|
0
|
|
|
|
|
|
my %threatEntries = (); |
729
|
0
|
|
|
|
|
|
foreach my $info (@send) { |
730
|
0
|
0
|
|
|
|
|
if ( |
731
|
|
|
|
|
|
|
!defined(first { |
732
|
|
|
|
|
|
|
$_->{threatType} eq $info->{list}->{threatType} && |
733
|
|
|
|
|
|
|
$_->{platformType} eq $info->{list}->{platformType} && |
734
|
|
|
|
|
|
|
$_->{threatEntryType} eq $info->{list}->{threatEntryType} |
735
|
0
|
0
|
0
|
0
|
|
|
} @lists) |
736
|
|
|
|
|
|
|
) { |
737
|
0
|
|
|
|
|
|
push(@lists, $info->{list}); |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
0
|
|
|
|
|
|
$hashes{ trim(encode_base64($info->{prefix})) } = 1; |
741
|
0
|
|
|
|
|
|
$threats{ $info->{list}->{threatType} } = 1; |
742
|
0
|
|
|
|
|
|
$platforms{ $info->{list}->{platformType} } = 1; |
743
|
0
|
|
|
|
|
|
$threatEntries{ $info->{list}->{threatEntryType} } = 1; |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# Get state for each list |
747
|
0
|
|
|
|
|
|
$info->{clientStates} = []; |
748
|
0
|
|
|
|
|
|
foreach my $list (@lists) { |
749
|
0
|
|
|
|
|
|
push(@{ $info->{clientStates} }, $self->{storage}->get_state(list => $list)); |
|
0
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
$info->{threatInfo} = { |
753
|
|
|
|
|
|
|
threatTypes => [ keys(%threats) ], |
754
|
|
|
|
|
|
|
platformTypes => [ keys(%platforms) ], |
755
|
|
|
|
|
|
|
threatEntryTypes => [ keys(%threatEntries) ], |
756
|
0
|
|
|
|
|
|
threatEntries => [ map { { hash => $_ } } keys(%hashes) ], |
|
0
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
}; |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
my $response = $self->{http_agent}->post( |
760
|
|
|
|
|
|
|
$self->{base} . "/fullHashes:find?key=" . $self->{key}, |
761
|
0
|
|
|
|
|
|
"Content-Type" => "application/json", |
762
|
|
|
|
|
|
|
Content => encode_json($info) |
763
|
|
|
|
|
|
|
); |
764
|
|
|
|
|
|
|
|
765
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->trace($response->request()->as_string()); |
766
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->trace($response->as_string()); |
767
|
|
|
|
|
|
|
|
768
|
0
|
0
|
|
|
|
|
if (! $response->is_success()) { |
769
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->error("Full hash request failed"); |
770
|
0
|
|
|
|
|
|
$self->{last_error} = "Full hash request failed"; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# TODO |
773
|
|
|
|
|
|
|
# foreach my $info (keys keys %hashes) { |
774
|
|
|
|
|
|
|
# my $prefix = $info->{prefix}; |
775
|
|
|
|
|
|
|
# |
776
|
|
|
|
|
|
|
# my $errors = $self->{storage}->get_full_hash_error(prefix => $prefix); |
777
|
|
|
|
|
|
|
# if (defined $errors && ( |
778
|
|
|
|
|
|
|
# $errors->{errors} >=2 # backoff mode |
779
|
|
|
|
|
|
|
# || $errors->{errors} == 1 && (time() - $errors->{timestamp}) > 5 * 60)) { # 5 minutes |
780
|
|
|
|
|
|
|
# $self->{storage}->full_hash_error(prefix => $prefix, timestamp => time()); # more complicate than this, need to check time between 2 errors |
781
|
|
|
|
|
|
|
# } |
782
|
|
|
|
|
|
|
# } |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
else { |
785
|
0
|
0
|
|
|
|
|
$self->{logger} && $self->{logger}->debug("Full hash request OK"); |
786
|
|
|
|
|
|
|
|
787
|
0
|
|
|
|
|
|
push(@full_hashes, $self->parse_full_hashes($response->decoded_content(encoding => 'none'))); |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
# TODO |
790
|
|
|
|
|
|
|
# foreach my $prefix (@$prefixes) { |
791
|
|
|
|
|
|
|
# my $prefix = $info->{prefix}; |
792
|
|
|
|
|
|
|
# |
793
|
|
|
|
|
|
|
# $self->{storage}->full_hash_ok(prefix => $prefix, timestamp => time()); |
794
|
|
|
|
|
|
|
# } |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
|
798
|
0
|
|
|
|
|
|
return @full_hashes; |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=head2 parse_full_hashes() |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Processes the request for full hashes from Google. |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=cut |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub parse_full_hashes { |
808
|
0
|
|
|
0
|
1
|
|
my ($self, $data) = @_; |
809
|
|
|
|
|
|
|
|
810
|
0
|
0
|
|
|
|
|
if ($data eq '') { |
811
|
0
|
|
|
|
|
|
return (); |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
|
814
|
0
|
|
|
|
|
|
my $info = decode_json($data); |
815
|
0
|
0
|
0
|
|
|
|
if (!exists($info->{matches}) || scalar(@{ $info->{matches} }) == 0) { |
|
0
|
|
|
|
|
|
|
816
|
0
|
|
|
|
|
|
return (); |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
|
819
|
0
|
|
|
|
|
|
my @hashes = (); |
820
|
0
|
|
|
|
|
|
foreach my $match (@{ $info->{matches} }) { |
|
0
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
my $list = { |
822
|
|
|
|
|
|
|
threatType => $match->{threatType}, |
823
|
|
|
|
|
|
|
platformType => $match->{platformType}, |
824
|
|
|
|
|
|
|
threatEntryType => $match->{threatEntryType}, |
825
|
0
|
|
|
|
|
|
}; |
826
|
|
|
|
|
|
|
|
827
|
0
|
|
|
|
|
|
my $hash = decode_base64($match->{threat}->{hash}); |
828
|
0
|
|
|
|
|
|
my $cache = $match->{cacheDuration}; |
829
|
|
|
|
|
|
|
|
830
|
0
|
|
|
|
|
|
my %metadata = (); |
831
|
0
|
|
|
|
|
|
foreach my $extra (@{ $match->{threatEntryMetadata}->{entries} }) { |
|
0
|
|
|
|
|
|
|
832
|
0
|
|
|
|
|
|
$metadata{ decode_base64($extra->{key}) } = decode_base64($extra->{value}); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
0
|
|
|
|
|
|
push(@hashes, { hash => $hash, cache => $cache, list => $list, metadata => { %metadata } }); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
# TODO: |
839
|
0
|
|
0
|
|
|
|
my $wait = $info->{minimumWaitDuration} || 0; # "300.000s", |
840
|
0
|
|
|
|
|
|
$wait =~ s/[a-z]//i; |
841
|
|
|
|
|
|
|
|
842
|
0
|
|
0
|
|
|
|
my $negativeWait = $info->{negativeCacheDuration} || 0; # "300.000s" |
843
|
0
|
|
|
|
|
|
$negativeWait =~ s/[a-z]//i; |
844
|
|
|
|
|
|
|
|
845
|
0
|
|
|
|
|
|
return @hashes; |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=head1 PROXIES AND LOCAL ADDRESSES |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
To use a proxy or select the network interface to use, simply create and set up an L object and pass it to the constructor: |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
use LWP::UserAgent; |
853
|
|
|
|
|
|
|
use Net::Google::SafeBrowsing4; |
854
|
|
|
|
|
|
|
use Net::Google::SafeBrowsing4::Storage::File; |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new(); |
857
|
|
|
|
|
|
|
$ua->env_proxy(); |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
# $ua->local_address("192.168.0.14"); |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
my $gsb = Net::Google::SafeBrowsing4->new( |
862
|
|
|
|
|
|
|
key => "my-api-key", |
863
|
|
|
|
|
|
|
storage => Net::Google::SafeBrowsing4::Storage::File->new(path => "."), |
864
|
|
|
|
|
|
|
http_agent => $ua, |
865
|
|
|
|
|
|
|
); |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
Note that the L object will override certain LWP properties: |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=over |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=item timeout |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
The network timeout will be set according to the C constructor parameter. |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=item Content-Type |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
The Content-Type default header will be set to I for HTTPS Requests. |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=item Accept-Encoding |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
The Accept-Encoding default header will be set according to the C constructor parameter. |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=back |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head1 SEE ALSO |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
See L about URI parsing for Google Safe Browsing v4. |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
See L for the list of public functions. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
See L for a back-end storage using files. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Google Safe Browsing v4 API: L |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=head1 AUTHOR |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
Julien Sobrier, Ejulien@sobrier.netE |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
Copyright (C) 2017 by Julien Sobrier |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
905
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.8 or, |
906
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=cut |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
1; |
912
|
|
|
|
|
|
|
__END__ |