File Coverage

blib/lib/Net/Google/SafeBrowsing/UpdateRequest.pm
Criterion Covered Total %
statement 25 27 92.5
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 34 36 94.4


line stmt bran cond sub pod time code
1             # Copyright 2007 Daniel Born
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15             =head1 NAME
16              
17             Net::Google::SafeBrowsing::UpdateRequest - Update a Google SafeBrowsing table
18              
19             =head1 SYNOPSIS
20              
21             my $u = Net::Google::SafeBrowsing::UpdateRequest->new(
22             $apikey, $dbfile, $blocklist);
23             if ($u->update and $u->close) {
24             print "Successfully updated $blocklist in $dbfile\n";
25             }
26              
27             =head1 DESCRIPTION
28              
29             The UpdateRequest module updates the local cache of a Google SafeBrowsing URI
30             table. The cache is stored in a 'DB_File'.
31              
32             =head1 METHODS
33              
34             =over
35              
36             =cut
37              
38             package Net::Google::SafeBrowsing::UpdateRequest;
39 2     2   42840 use strict;
  2         4  
  2         68  
40 2     2   11 use warnings;
  2         3  
  2         94  
41             use fields (
42 2         11 'apikey', # Google API key
43             'dbfile', # Path to DB_File with URL hashes
44             'blocklist', # Name of Google blocklist to update
45             'reqfile', # Read /update from a local file (testing)
46             'keysfile', # Read MAC keys froma local file (testing)
47             'skip_mac', # Skip message authentication code verification
48             'db', # Database handle, tied to dbfile
49             'tabledata_ref', # Reference to the table data block
50             'mac', # Message authentication code for this update
51 2     2   1646 );
  2         3243  
52 2     2   11069 use LWP::UserAgent;
  2         106581  
  2         66  
53 2     2   1760 use English;
  2         8930  
  2         14  
54 2     2   1182 use Fcntl;
  2         3  
  2         675  
55 2     2   10 use Digest::MD5;
  2         14  
  2         69  
56 2     2   1737 use MIME::Base64;
  2         1507  
  2         161  
57 2     2   109697 use DB_File;
  0            
  0            
58             use Net::Google::SafeBrowsing::Blocklist qw(:all);
59             our $VERSION = '1.06';
60              
61             =item Net::Google::SafeBrowsing::UpdateRequest->new($apikey, $dbfile,
62             $blocklist, $reqfile, $keysfile, $skip_mac)
63              
64             Create an UpdateRequest for the specified table.
65              
66             =over
67              
68             =item $apikey
69              
70             API key from Google.
71              
72             =item $dbfile
73              
74             Path to place to store the results.
75              
76             =item $blocklist
77              
78             Name of URI table to update.
79              
80             =item $reqfile
81              
82             Optional. If specified, read an update from a local text file rather than
83             downloading one from Google (mostly for testing).
84              
85             =item $keysfile
86              
87             Optional. If specified, read a /getkeys result from a local file (mostly for
88             testing).
89              
90             =item $skip_mac
91              
92             Optional. If true, skip MAC verification.
93              
94             =back
95              
96             =cut
97              
98             sub new {
99             my ($class, $apikey, $dbfile, $blocklist, $reqfile, $keysfile, $skip_mac) = @_;
100             my Net::Google::SafeBrowsing::UpdateRequest $self = fields::new(
101             ref $class || $class);
102             $self->{apikey} = $apikey;
103             $self->{dbfile} = $dbfile;
104             $self->{blocklist} = $blocklist;
105             $self->{reqfile} = $reqfile;
106             $self->{keysfile} = $keysfile;
107             $self->{skip_mac} = $skip_mac;
108             my %db;
109             tie %db, 'DB_File', $dbfile, O_RDWR|O_CREAT, 0666, $DB_HASH
110             or die "Cannot open db file '$dbfile': $!";
111             if (not defined($db{$MAJORVERSION})) {
112             $db{$MAJORVERSION} = 1;
113             }
114             if (not defined($db{$MINORVERSION})) {
115             $db{$MINORVERSION} = -1;
116             }
117             $self->{db} = \%db;
118             return $self;
119             }
120              
121             sub get_local_file {
122             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
123             my ($file) = @_;
124             if (not sysopen(FH, $file, O_RDONLY)) {
125             warn "open $file: $!";
126             return undef;
127             }
128             my $content;
129             {
130             local $/ = undef;
131             $content = ;
132             }
133             close(FH);
134             return \$content;
135             }
136              
137             sub get_remote_content {
138             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
139             my ($uri) = @_;
140             my $ua = LWP::UserAgent->new;
141             $ua->timeout(60);
142             $self->{db}->{$LASTATTEMPT} = time();
143             my $resp = $ua->get($uri);
144             if ($resp->is_success) {
145             $self->{db}->{$ERRORS} = 0;
146             return $resp->content_ref;
147             } else {
148             ++$self->{db}->{$ERRORS};
149             warn "Request for '$uri' failed: ", $resp->status_line,
150             ", error count: ", $self->{db}->{$ERRORS};
151             return undef;
152             }
153             }
154              
155             sub get_keys {
156             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
157             my $content_ref;
158             if ($self->{keysfile}) {
159             l("Getting keys from local file ", $self->{keysfile});
160             if (not ($content_ref = $self->get_local_file($self->{keysfile}))) {
161             return 0;
162             }
163             } elsif (not ($content_ref = $self->get_remote_content(
164             'https://sb-ssl.google.com/safebrowsing/getkey?client=api'))) {
165             warn "/getkey request failed";
166             return 0;
167             }
168             if (not $self->parse_getkey($content_ref)) {
169             return 0;
170             }
171             return 1;
172             }
173              
174             =item $u->update
175              
176             Attempt to update the blocklist.
177              
178             =cut
179              
180             sub update {
181             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
182             my $now = time();
183             my $errs = $self->{db}->{$ERRORS} || 0;
184             my $last = $self->{db}->{$LASTATTEMPT} || 0;
185             my $sincelast = $now - $last;
186             if (($errs >= 5 and $sincelast < 360 * 60) or
187             ($errs == 4 and $sincelast < 180 * 60) or
188             ($errs == 3 and $sincelast < 60 * 60) or
189             ($errs >= 1 and $sincelast < 60)) {
190             warn "Too many failures: $errs. Last attempt: $last.";
191             return 0;
192             }
193             my $wrkey = '';
194             if (not $self->{skip_mac}) {
195             if (not ($self->{db}->{$CLIENTKEY} and $self->{db}->{$WRAPPEDKEY})) {
196             if (not $self->get_keys) {
197             return 0;
198             }
199             }
200             $wrkey .= '&wrkey=' . $self->{db}->{$WRAPPEDKEY};
201             }
202             my $content_ref;
203             if ($self->{reqfile}) {
204             l("Getting update from local file ", $self->{reqfile});
205             if (not ($content_ref = $self->get_local_file($self->{reqfile}))) {
206             return 0;
207             }
208             } elsif (not ($content_ref = $self->get_remote_content(
209             sprintf('http://sb.google.com/safebrowsing/update?client=api' .
210             '&apikey=%s&version=%s:%d:%d%s',
211             $self->{apikey}, $self->{blocklist},
212             $self->{db}->{$MAJORVERSION},
213             $self->{db}->{$MINORVERSION}, $wrkey)))) {
214             warn "/update request failed";
215             return 0;
216             }
217             if (${$content_ref} =~ /^\s*pleaserekey:/i) {
218             if (not $self->get_keys) {
219             return 0;
220             }
221             }
222             if (not $self->parse_update($content_ref)) {
223             warn "Failed to parse response: '${$content_ref}'";
224             return 0;
225             }
226             if (not $self->{skip_mac} and $self->{tabledata_ref}) {
227             if (not defined($self->{mac})) {
228             warn "No MAC returned";
229             return 0;
230             }
231             my $digest;
232             if (not $self->check_mac($self->{db}->{$CLIENTKEY},
233             $self->{tabledata_ref}, $self->{mac}, \$digest)) {
234             warn "MAC does not match, digest: '", $digest, "', MAC: '",
235             $self->{mac}, "'";
236             return 0;
237             }
238             }
239             $self->{db}->{$TIMESTAMP} = time();
240             return 1;
241             }
242              
243             sub check_mac {
244             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
245             my ($clientkey, $tabledata_ref, $expected, $actual_ref) = @_;
246             my $sep = ':coolgoog:';
247             my $data = $clientkey . $sep . ${$tabledata_ref} . $sep . $clientkey;
248             ${$actual_ref} = Digest::MD5::md5_base64($data) . '==';
249             return ${$actual_ref} eq $expected;
250             }
251              
252             sub parse_getkey {
253             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
254             my ($content_ref) = @_;
255             my $got = 0;
256             foreach my $line (split(/[\n\r]+/, ${$content_ref})) {
257             if ($line =~ /^\s*clientkey:(\d+):(.+)$/i) {
258             $self->{db}->{$CLIENTKEY} = MIME::Base64::decode_base64(
259             substr($2, 0, int($1)));
260             ++$got;
261             } elsif ($line =~ /^\s*wrappedkey:(\d+):(.+)$/i) {
262             $self->{db}->{$WRAPPEDKEY} = substr($2, 0, int($1));
263             ++$got;
264             }
265             }
266             if ($got < 2) {
267             warn "Failed to parse /getkey response";
268             return 0;
269             }
270             return 1;
271             }
272              
273             # This modifies ${$content_ref}.
274             sub parse_update {
275             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
276             my ($content_ref) = @_;
277             if (${$content_ref} =~ /^\s*$/) {
278             # Empty response if there are no updates.
279             return 1;
280             }
281             # Parse header line.
282             if (${$content_ref} !~ s/^\s*\[\s*(\S+)\s+(\d+)\.(\d+)(\s+update)?\s*\]//i) {
283             warn "Failed to parse header";
284             return 0;
285             }
286             my $postmatch = $POSTMATCH;
287             my $blocklist = $1;
288             if ($blocklist ne $self->{blocklist}) {
289             warn "Got wrong blocklist: '$blocklist', expected: '",
290             $self->{blocklist}, "'";
291             return 0;
292             }
293             my $is_replacement = not defined($4);
294             if ($is_replacement) {
295             $self->clear_table;
296             }
297             $self->{db}->{$MAJORVERSION} = int($2);
298             $self->{db}->{$MINORVERSION} = int($3);
299             if ($postmatch =~ /^\s*\[(.+?)\]/) {
300             # Parse optional key=value pairs.
301             my $opts = $1;
302             foreach my $kvp (split(/\s+/, $opts)) {
303             my ($key, $value) = split(/=/, $kvp, 2);
304             if (lc($key) eq 'mac') {
305             $self->{mac} = $value;
306             last; # mac is the only recognized key.
307             }
308             }
309             }
310             # Delete until end of header line's \n.
311             ${$content_ref} =~ s/^.*[\n\r]+//;
312             # Delete blank line after the end of the table data.
313             if (${$content_ref} =~ /[\n\r]{2}$/) {
314             ${$content_ref} =~ s/[\n\r]$//;
315             }
316             $self->{tabledata_ref} = $content_ref;
317             foreach my $line (split(/[\n\r]+/, ${$content_ref})) {
318             if ($line =~ /^\s*([+-])(\S+)/) {
319             my $key = pack('H32', $2);
320             if ($1 eq '+') {
321             $self->{db}->{$key} = '';
322             } else {
323             delete $self->{db}->{$key};
324             }
325             }
326             }
327             return 1;
328             }
329              
330             sub clear_table {
331             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
332             my %special;
333             foreach my $k (@SPECIAL_KEYS) {
334             $special{$k} = $self->{db}->{$k};
335             }
336             undef(%{$self->{db}});
337             %{$self->{db}} = %special;
338             }
339              
340             =item $u->close
341              
342             Close the $dbfile.
343              
344             =cut
345              
346             sub close {
347             my Net::Google::SafeBrowsing::UpdateRequest $self = shift;
348             if (not untie($self->{db})) {
349             warn "Failed to untie '", $self->{dbfile}, "': $!";
350             return 0;
351             }
352             return 1;
353             }
354              
355             sub l {
356             #print STDERR @_, "\n";
357             }
358              
359             =back
360              
361             =cut
362              
363              
364             1;
365