File Coverage

blib/lib/Net/Google/SafeBrowsing4.pm
Criterion Covered Total %
statement 79 315 25.0
branch 18 162 11.1
condition 5 63 7.9
subroutine 16 24 66.6
pod 9 9 100.0
total 127 573 22.1


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