diff --git a/.gitignore b/.gitignore index 9a4ef46..15b4aa8 100644 --- a/.gitignore +++ b/.gitignore @@ -17,6 +17,8 @@ denysoft_greylist.dbm denysoft_greylist.dbm.lock greylist.dbm greylist.dbm.lock +greylisting.dbm +greylisting.dbm.lock /cover_db/ .last_cover_stats diff --git a/lib/Qpsmtpd/DB.pm b/lib/Qpsmtpd/DB.pm index a769c19..9d8df4e 100644 --- a/lib/Qpsmtpd/DB.pm +++ b/lib/Qpsmtpd/DB.pm @@ -1,20 +1,21 @@ package Qpsmtpd::DB; use strict; use warnings; -use Qpsmtpd::DB::File::DBM; -use Qpsmtpd::DB::Redis; + +our @child_classes = qw( + Qpsmtpd::DB::Redis + Qpsmtpd::DB::File::DBM +); sub new { my ( $class, %arg ) = @_; - # Qpsmtpd::DB::File::DBM is the only supported class just now - my @child_classes = qw( - Qpsmtpd::DB::Redis - Qpsmtpd::DB::File::DBM - ); - my $manual_class = delete $arg{class}; - return $manual_class->new(%arg) if $manual_class; + my @try_classes = @child_classes; + if ( my $manual_class = delete $arg{class} ) { + @try_classes = ( $manual_class ); + } my ( $child, @errors ); - for my $child_class ( @child_classes ) { + for my $child_class ( @try_classes ) { + eval "use $child_class"; eval { $child = $child_class->new(%arg); }; diff --git a/lib/Qpsmtpd/DB/File.pm b/lib/Qpsmtpd/DB/File.pm index d9ea042..3e37695 100644 --- a/lib/Qpsmtpd/DB/File.pm +++ b/lib/Qpsmtpd/DB/File.pm @@ -3,11 +3,6 @@ use strict; use warnings; use parent 'Qpsmtpd::DB'; -sub new { - my ( $class, %arg ) = @_; - return bless { %arg }, $class; -} - sub dir { my ( $self, @candidate_dirs ) = @_; return $self->{dir} if $self->{dir} and ! @candidate_dirs; diff --git a/lib/Qpsmtpd/DB/File/DBM.pm b/lib/Qpsmtpd/DB/File/DBM.pm index e5942c7..488094e 100644 --- a/lib/Qpsmtpd/DB/File/DBM.pm +++ b/lib/Qpsmtpd/DB/File/DBM.pm @@ -8,6 +8,11 @@ BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } use AnyDBM_File; use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); +sub new { + my ( $class, %arg ) = @_; + return bless {%arg}, $class; +} + sub file_extension { my ( $self, $extension ) = @_; return $self->{file_extension} ||= '.dbm'; @@ -152,4 +157,14 @@ sub delete { delete $tied->{$key}; } +sub flush { + my ( $self ) = @_; + my $tied = $self->{tied}; + if ( ! $tied ) { + warn "DBM db not yet set up, flush() failed\n"; + return; + } + delete $tied->{$_} for keys %$tied; +} + 1; diff --git a/lib/Qpsmtpd/DB/Redis.pm b/lib/Qpsmtpd/DB/Redis.pm index 9d35cb6..c5165e3 100644 --- a/lib/Qpsmtpd/DB/Redis.pm +++ b/lib/Qpsmtpd/DB/Redis.pm @@ -107,6 +107,8 @@ sub delete { return $self->redis->del($key); } +sub flush { shift->redis->flushdb } + package MyRedis; eval "use parent 'Redis'"; diff --git a/t/plugin_tests/greylisting b/t/plugin_tests/greylisting index d1bfe1d..5572561 100644 --- a/t/plugin_tests/greylisting +++ b/t/plugin_tests/greylisting @@ -8,11 +8,6 @@ use Qpsmtpd::Constants; my $test_email = 'user@example.com'; -my @greydbs = qw( denysoft_greylist.dbm denysoft_greylist.dbm.lock ); -foreach ( @greydbs ) { - unlink $_ if -f $_; -} - sub register_tests { my $self = shift; @@ -238,24 +233,38 @@ sub test_greylist { $self->connection->remote_ip('1.2.3.4'); my $sender = Qpsmtpd::Address->new( "<$test_email>" ); my $rcpt = Qpsmtpd::Address->new( "<$test_email>" ); - my $start = time() - 40 * 3600 * 24; # 40 days ago - $mocktime = $start; - is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), - 'DENYSOFT: This mail is temporarily denied', - 'Initial connection attempt greylisted' ); - $mocktime = $start + 60 * 49; - is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), - 'DENYSOFT: This mail is temporarily denied', - 'Greylisted 49 minutes later' ); - $mocktime = $start + 60 * 51; - is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), - 'DECLINED', - 'Allowed 51 minutes later' ); - $mocktime = $start + 60 * 52 + 36 * 3600 * 24; - $self->prune_db; - is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), - 'DENYSOFT: This mail is temporarily denied', - 're-greylisted 36 days later' ); + for my $test_class (@Qpsmtpd::DB::child_classes) { + delete $self->{db}; + eval { $self->db( class => $test_class ) }; + if ( $@ ) { + warn "Unable to test greylisting against $test_class: $@"; + next; + } + $self->db->lock; + $self->db->flush; + $self->db->unlock; + my $start = time() - 40 * 3600 * 24; # 40 days ago + $mocktime = $start; + is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), + 'DENYSOFT: This mail is temporarily denied', + 'Initial connection attempt greylisted' ); + $mocktime = $start + 60 * 49; + is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), + 'DENYSOFT: This mail is temporarily denied', + 'Greylisted 49 minutes later' ); + $mocktime = $start + 60 * 51; + is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), + 'DECLINED', + 'Allowed 51 minutes later' ); + $mocktime = $start + 60 * 52 + 36 * 3600 * 24; + $self->prune_db; + is( $self->rc( $self->greylist( $self->transaction, $sender, $rcpt ) ), + 'DENYSOFT: This mail is temporarily denied', + 're-greylisted 36 days later' ); + $self->db->lock; + $self->db->flush; + $self->db->unlock; + } } { diff --git a/t/qpsmtpd-db-file.t b/t/qpsmtpd-db-file.t new file mode 100644 index 0000000..0dffe47 --- /dev/null +++ b/t/qpsmtpd-db-file.t @@ -0,0 +1,47 @@ +use strict; +use warnings; + +use Test::More; + +use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) +use lib 't'; + +use_ok('Qpsmtpd::DB::File'); + +__qphome(); +__validate_dir(); +__dir(); + +done_testing(); + +sub __qphome { + my $db = FakeDB->new; + is( $db->qphome, 't', 'qphome()' ); +} + +sub __validate_dir { + my $db = FakeDB->new; + is( $db->validate_dir(), 0, 'validate_dir(): false on no input' ); + is( $db->validate_dir(undef), 0, 'validate_dir(): false on undef' ); + is( $db->validate_dir('invalid'), 0, + 'validate_dir(): false for non-existent directory' ); + is( $db->validate_dir('t/config'), 1, + 'validate_dir(): true for real directory' ); +} + +sub __dir { + my $db = FakeDB->new; + is( $db->dir(), 't/config', 'default directory' ); + is( $db->dir('_invalid','t/Test'), 't/Test', 'skip invalid candidate dirs' ); + $db->{dir} = '_cached'; + is( $db->dir(), '_cached', 'cached directory' ); + is( $db->dir('t/Test'), 't/Test', 'passing candidate dirs resets cache' ); + is( $db->dir('_invalid'), 't/config', 'invalid candidate dirs reverts to default' ); +} + +package FakeDB; +use parent 'Qpsmtpd::DB::File'; +sub new { + my $class = shift; + return bless {@_}, $class; +} diff --git a/t/qpsmtpd-db.t b/t/qpsmtpd-db.t new file mode 100644 index 0000000..af9bada --- /dev/null +++ b/t/qpsmtpd-db.t @@ -0,0 +1,68 @@ +use strict; +use warnings; + +use Test::More; + +use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) +use lib 't'; + +use_ok('Qpsmtpd::DB'); +use_ok('Qpsmtpd'); + +__new(); +__lock(); +__unlock(); +__name(); + +done_testing(); + +sub __new { + @Qpsmtpd::DB::child_classes = qw( + BrokenClassOne + BrokenClassTwo + ); + my $db; + eval { $db = Qpsmtpd::DB->new }; + is( $@, "Couldn't load any storage modules\n" + . "Couldn't load BrokenClassOne: fool me once, shame on me\n\n" + . "Couldn't load BrokenClassTwo: fool me can't get fooled again\n", + 'Detect failure to load all child DB classes' ); + eval { $db = Qpsmtpd::DB->new( class => 'BrokenClassOne' ) }; + is( $@, "fool me once, shame on me\n", + 'Failure to load manual class' ); + @Qpsmtpd::DB::child_classes = qw( EmptyClass ); + eval { $db = Qpsmtpd::DB->new }; + is( ref $db, 'EmptyClass', + 'Load object with manual (bogus) class: Qpsmtpd object is returned' ); +} + +sub __lock { + @Qpsmtpd::DB::child_classes = qw( EmptyClass ); + is( Qpsmtpd::DB->new->lock, 1, 'Default lock() method just returns true' ); +} + +sub __unlock { + @Qpsmtpd::DB::child_classes = qw( EmptyClass ); + is( Qpsmtpd::DB->new->unlock, 1, 'Default lock() method just returns true' ); +} + +sub __name { + @Qpsmtpd::DB::child_classes = qw( EmptyClass ); + my $db = Qpsmtpd::DB->new; + is( $db->name, undef, 'no name set yet' ); + is( $db->name('test'), 'test', 'set name' ); + is( $db->name, 'test', 'get name' ); +} + +package BrokenClassOne; +sub new { die "fool me once, shame on me\n" } + +package BrokenClassTwo; +sub new { die "fool me can't get fooled again\n" } + +package EmptyClass; +use parent 'Qpsmtpd::DB'; +sub new { + my $class = shift; + return bless {@_}, $class; +} diff --git a/t/qpsmtpd-plugin.t b/t/qpsmtpd-plugin.t new file mode 100644 index 0000000..9bb0e37 --- /dev/null +++ b/t/qpsmtpd-plugin.t @@ -0,0 +1,34 @@ +use strict; +use warnings; + +use Test::More; + +use lib 'lib'; # test lib/Qpsmtpd (vs site_perl) +use lib 't'; + +use_ok('Qpsmtpd::Plugin'); + +__db(); + +done_testing(); + +sub __db { + my $plugin = FakePlugin->new; + my $db = $plugin->db( class => 'FakeDB', name => 'testfoo' ); + is( ref $db, 'FakeDB', 'Qpsmtpd::Plugin::db(): Returns DB object' ); + is( ref $plugin->{db}, 'FakeDB', 'DB object is cached' ); + is( $db->{name}, 'testfoo', 'accepts name argument' ); + delete $plugin->{db}; + $db = $plugin->db( class => 'FakeDB' ); + is( $db->{name}, 'testbar', 'name argument defaults to plugin name' ); +} + +package FakePlugin; +use parent 'Qpsmtpd::Plugin'; +sub plugin_name { 'testbar' } + +package FakeDB; +sub new { + my $class = shift; + return bless {@_}, $class; +}