package Net::Google::SafeBrowsing2::Postgres;
use strict;
use warnings;
use base 'Net::Google::SafeBrowsing2::DBI';
use Carp;
use DBI;
use List::Util qw(first);
our $VERSION = '0.02';
=head1 NAME
Net::Google::SafeBrowsing2::Postgres - Postgres as back-end storage for the
Google Safe Browsing v2 database
=head1 SYNOPSIS
use Net::Google::SafeBrowsing2::Postgres;
my $storage = Net::Google::SafeBrowsing2::Postgres->new(
host => '127.0.0.1',
database => 'google_safe_browsing',
username => $username,
password => $password,
);
# ...
$storage->close();
=head1 DESCRIPTION
This is an implementation of L<Net::Google::SafeBrowsing2::Storage> using
Postgres.
=head1 CONSTRUCTOR
=over 4
=back
=head2 new()
Create a Net::Google::SafeBrowsing2::Postgres object
my $storage = Net::Google::SafeBrowsing2::Postgres->new(
host => '127.0.0.1',
database => 'google_safe_browsing',
username => $username,
password => $password,
);
Arguments
=over 4
=item host
Specifies Postgres host name. Defaults to 127.0.0.1.
=item database
Specifies Postgres database name. Defaults to "google_safe_browsing".
=item username
Specifies the username for the Postgres connection. Required.
=item password
Specifies the password for the Postgres connection. Required.
=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) = @_;
# Default arguments
my $self = {
host => '127.0.0.1',
database => 'google_safe_browsing',
keep_all => 0,
%args,
};
if (!$self->{username}) {
croak "username required";
}
if (!$self->{password}) {
croak "password required";
}
bless $self, $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:Pg:dbname=" . $self->{database} . ";host=" . $self->{host},
$self->{username},
$self->{password},
{
RaiseError => 1,
},
);
my @tables = $self->{dbh}->tables;
# Postgres reports normal tables (compared to internal ones) with a
# prefix of "public."
if (! defined first { /public\.updates/ } @tables) {
$self->create_table_updates();
}
if (! defined first { /public\.a_chunks/ } @tables) {
$self->create_table_a_chunks();
}
if (! defined first { /public\.s_chunks/ } @tables) {
$self->create_table_s_chunks();
}
if (! defined first { /public\.full_hashes/ } @tables) {
$self->create_table_full_hashes();
}
if (! defined first { /public\.full_hashes_errors/ } @tables) {
$self->create_table_full_hashes_errors();
}
if (! defined first { /public\.mac_keys/ } @tables) {
$self->create_table_mac_keys();
}
}
# Overridden because Postgres uses SERIAL instead of AUTO_INCREMENT.
sub create_table_full_hashes {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE full_hashes (
id SERIAL PRIMARY KEY,
num INT,
hash VARCHAR( 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);
}
# Overridden because Postgres uses SERIAL instead of AUTO_INCREMENT.
sub create_table_full_hashes_errors {
my ($self, %args) = @_;
my $schema = qq{
CREATE TABLE full_hashes_errors (
id SERIAL PRIMARY KEY,
errors INT Default '0',
prefix VARCHAR( 8 ),
timestamp INT Default '0'
);
};
$self->{dbh}->do($schema);
}
sub add_chunks_a {
my ($self, %args) = @_;
my $chunknum = $args{chunknum} || 0;
my $chunks = $args{chunks} || [];
my $list = $args{'list'} || '';
$self->{add_chunks_a_ins_sth} ||= $self->{dbh}->prepare('INSERT INTO a_chunks (hostkey, prefix, num, list) VALUES (?, ?, ?, ?)');
$self->{add_chunks_a_del_sth} ||= $self->{dbh}->prepare('DELETE FROM a_chunks WHERE hostkey = ? AND prefix = ? AND num = ? AND list = ?');
my $add = $self->{add_chunks_a_ins_sth};
my $del = $self->{add_chunks_a_del_sth};
foreach my $chunk (@$chunks) {
# Crude workaround for longer prefixes. Although Google state that the
# length varies, the overwhelming majority are 4 bytes. However, I have
# seen a 32 byte one (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;
}
$del->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $list );
$add->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $list );
}
if (scalar @$chunks == 0) { # keep empty chunks
$del->execute( '', '', $chunknum, $list );
$add->execute( '', '', $chunknum, $list );
}
}
=head1 SEE ALSO
See L<Net::Google::SafeBrowsing2> for handling Google Safe Browsing v2.
=head1 COPYRIGHT AND LICENSE
Copyright 2012 Nick Johnston, nickjohnstonsky@gmail.com. Based on
C<Net::Google::SafeBrowsing2> 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;