File Coverage

blib/lib/Net/Google/SafeBrowsing4/Storage/File.pm
Criterion Covered Total %
statement 44 246 17.8
branch 8 134 5.9
condition 0 75 0.0
subroutine 12 26 46.1
pod 14 16 87.5
total 78 497 15.6


line stmt bran cond sub pod time code
1             package Net::Google::SafeBrowsing4::Storage::File;
2              
3 4     4   200985 use strict;
  4         28  
  4         96  
4 4     4   16 use warnings;
  4         10  
  4         107  
5              
6 4     4   18 use base qw(Net::Google::SafeBrowsing4::Storage);
  4         6  
  4         1679  
7              
8 4     4   20 use Carp;
  4         7  
  4         260  
9 4     4   20 use List::Util qw(first);
  4         5  
  4         313  
10 4     4   2539 use Path::Tiny;
  4         41611  
  4         187  
11 4     4   1094 use Storable qw(nstore retrieve);
  4         5091  
  4         207  
12 4     4   1598 use List::BinarySearch qw(binsearch);
  4         6086  
  4         9744  
13              
14              
15             our $VERSION = '0.3';
16              
17             =head1 NAME
18              
19             Net::Google::SafeBrowsing4::Storage::File - File storage for the Google Safe Browsing v4 database
20              
21             =head1 SYNOPSIS
22              
23             use Net::Google::SafeBrowsing4::Storage::File;
24              
25             my $storage = Net::Google::SafeBrowsing4::Storage::File->new(path => '.');
26             $storage->save(...);
27              
28             =head1 DESCRIPTION
29              
30             This is the a file-based implementation of L to manage the Google Safe Browsing v4 local database.
31              
32             =cut
33              
34              
35             =head1 CONSTRUCTOR
36              
37             =over 4
38              
39             =back
40              
41             =head2 new()
42              
43             Create a Net::Google::SafeBrowsing4::Storage::File object
44              
45             my $storage => Net::Google::SafeBrowsing4::Storage::File->new(path => '.');
46              
47             Arguments
48              
49             =over 4
50              
51             =item path
52              
53             Optional. Path to store the database files Use current directory by default.
54              
55             =item keep_all
56              
57             Optional. Set to 1 to keep old information (such as expiring full hashes) in the database. 0 (delete) by default.
58              
59             =item sticky
60              
61             Optional. Set to 1 to if you are going to do multiple lookup. More memory will be used but lookup will be sped up. 0 by default.
62              
63             =item files
64              
65             Optional. Hash reference to map file types to file names. Default:
66              
67             {
68             updates => "updates.gdb4",
69             full_hashes => "full_hashes.gsb4"
70             }
71              
72             =item logger
73              
74             Optional. Log4Perl compatible object reference. By default this option is unset, making Net::Google::SafeBrowsing4::Storage::File silent.
75              
76             =back
77              
78             =cut
79              
80             sub new {
81 12     12 1 11782 my ($class, %args) = @_;
82              
83 12         103 my $self = { # default arguments
84             keep_all => 0,
85             path => '.',
86             sticky => 0,
87             files => {
88             updates => "updates.gdb4",
89             full_hashes => "full_hashes.gsb4",
90             lists => "lists.gsb4"
91             },
92             data => { },
93             %args,
94             };
95              
96 12 50       56 bless($self, $class) or croak("Can't bless $class: $!");
97              
98 12         53 $self->init();
99              
100 12         406 return $self;
101             }
102              
103             =head1 PUBLIC FUNCTIONS
104              
105             =over 4
106              
107             See L for a complete list of public functions.
108              
109             =back
110              
111             =head2 close()
112              
113             Cleanup old full hashes, and close the connection to the database.
114              
115             $storage->close();
116              
117             =cut
118              
119              
120             sub init {
121 12     12 0 22 my ($self, %args) = @_;
122              
123             # make sure path exists
124 12 50       182 if (! -d $self->{path}) {
125 0 0       0 mkdir($self->{path}) or croak("Cannot create directory " . $self->{path} . ": $!\n");
126             }
127              
128             # file to hold all updates
129 12         78 my $file = path(join("/", $self->{path}, $self->{files}->{updates}));
130 12 100       485 if (! -e $file) {
131 1         27 my %update = (last_update => 0, next_update => 0, errors => 0);
132 1 50       4 if ($self->{sticky}) {
133 0         0 $self->{data}->{ $self->{files}->{updates} } = { %update };
134             }
135              
136 1 50       5 nstore(\%update, $file) or croak("Cannot store information into $file: $!\n");
137             }
138             }
139              
140             sub save {
141 0     0 1 0 my ($self, %args) = @_;
142 0   0     0 my $list = $args{list} || croak("Missing list information");
143 0   0     0 my $override = $args{override} || 0;
144 0 0       0 my @hashes = @{ $args{add} || [] };
  0         0  
145 0 0       0 my @remove = @{ $args{remove} || [] };
  0         0  
146 0   0     0 my $state = $args{'state'} || '';
147              
148             # save the information somewhere
149 0         0 my $file = path(join("/", $self->{path}, $self->list_to_file($list)));
150 0 0       0 $self->{logger} && $self->{logger}->debug("Save hashes to $file");
151              
152 0         0 my %data = ('state' => $state, hashes => [@hashes]); # hashes are already stored
153 0 0 0     0 if (-e $file && !$override) {
154 0         0 my $db = retrieve($file);
155 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (save)");
156              
157 0 0       0 $self->{logger} && $self->{logger}->debug("hashes to remove: ", scalar(@remove));
158 0 0       0 $self->{logger} && $self->{logger}->debug("hashes to add: ", scalar(@hashes));
159              
160 0 0       0 $self->{logger} && $self->{logger}->debug("Number of hashes before removal: ", scalar(@{ $db->{hashes} }));
  0         0  
161 0         0 foreach my $index (@remove) {
162 0 0       0 $self->{logger} && $self->{logger}->debug("Remove index $index");
163 0         0 $db->{hashes}->[$index] = '';
164             }
165 0         0 $db->{hashes} = [ grep { $_ ne '' } @{ $db->{hashes} } ];
  0         0  
  0         0  
166 0 0       0 $self->{logger} && $self->{logger}->debug("Number of hashes after removal: ", scalar(@{ $db->{hashes} }));
  0         0  
167              
168 0         0 $data{hashes} = [sort { $a cmp $b } (@hashes, @{ $db->{hashes} })];
  0         0  
  0         0  
169             }
170              
171 0 0       0 nstore(\%data, $file) or croak("Cannot save data to $file: $!\n");
172 0 0       0 if ($self->{sticky}) {
173 0         0 $self->{data}->{ $self->list_to_file($list) } = { %data };
174             }
175              
176             # return the list of hashes, sorted, from the new storage
177 0 0       0 $self->{logger} && $self->{logger}->debug("Number of hashes at end: ", scalar(@{ $data{hashes} }));
  0         0  
178 0         0 return @{ $data{hashes} };
  0         0  
179             }
180              
181              
182              
183             sub reset {
184 0     0 1 0 my ($self, %args) = @_;
185 0   0     0 my $list = $args{list} || croak("Missing list information");
186              
187 0         0 my $file = path(join("/", $self->{path}, $self->list_to_file($list)));
188 0         0 unlink($file);
189              
190 0 0       0 if ($self->{sticky}) {
191 0         0 $self->{data}->{ $self->list_to_file($list) } = { };
192             }
193             }
194              
195              
196             sub next_update {
197 0     0 1 0 my ($self, %args) = @_;
198              
199             # make sure the file exists
200 0         0 $self->init();
201              
202 0         0 my $update = { };
203 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->{files}->{updates} })) {
204 0         0 $update = $self->{data}->{ $self->{files}->{updates} };
205             }
206             else {
207             # retrieve information from storage
208 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{updates}));
209 0         0 $update = retrieve($file);
210 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (reset)");
211              
212 0 0       0 if ($self->{sticky}) {
213 0         0 $self->{data}->{ $self->{files}->{updates} } = $update;;
214             }
215             }
216              
217 0   0     0 return $update->{next_update} || 0;
218             }
219              
220             sub last_update {
221 0     0 1 0 my ($self, %args) = @_;
222              
223             # make sure the file exists
224 0         0 $self->init();
225              
226 0         0 my $update = { };
227 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->{files}->{updates} })) {
228 0         0 $update = $self->{data}->{ $self->{files}->{updates} };
229             }
230             else {
231             # retrieve information from storage
232 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{updates}));
233 0         0 $update = retrieve($file);
234 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (last_udpate)");
235              
236 0 0       0 if ($self->{sticky}) {
237 0         0 $self->{data}->{ $self->{files}->{updates} } = $update;
238             }
239             }
240              
241 0   0     0 return { last_update => $update->{last_update} || 0, errors => $update->{errors} || 0 };
      0        
242             }
243              
244              
245             sub get_state {
246 0     0 1 0 my ($self, %args) = @_;
247 0   0     0 my $list = $args{list} || croak("Missing list information\n");
248              
249 0         0 my $update = { };
250 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->list_to_file($list) })) {
251 0         0 $update = $self->{data}->{ $self->list_to_file($list) };
252             }
253             else {
254 0         0 my $file = path(join("/", $self->{path}, $self->list_to_file($list)));
255 0 0       0 if (! -e $file) {
256 0         0 return "";
257             }
258             else {
259 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (get_state)");
260 0         0 $update = retrieve($file);
261              
262 0 0       0 if ($self->{sticky}) {
263 0         0 $self->{data}->{ $self->list_to_file($list) } = $update;
264             }
265             }
266             }
267              
268 0   0     0 return $update->{'state'} || '';
269             }
270              
271             sub updated {
272 0     0 1 0 my ($self, %args) = @_;
273 0   0     0 my $time = $args{'time'} || time();
274 0   0     0 my $next = $args{'next'} || time() + 1800;
275              
276             # next update applies to all lists, save it
277             # make sure the file exists
278 0         0 $self->init();
279              
280 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{updates}));
281 0         0 my $update = { };
282 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->{files}->{updates} })) {
283 0         0 $update = $self->{data}->{ $self->{files}->{updates} };
284             }
285             else {
286             # retrieve information from storage
287 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (updated)");
288 0         0 $update = retrieve($file);
289             }
290              
291 0         0 $update->{next_update} = $next;
292 0         0 $update->{last_udpate} = $time;
293 0         0 $update->{errors} = 0;
294              
295 0 0       0 nstore($update, $file) or croak("Cannot save data to $file: $!\n");
296              
297 0 0       0 if ($self->{sticky}) {
298 0         0 $self->{data}->{ $self->{files}->{updates} } = $update;
299             }
300             }
301              
302              
303             sub update_error {
304 0     0 1 0 my ($self, %args) = @_;
305 0   0     0 my $time = $args{'time'} || time();
306 0   0     0 my $wait = $args{'wait'} || 1800;
307 0   0     0 my $errors = $args{errors} || 0;
308              
309             # make sure the file exists
310 0         0 $self->init();
311              
312 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{updates}));
313 0         0 my $update = { };
314 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->{files}->{updates} })) {
315 0         0 $update = $self->{data}->{ $self->{files}->{updates} };
316             }
317             else {
318             # retrieve information from storage
319 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (update_error)");
320 0         0 $update = retrieve($file);
321             }
322              
323 0         0 $update->{next_update} = $time + $wait;
324 0         0 $update->{last_udpate} = $time;
325 0         0 $update->{errors} = $errors;
326              
327 0 0       0 nstore($update, $file) or croak("Cannot save data to $file: $!\n");
328 0 0       0 if ($self->{sticky}) {
329 0         0 $self->{data}->{ $self->{files}->{updates} } = $update;
330             }
331             }
332              
333              
334             sub get_prefixes {
335 0     0 1 0 my ($self, %args) = @_;
336 0 0       0 my @lists = @{ $args{lists} || [] };
  0         0  
337 0 0       0 my @hashes = @{ $args{hashes} || [] };
  0         0  
338 0         0 my @data = ();
339              
340 0 0       0 $self->{logger} && $self->{logger}->debug("Number of lists: ", scalar(@lists));
341 0         0 foreach my $list (@lists) {
342 0         0 my $db = { };
343 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->list_to_file($list) })) {
344 0         0 $db = $self->{data}->{ $self->list_to_file($list) };
345             }
346             else {
347 0         0 my $file = path(join("/", $self->{path}, $self->list_to_file($list)));
348 0 0       0 if (! -e $file) {
349 0 0       0 $self->{logger} && $self->{logger}->debug("File $file does not exist");
350 0         0 next;
351             }
352              
353 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file (get_prefixes)");
354 0         0 $db = retrieve($file);
355              
356 0 0       0 if ($self->{sticky}) {
357 0         0 $self->{data}->{ $self->list_to_file($list) } = $db;
358             }
359             }
360              
361 0         0 foreach my $hash (@hashes) {
362 0         0 my $prefix = undef;
363 0     0   0 my $index = binsearch {substr($a, 0, length($b)) cmp $b} $hash, @{$db->{hashes}};
  0         0  
  0         0  
364 0 0       0 if (defined($index)) {
365 0         0 $prefix = $db->{hashes}->[$index];
366 0         0 push(@data, { prefix => $prefix, list => $list, hash => $hash });
367             }
368             }
369             }
370              
371 0         0 return @data;
372             }
373              
374              
375             sub add_full_hashes {
376 0     0 1 0 my ($self, %args) = @_;
377 0 0       0 my @hashes = @{ $args{hashes} || [] };
  0         0  
378 0   0     0 my $timestamp = $args{timestamp} || time();
379              
380              
381 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{full_hashes}));
382 0         0 my $db = { hashes => [] };
383 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->{files}->{full_hashes} })) {
    0          
384 0         0 $db = $self->{data}->{ $self->{files}->{full_hashes} };
385             }
386             elsif (-e $file) {
387 0         0 $db = retrieve($file);
388             }
389              
390 0         0 foreach my $hash (@hashes) {
391 0         0 my $cache = $hash->{cache};
392 0         0 $cache =~ s/s//;
393 0 0       0 $self->{logger} && $self->{logger}->debug("cache: $cache");
394              
395 0         0 $hash->{expire} = $cache + $timestamp;
396 0         0 push(@{ $db->{hashes} }, $hash);
  0         0  
397             }
398              
399 0 0       0 $self->{logger} && $self->{logger}->debug("Save ", scalar(@{ $db->{hashes} }), " full hashes to $file");
  0         0  
400 0 0       0 nstore($db, $file) or croak("Cannot save data to $file: $!\n");
401              
402 0 0       0 if ($self->{sticky}) {
403 0         0 $self->{data}->{ $self->{files}->{full_hashes} } = $db;
404             }
405              
406 0         0 return (@{ $db->{hashes} });
  0         0  
407             }
408              
409              
410             sub get_full_hashes {
411 0     0 1 0 my ($self, %args) = @_;
412 0 0       0 my @lists = @{ $args{lists} || [] };
  0         0  
413 0   0     0 my $hash = $args{hash} || return ();
414              
415 0         0 my $db = { };
416 0 0 0     0 if ($self->{sticky} && exists($self->{data}->{ $self->{files}->{full_hashes} })) {
417 0         0 $db = $self->{data}->{ $self->{files}->{full_hashes} };
418             }
419             else {
420 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{full_hashes}));
421 0 0       0 if (! -e $file) {
422 0         0 return ();
423             }
424              
425 0 0       0 $self->{logger} && $self->{logger}->debug("Load $file");
426 0         0 $db = retrieve($file);
427             }
428              
429 0         0 my @hashes = ();
430 0 0       0 $self->{logger} && $self->{logger}->debug("Number of full hashes on file: ", scalar(@{ $db->{hashes} }));
  0         0  
431 0         0 foreach my $list (@lists) {
432             my $result = first {
433             $_->{hash} eq $hash &&
434             $_->{list}->{threatEntryType} eq $list->{threatEntryType} &&
435             $_->{list}->{threatType} eq $list->{threatType} &&
436             $_->{list}->{platformType} eq $list->{platformType} &&
437             $_->{expire} > time()
438 0 0 0 0   0 } @{ $db->{hashes} };
  0   0     0  
  0   0     0  
439              
440 0 0       0 push(@hashes, $result) if (defined($result));
441             }
442              
443 0         0 return @hashes;
444             }
445              
446              
447             sub list_to_file {
448 0     0 0 0 my ($self, $list) = @_;
449              
450 0         0 return join("_", $list->{threatType}, $list->{platformType}, $list->{threatEntryType}) . ".gsb4";
451             }
452              
453              
454             sub close {
455 0     0 1 0 my ($self, %args) = @_;
456              
457 0 0       0 if ($self->{keep_all} == 0) {
458 0         0 return;
459             }
460              
461 0         0 my $file = path(join("/", $self->{path}, $self->{files}->{full_hashes}));
462 0 0       0 if (! -e $file) {
463 0         0 return;
464             }
465              
466 0         0 my $db = retrieve($file);
467              
468 0         0 my @results = grep { $_->{expire} > time() } @{ $db->{hashes} };
  0         0  
  0         0  
469 0 0       0 if (scalar(@results) < scalar(@{ $db->{hashes} })) {
  0         0  
470 0         0 $db->{hashes} = [@results];
471 0 0       0 nstore($db, $file) or croak("Cannot save data to $file: $!\n");
472             }
473              
474 0         0 $self->{data} = { };
475             }
476              
477              
478             sub get_lists {
479 1     1 1 925 my ($self, %args) = @_;
480              
481 1         7 my $file = path(join("/", $self->{path}, $self->{files}->{lists}));
482            
483 1 50       40 if (! -e $file) {
484 0         0 return [];
485             }
486            
487 1         29 my $db = retrieve($file);
488 1         127 return $db;
489             }
490              
491             sub save_lists {
492 2     2 1 20 my ($self, $lists) = @_;
493            
494 2         13 my $file = path(join("/", $self->{path}, $self->{files}->{lists}));
495 2 50       79 nstore($lists, $file) or croak("Cannot save data to $file: $!\n");
496             }
497              
498              
499             =head1 CHANGELOG
500              
501             =over 4
502              
503             =item 0.1
504              
505             Initial release
506              
507             =item 0.3
508              
509             Add C and C methods.
510              
511             =back
512              
513              
514             =head1 SEE ALSO
515              
516             See L for handling Google Safe Browsing v4.
517              
518             See L for the list of public functions.
519              
520             Google Safe Browsing v4 API: L
521              
522              
523             =head1 AUTHOR
524              
525             Julien Sobrier, Ejulien@sobrier.netE
526              
527             =head1 COPYRIGHT AND LICENSE
528              
529             Copyright (C) 2016 by Julien Sobrier
530              
531             This library is free software; you can redistribute it and/or modify
532             it under the same terms as Perl itself, either Perl version 5.8.8 or,
533             at your option, any later version of Perl 5 you may have available.
534              
535              
536             =cut
537              
538             1;