Get rid of Qpsmtpd::DB::File

DBM is probably the only file format we'll ever support anyhow
This commit is contained in:
Jared Johnson 2015-01-27 15:54:38 -06:00
parent ce97a0eb41
commit 113becf8be
6 changed files with 55 additions and 91 deletions

View File

@ -1,34 +0,0 @@
package Qpsmtpd::DB::File;
use strict;
use warnings;
use parent 'Qpsmtpd::DB';
sub dir {
my ( $self, @candidate_dirs ) = @_;
return $self->{dir} if $self->{dir} and ! @candidate_dirs;
push @candidate_dirs, ( $self->qphome . '/var/db', $self->qphome . '/config' );
for my $d ( @candidate_dirs ) {
next if ! $self->validate_dir($d);
return $self->{dir} = $d; # first match wins
}
}
sub validate_dir {
my ( $self, $d ) = @_;
return 0 if ! $d;
return 0 if ! -d $d;
return 1;
}
sub qphome {
my ( $self ) = @_;
my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
return $QPHOME;
}
sub path {
my ( $self ) = @_;
return $self->dir . '/' . $self->name . $self->file_extension;
}
1;

View File

@ -2,7 +2,7 @@ package Qpsmtpd::DB::File::DBM;
use strict;
use warnings;
use parent 'Qpsmtpd::DB::File';
use parent 'Qpsmtpd::DB';
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
use AnyDBM_File;
@ -13,11 +13,6 @@ sub new {
return bless {%arg}, $class;
}
sub file_extension {
my ( $self, $extension ) = @_;
return $self->{file_extension} ||= '.dbm';
}
sub lock {
my ( $self ) = @_;
if ( $self->nfs_locking ) {
@ -184,4 +179,32 @@ sub flush {
delete $tied->{$_} for keys %$tied;
}
sub dir {
my ( $self, @candidate_dirs ) = @_;
return $self->{dir} if $self->{dir} and ! @candidate_dirs;
push @candidate_dirs, ( $self->qphome . '/var/db', $self->qphome . '/config' );
for my $d ( @candidate_dirs ) {
next if ! $self->validate_dir($d);
return $self->{dir} = $d; # first match wins
}
}
sub validate_dir {
my ( $self, $d ) = @_;
return 0 if ! $d;
return 0 if ! -d $d;
return 1;
}
sub qphome {
my ( $self ) = @_;
my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
return $QPHOME;
}
sub path {
my ( $self ) = @_;
return $self->dir . '/' . $self->name . '.dbm';
}
1;

View File

@ -268,8 +268,6 @@ sub init_dbm {
$cdir = $1 if $cdir and $cdir =~ m{^([-a-zA-Z0-9./_]+)$};
# greylisting-specific hints for where to store the greylist DB
my $db_dir = $self->db->dir( $cdir, '/var/lib/qpsmtpd/greylisting' );
return 1 if $self->db->file_extension ne '.dbm';
$self->db->nfs_locking( $self->{_args}{nfslock} );
# Work around old DBM filename

View File

@ -262,8 +262,6 @@ sub init_db {
my $cdir = $self->{_args}{db_dir};
# karma-specific hints for where to store the DB
$self->db->dir( $cdir, '/var/lib/qpsmtpd/karma' );
return if $self->db->file_extension ne '.dbm';
$self->db->nfs_locking( $self->{_args}{nfslock} );
}

View File

@ -18,6 +18,9 @@ __delete();
__get_keys();
__size();
__flush();
__qphome();
__validate_dir();
__dir();
__untie_gotcha();
done_testing();
@ -101,6 +104,29 @@ sub __flush {
$db->unlock;
}
sub __qphome {
is( $db->qphome, 't', 'qphome()' );
}
sub __validate_dir {
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/tmp'), 1,
'validate_dir(): true for real directory' );
}
sub __dir {
my $db2 = Qpsmtpd::DB::File::DBM->new( name => 'dirtest' );
is( $db2->dir(), 't/config', 'default directory' );
is( $db2->dir('_invalid','t/Test'), 't/Test', 'skip invalid candidate dirs' );
$db2->{dir} = '_cached';
is( $db2->dir(), '_cached', 'cached directory' );
is( $db2->dir('t/Test'), 't/Test', 'passing candidate dirs resets cache' );
is( $db2->dir('_invalid'), 't/config', 'invalid candidate dirs reverts to default' );
}
sub __untie_gotcha {
# Regression test for 'gotcha' with untying hash that never goes away
$db->lock;

View File

@ -1,47 +0,0 @@
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;
}