package Net::Google::SafeBrowsing2::MySQL;
use strict;
use warnings;
use base 'Net::Google::SafeBrowsing2::DBI';
use Carp;
use DBI;
use List::Util qw(first);
our $VERSION = '1.0';
=head1 NAME
Net::Google::SafeBrowsing2::MySQL - MySQL as back-end storage for the Google Safe Browsing v2 database
=head1 SYNOPSIS
use Net::Google::SafeBrowsing2::MySQL;
my $storage = Net::Google::SafeBrowsing2::MySQL->new(host => '127.0.0.1', database => 'GoogleSafeBrowsingv2');
...
$storage->close();
=head1 DESCRIPTION
This is an implementation of L<Net::Google::SafeBrowsing2::Storage> using MySQL.
=cut
=head1 CONSTRUCTOR
=over 4
=back
=head2 new()
Create a Net::Google::SafeBrowsing2::MySQL object
my $storage = Net::Google::SafeBrowsing2::MySQL->new(
host => '127.0.0.1',
database => 'GoogleSafeBrowsingv2',
username => 'foo',
password => 'bar'
);
Arguments
=over 4
=item host
Required. MySQL host name
=item database
Required. MySQL database name to connect to.
=item username
Required. MySQL username.
=item password
Required. MySQL password.
=item port
Optional. MySQL port number to connect to.
=item keep_all
Optional. Set to 1 to keep old information (such as expiring full hashes) in the database. 0 (delete) by default.
=back
=cut
sub new {
my ($class, %args) = @_;
my $self = { # default arguments
host => '127.0.0.1',
database => 'GoogleSafeBrowsingv2',
port => 3306,
keep_all => 0,
%args,
};
bless $self, $class or croak "Can't bless $class: $!";
$self->init();
return $self;
}
=head1 PUBLIC FUNCTIONS
=over 4
See L<Net::Google::SafeBrowsing2::Storage> for a complete list of public functions.
=back
=head2 close()
Cleanup old full hashes, and close the connection to the database.
$storage->close();
=cut
sub init {
my ($self, %args) = @_;
$self->{dbh} = DBI->connect("DBI:mysql:database=" . $self->{database} . ";host=" . $self->{host} . ";port=" . $self->{port}, $self->{username}, $self->{password}, {'RaiseError' => 1});
my @tables = $self->{dbh}->tables;
if (! defined first { $_ =~ '`updates`' } @tables) {
$self->create_table_updates();
}
if (! defined first { $_ =~ '`a_chunks`' } @tables) {
$self->create_table_a_chunks();
}
if (! defined first { $_ =~ '`s_chunks`' } @tables) {
$self->create_table_s_chunks();
}
if (! defined first { $_ =~ '`full_hashes`' } @tables) {
$self->create_table_full_hashes();
}
if (! defined first { $_ =~ '`full_hashes_errors`' } @tables) {
$self->create_table_full_hashes_errors();
}
if (! defined first { $_ =~ '`mac_keys`' } @tables) {
$self->create_table_mac_keys();
}
# Remove indexes previously created
$self->{dbh}->do("ALTER TABLE `a_chunks` DROP INDEX `a_chunks_hostkey`") if ($self->{dbh}->do("SHOW INDEX FROM `a_chunks`WHERE KEY_NAME = 'a_chunks_hostkey'") > 0);
$self->{dbh}->do("ALTER TABLE `a_chunks` DROP INDEX `a_chunks_num_list`") if ($self->{dbh}->do("SHOW INDEX FROM `a_chunks`WHERE KEY_NAME = 'a_chunks_num_list'") > 0);
$self->{dbh}->do("ALTER TABLE `s_chunks` DROP INDEX `s_chunks_hostkey`") if ($self->{dbh}->do("SHOW INDEX FROM `s_chunks`WHERE KEY_NAME = 's_chunks_hostkey'") > 0);
$self->{dbh}->do("ALTER TABLE `s_chunks` DROP INDEX `s_chunks_num`") if ($self->{dbh}->do("SHOW INDEX FROM `s_chunks`WHERE KEY_NAME = 's_chunks_num'") > 0);
$self->{dbh}->do("ALTER TABLE `s_chunks` DROP INDEX `s_chunks_num_list`") if ($self->{dbh}->do("SHOW INDEX FROM `s_chunks`WHERE KEY_NAME = 's_chunks_num_list'") > 0);
}
sub create_table_updates {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE updates (
last INT NOT NULL DEFAULT '0',
wait INT NOT NULL DEFAULT '0',
errors INT NOT NULL DEFAULT '1800',
list VARCHAR( 50 ) NOT NULL
);
}; # Need to handle errors
$self->{dbh}->do($schema);
}
sub create_table_a_chunks {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE a_chunks (
hostkey VARBINARY( 8 ),
prefix VARBINARY( 8 ),
num INT NOT NULL,
list VARCHAR( 50 ) NOT NULL
);
};
$self->{dbh}->do($schema);
my $index = qq{
CREATE INDEX a_chunks_hostkey ON a_chunks (
hostkey
);
};
# $self->{dbh}->do($index);
$index = qq{
CREATE INDEX a_chunks_num_list ON a_chunks (
num,
list
);
};
# $self->{dbh}->do($index);
$index = qq{
CREATE UNIQUE INDEX a_chunks_unique ON a_chunks (
hostkey,
prefix,
num,
list
);
};
$self->{dbh}->do($index);
}
sub create_table_s_chunks {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE s_chunks (
hostkey VARBINARY( 8 ),
prefix VARBINARY( 8 ),
num INT NOT NULL,
add_num INT DEFAULT 0,
list VARCHAR( 50 ) NOT NULL
);
};
$self->{dbh}->do($schema);
my $index = qq{
CREATE INDEX s_chunks_hostkey ON s_chunks (
hostkey
);
};
# $self->{dbh}->do($index);
$index = qq{
CREATE INDEX s_chunks_num ON s_chunks (
num
);
};
# $self->{dbh}->do($index);
$index = qq{
CREATE INDEX s_chunks_num_list ON s_chunks (
num,
list
);
};
# $self->{dbh}->do($index);
$index = qq{
CREATE UNIQUE INDEX s_chunks_unique ON s_chunks (
hostkey,
prefix,
num,
add_num,
list
);
};
$self->{dbh}->do($index);
}
sub create_table_full_hashes {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE full_hashes (
id INT AUTO_INCREMENT PRIMARY KEY,
num INT,
hash VARBINARY( 32 ),
list VARCHAR( 50 ),
timestamp INT Default '0'
);
};
$self->{dbh}->do($schema);
my $index = qq{
CREATE UNIQUE INDEX hash ON full_hashes (
num,
hash,
list
);
};
$self->{dbh}->do($index);
}
sub create_table_full_hashes_errors {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE full_hashes_errors (
id INT AUTO_INCREMENT PRIMARY KEY,
errors INT Default '0',
prefix VARBINARY( 8 ),
timestamp INT Default '0'
);
};
$self->{dbh}->do($schema);
}
sub create_table_mac_keys{
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE mac_keys (
client_key VARCHAR( 50 ) Default '',
wrapped_key VARCHAR( 50 ) Default ''
);
};
$self->{dbh}->do($schema);
}
sub add_chunks_s {
my ($self, %args) = @_;
my $chunknum = $args{chunknum} || 0;
my $chunks = $args{chunks} || [];
my $list = $args{'list'} || '';
my $add = $self->{dbh}->prepare('INSERT IGNORE INTO s_chunks (hostkey, prefix, num, add_num, list) VALUES (?, ?, ?, ?, ?)');
$self->{dbh}->{AutoCommit} = 0;
foreach my $chunk (@$chunks) {
$add->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $chunk->{add_chunknum}, $list );
}
if (scalar @$chunks == 0) { # keep empty chunks
$add->execute( '', '', $chunknum, '', $list );
}
$self->{dbh}->commit;
$self->{dbh}->{AutoCommit} = 1;
}
sub add_chunks_a {
my ($self, %args) = @_;
my $chunknum = $args{chunknum} || 0;
my $chunks = $args{chunks} || [];
my $list = $args{'list'} || '';
my $add = $self->{dbh}->prepare('INSERT IGNORE INTO a_chunks (hostkey, prefix, num, list) VALUES (?, ?, ?, ?)');
$self->{dbh}->{AutoCommit} = 0;
foreach my $chunk (@$chunks) {
# 32-byte prefix seen at chunk 69961
# If this becomes more of a problem, the schema will have to be adjusted.
if (length($chunk->{prefix}) > 8) {
$chunk->{prefix} = substr $chunk->{prefix}, 0, 4;
}
$add->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $list );
}
if (scalar @$chunks == 0) { # keep empty chunks
$add->execute( '', '', $chunknum, $list );
}
$self->{dbh}->commit;
$self->{dbh}->{AutoCommit} = 1;
}
=head1 CHANGELOG
=over 4
=item 0.6
Remove some indexes to speed up INSERTs.
=item 0.5
Keep empty sub chunks. Shorten prefixes greater than 8 bytes (workaround to keep schema tight)
=item 0.4
Add option keep_all to keep expired full hashes. Useful for debugging.
=item 0.3
Use more efficient add_chunk_a and add_chunk_s functions.
Change data type for prefixes from VARCHAR to VARBINARY.
=back
=head1 SEE ALSO
See L<Net::Google::SafeBrowsing2> for handling Google Safe Browsing v2.
See L<Net::Google::SafeBrowsing2::Storage> for the list of public functions.
See L<Net::Google::SafeBrowsing2::Sqlite> for a back-end using Sqlite.
Google Safe Browsing v2 API: L<http://code.google.com/apis/safebrowsing/developers_guide_v2.html>
=head1 AUTHOR
Julien Sobrier, E<lt>jsobrier@zscaler.comE<gt> or E<lt>julien@sobrier.netE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2011 by Julien Sobrier
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
1;