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   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__