diff --git a/lib/Qpsmtpd/DB.pm b/lib/Qpsmtpd/DB.pm new file mode 100644 index 0000000..e497af3 --- /dev/null +++ b/lib/Qpsmtpd/DB.pm @@ -0,0 +1,21 @@ +package Qpsmtpd::DB; +use strict; +use warnings; +use Qpsmtpd::DB::File::DBM; + +sub new { + my ( $class, %arg ) = @_; + # The only supported class just now + return bless { %arg }, 'Qpsmtpd::DB::File::DBM'; +} + +# noop default method for plugins that don't require locking +sub get_lock { 1 } + +sub name { + my ( $self, $name ) = @_; + return $self->{name} = $name if $name; + return $self->{name}; +} + +1; diff --git a/lib/Qpsmtpd/DB/File.pm b/lib/Qpsmtpd/DB/File.pm new file mode 100644 index 0000000..3e37695 --- /dev/null +++ b/lib/Qpsmtpd/DB/File.pm @@ -0,0 +1,34 @@ +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; diff --git a/lib/Qpsmtpd/DB/File/DBM.pm b/lib/Qpsmtpd/DB/File/DBM.pm new file mode 100644 index 0000000..e5942c7 --- /dev/null +++ b/lib/Qpsmtpd/DB/File/DBM.pm @@ -0,0 +1,155 @@ +package Qpsmtpd::DB::File::DBM; +use strict; +use warnings; + +use parent 'Qpsmtpd::DB::File'; + +BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } +use AnyDBM_File; +use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); + +sub file_extension { + my ( $self, $extension ) = @_; + return $self->{file_extension} ||= '.dbm'; +} + +sub lock { + my ( $self ) = @_; + if ( $self->nfs_locking ) { + $self->nfs_file_lock or return; + } else { + $self->file_lock or return; + } + return $self->tie_dbm; +} + +sub file_lock { + my ( $self ) = @_; + my $path = $self->path; + open(my $lock, '>', "$path.lock") or do { + warn "opening lockfile failed: $!\n"; + return; + }; + + flock($lock, LOCK_EX) or do { + warn "flock of lockfile failed: $!\n"; + close $lock; + return; + }; + $self->{lock} = $lock; +} + +sub nfs_file_lock { + my ( $self ) = @_; + my $path = $self->path; + + require File::NFSLock; + + ### set up a lock - lasts until object looses scope + my $nfslock = new File::NFSLock { + file => "$path.lock", + lock_type => LOCK_EX | LOCK_NB, + blocking_timeout => 10, # 10 sec + stale_lock_timeout => 30 * 60, # 30 min + } + or do { + warn "nfs lockfile failed: $!\n"; + return; + }; + + open(my $lock, '+<', "$path.lock") or do { + warn "opening nfs lockfile failed: $!\n"; + return; + }; + + $self->{lock} = $lock; +} + +sub tie_dbm { + my ( $self ) = @_; + my $path = $self->path; + + tie(my %db, 'AnyDBM_File', $path, O_CREAT | O_RDWR, oct('0600')) or do { + warn "tie to database $path failed: $!\n"; + $self->unlock; + return; + }; + $self->{tied} = \%db; + return 1; +} + +sub nfs_locking { + my $self = shift; + return $self->{nfs_locking} if ! @_; + return $self->{nfs_locking} = shift; +} + +sub unlock { + my ( $self ) = @_; + close $self->{lock}; + untie $self->{tied}; +} + +sub get { + my ( $self, $key ) = @_; + if ( ! $key ) { + warn "No key provided, set() failed\n"; + return; + } + my $tied = $self->{tied}; + if ( ! $tied ) { + warn "DBM db not yet set up, get() failed\n"; + return; + } + return $tied->{$key}; +} + +sub set { + my ( $self, $key, $val ) = @_; + my $tied = $self->{tied}; + if ( ! $tied ) { + warn "DBM db not yet set up, set() failed\n"; + return; + } + if ( ! $key ) { + warn "No key provided, set() failed\n"; + return; + } + return $tied->{$key} = $val; +} + +sub get_keys { + my ( $self ) = @_; + my $tied = $self->{tied}; + if ( ! $tied ) { + warn "DBM db not yet set up, keys() failed\n"; + return; + } + return keys %$tied; +} + +sub size { + my ( $self ) = @_; + my $tied = $self->{tied}; + if ( ! $tied ) { + warn "DBM db not yet set up, size() failed\n"; + return; + } + return scalar keys %$tied; +} + +sub delete { + my ( $self, $key ) = @_; + my $tied = $self->{tied}; + if ( ! $tied ) { + warn "DBM db not yet set up, delete() failed\n"; + return; + } + if ( ! $key ) { + warn "No key provided, delete() failed\n"; + return; + } + delete $tied->{$key}; +} + +1; diff --git a/lib/Qpsmtpd/Plugin.pm b/lib/Qpsmtpd/Plugin.pm index b38c3d7..b51b6cf 100644 --- a/lib/Qpsmtpd/Plugin.pm +++ b/lib/Qpsmtpd/Plugin.pm @@ -4,6 +4,7 @@ use warnings; use lib 'lib'; use parent 'Qpsmtpd::Base'; +use Qpsmtpd::DB; use Qpsmtpd::Constants; # more or less in the order they will fire @@ -346,4 +347,9 @@ sub _register_standard_hooks { } } +sub db { + my ( $self, %arg ) = @_; + return $self->{db} ||= Qpsmtpd::DB->new(%arg); +} + 1; diff --git a/plugins/greylisting b/plugins/greylisting index 755cacf..b00bc03 100644 --- a/plugins/greylisting +++ b/plugins/greylisting @@ -178,13 +178,7 @@ use Qpsmtpd::Constants; my $VERSION = '0.12'; -BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } -use AnyDBM_File; -use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); - my $DENYMSG = "This mail is temporarily denied"; -my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); -my $DB = "greylist.dbm"; my %PERMITTED_ARGS = map { $_ => 1 } qw(per_recipient remote_ip sender recipient black_timeout grey_timeout white_timeout deny_late db_dir nfslock p0f reject loglevel geoip upgrade ); @@ -224,6 +218,7 @@ sub register { else { $self->register_hook('rcpt', 'rcpt_handler'); } + $self->init_db(); $self->prune_db(); if ($self->{_args}{upgrade}) { $self->convert_db(); @@ -231,6 +226,25 @@ sub register { $self->load_exclude_files(); } +sub init_db { + my ( $self ) = @_; + $self->db( name => 'greylist' ); + return if ! $self->db->can('path'); + my $cdir = $self->{_args}{db_dir}; + $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 if $self->db->file_extension ne '.dbm'; + $self->db->nfs_locking( $self->{_args}{nfslock} ); + + # Work around old DBM filename + return if -f "$db_dir/greylist.dbm"; + my $oldname = 'denysoft_greylist'; + return if ! -f "$db_dir/$oldname.dbm"; + $self->db->name($oldname); +} + sub load_exclude_files { my ( $self ) = @_; $self->load_exclude_file($_) for $self->qp->config('greylist_exclude_files'); @@ -337,30 +351,30 @@ sub greylist { return DECLINED if $self->exclude(); - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; + my $key = $self->get_greylist_key($sender, $rcpt) or return DECLINED; my $fmt = "%s:%d:%d:%d"; - # new IP or entry timed out - record new - if (!$tied->{$key}) { - $tied->{$key} = sprintf $fmt, time, 1, 0, 0; + $self->db->lock or return DECLINED; + my $value = $self->db->get($key); + if ( ! $value ) { + # new IP or entry timed out - record new + $self->db->set( $key, sprintf $fmt, time, 1, 0, 0 ); $self->log(LOGWARN, "fail: initial DENYSOFT, unknown"); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } - my ($ts, $new, $black, $white) = split /:/, $tied->{$key}; + my ( $ts, $new, $black, $white ) = split /:/, $value; $self->log(LOGDEBUG, "ts: " . localtime($ts) . ", now: " . localtime); if ($white) { # white IP - accept unless timed out if (time - $ts < $config->{white_timeout}) { - $tied->{$key} = sprintf $fmt, time, $new, $black, ++$white; + $self->db->set( $key, sprintf $fmt, time, $new, $black, ++$white ); $self->log(LOGINFO, "pass: white, $white deliveries"); - return $self->cleanup_and_return($tied, $lock, DECLINED); + return $self->cleanup_and_return(DECLINED); } else { $self->log(LOGINFO, "key $key has timed out (white)"); @@ -369,28 +383,27 @@ sub greylist { # Black IP - deny, but don't update timestamp if (time - $ts < $config->{black_timeout}) { - $tied->{$key} = sprintf $fmt, $ts, $new, ++$black, 0; + $self->db->set( $key, sprintf $fmt, $ts, $new, ++$black, 0 ); $self->log(LOGWARN, "fail: black DENYSOFT - $black deferred connections"); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } # Grey IP - accept unless timed out elsif (time - $ts < $config->{grey_timeout}) { - $tied->{$key} = sprintf $fmt, time, $new, $black, 1; + $self->db->set( $key, sprintf $fmt, time, $new, $black, 1 ); $self->log(LOGWARN, "pass: updated grey->white"); - return $self->cleanup_and_return($tied, $lock, DECLINED); + return $self->cleanup_and_return(DECLINED); } $self->log(LOGWARN, "pass: timed out (grey)"); - return $self->cleanup_and_return($tied, $lock, DECLINED); + return $self->cleanup_and_return(DECLINED); } sub cleanup_and_return { - my ($self, $tied, $lock, $return_val) = @_; + my ($self, $return_val) = @_; - untie $tied; - close $lock; + $self->db->unlock; return $return_val if defined $return_val; # explicit override return DECLINED if defined $self->{_args}{reject} && !$self->{_args}{reject}; @@ -417,137 +430,45 @@ sub get_greylist_key { return join ':', @key; } -sub get_dbm_tie { - my ($self, $db, $lock) = @_; - - tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, oct('0600')) or do { - $self->log(LOGCRIT, "tie to database $db failed: $!"); - close $lock; - return; - }; - return \%db; -} - -sub get_dbm_location { - my $self = shift; - - my $transaction = $self->qp->transaction; - my $config = $self->{_args}; - - if ($config->{db_dir} && $config->{db_dir} =~ m{^([-a-zA-Z0-9./_]+)$}) { - $config->{db_dir} = $1; - } - - my @candidate_dirs = ( - $config->{db_dir}, - "/var/lib/qpsmtpd/greylisting", - "$QPHOME/var/db", "$QPHOME/config", '.' - ); - - my $dbdir; - for my $d (@candidate_dirs) { - next if !$d || !-d $d; # impossible - $dbdir = $d; - last; # first match wins - } - my $db = "$dbdir/$DB"; - if (!-f $db && -f "$dbdir/denysoft_greylist.dbm") { - $db = "$dbdir/denysoft_greylist.dbm"; # old DB name - } - $self->log(LOGDEBUG, "using $db as greylisting database"); - return $db; -} - -sub get_dbm_lock { - my ($self, $db) = @_; - - return $self->get_dbm_lock_nfs($db) if $self->{_args}{nfslock}; - - # Check denysoft db - open(my $lock, '>', "$db.lock") or do { - $self->log(LOGCRIT, "opening lockfile failed: $!"); - return; - }; - - flock($lock, LOCK_EX) or do { - $self->log(LOGCRIT, "flock of lockfile failed: $!"); - close $lock; - return; - }; - - return $lock; -} - -sub get_dbm_lock_nfs { - my ($self, $db) = @_; - - require File::NFSLock; - - ### set up a lock - lasts until object looses scope - my $nfslock = new File::NFSLock { - file => "$db.lock", - lock_type => LOCK_EX | LOCK_NB, - blocking_timeout => 10, # 10 sec - stale_lock_timeout => 30 * 60, # 30 min - } - or do { - $self->log(LOGCRIT, "nfs lockfile failed: $!"); - return; - }; - - open(my $lock, '+<', "$db.lock") or do { - $self->log(LOGCRIT, "opening nfs lockfile failed: $!"); - return; - }; - - return $lock; -} - sub convert_db { my $self = shift; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; - my $count = keys %$tied; + $self->db->lock or return DECLINED; + my $count = $self->db->size; my $converted = 0; - foreach my $key (keys %$tied) { + foreach my $key ( $self->db->get_keys ) { my (@parts) = split /:/, $key; next if $parts[0] =~ /^[\d]+$/; # already converted $converted++; my $nip = Net::IP->new($parts[0]); $parts[0] = $nip->intip; # convert IP to integer my $new_key = join ':', @parts; - $tied->{$new_key} = $tied->{$key}; - delete $tied->{$key}; + $self->db->set( $new_key, $self->db->get($key) ); + $self->db->delete( $key ); } - untie $tied; - close $lock; + $self->db->unlock; $self->log(LOGINFO, "converted $converted of $count DB entries"); - return $self->cleanup_and_return($tied, $lock, DECLINED); + return $self->cleanup_and_return(DECLINED); } sub prune_db { my $self = shift; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; - my $count = keys %$tied; + $self->db->lock or return DECLINED; + my $count = $self->db->size; my $pruned = 0; - foreach my $key (keys %$tied) { - my ($ts, $new, $black, $white) = split /:/, $tied->{$key}; + foreach my $key ( $self->db->get_keys ) { + my ($ts, $new, $black, $white) = split /:/, $self->db->get($key); my $age = time - $ts; next if $age < $self->{_args}{white_timeout}; $pruned++; - delete $tied->{$key}; + $self->db->delete($key); } - untie $tied; - close $lock; + $self->db->unlock; $self->log(LOGINFO, "pruned $pruned of $count DB entries"); - return $self->cleanup_and_return($tied, $lock, DECLINED); + return $self->cleanup_and_return(DECLINED); } sub exclude { diff --git a/plugins/karma b/plugins/karma index 5fadbb9..6b598a7 100644 --- a/plugins/karma +++ b/plugins/karma @@ -231,9 +231,6 @@ use warnings; use Qpsmtpd::Constants; -BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } -use AnyDBM_File; -use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); use Net::IP; sub register { @@ -248,6 +245,7 @@ sub register { $self->{_args}{reject} = 'naughty'; } + $self->init_db(); #$self->prune_db(); # keep the DB compact $self->register_hook('connect', 'connect_handler'); $self->register_hook('mail', 'from_handler'); @@ -257,6 +255,18 @@ sub register { $self->register_hook('disconnect', 'disconnect_handler'); } +sub init_db { + my ( $self ) = @_; + $self->db( name => 'karma' ); + return if ! $self->db->can('path'); + 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} ); +} + sub hook_pre_connection { my ($self, $transaction, %args) = @_; @@ -264,23 +274,22 @@ sub hook_pre_connection { my $remote_ip = $args{remote_ip}; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; + $self->db->lock or return DECLINED; my $key = $self->get_karma_key($remote_ip) or do { $self->log(LOGINFO, "skip, unable to get DB key"); return DECLINED; }; - if (!$tied->{$key}) { + my $value = $self->db->get($key); + if ( ! $value ) { $self->log(LOGDEBUG, "pass, no record"); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } my ($penalty_start_ts, $naughty, $nice, $connects) = - $self->parse_db_record($tied->{$key}); + $self->parse_db_record($value); $self->calc_karma($naughty, $nice); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } sub connect_handler { @@ -290,37 +299,36 @@ sub connect_handler { return DECLINED if $self->is_immune(); - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; + $self->db->lock or return DECLINED; my $key = $self->get_karma_key() or do { $self->log(LOGINFO, "skip, unable to get DB key"); return DECLINED; }; - if (!$tied->{$key}) { + my $value = $self->db->get($key); + if ( ! $value) { $self->log(LOGINFO, "pass, no record"); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } my ($penalty_start_ts, $naughty, $nice, $connects) = - $self->parse_db_record($tied->{$key}); + $self->parse_db_record($value); my $summary = "$naughty naughty, $nice nice, $connects connects"; my $karma = $self->calc_karma($naughty, $nice); if (!$penalty_start_ts) { $self->log(LOGINFO, "pass, no penalty ($summary)"); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } my $days_old = (time - $penalty_start_ts) / 86400; if ($days_old >= $self->{_args}{penalty_days}) { $self->log(LOGINFO, "pass, penalty expired ($summary)"); - return $self->cleanup_and_return($tied, $lock); + return $self->cleanup_and_return(); } - $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects); - $self->cleanup_and_return($tied, $lock); + $self->db->set( $key, join(':', $penalty_start_ts, $naughty, $nice, ++$connects) ); + $self->cleanup_and_return(); my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old; my $mess = "You were naughty. You cannot connect for $left more days."; @@ -414,13 +422,11 @@ sub disconnect_handler { return DECLINED; }; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; + $self->db->lock or return DECLINED; my $key = $self->get_karma_key(); my ($penalty_start_ts, $naughty, $nice, $connects) = - $self->parse_db_record($tied->{$key}); + $self->parse_db_record( $self->db->get($key) ); my $history = ($nice || 0) - $naughty; my $log_mess = ''; @@ -450,8 +456,8 @@ sub disconnect_handler { } $self->log(LOGINFO, $log_mess . ", (msg: $karma, his: $history)"); - $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects); - return $self->cleanup_and_return($tied, $lock); + $self->db->set( $key, join(':', $penalty_start_ts, $naughty, $nice, ++$connects) ); + return $self->cleanup_and_return(); } sub illegal_envelope_format { @@ -489,10 +495,9 @@ sub calc_karma { } sub cleanup_and_return { - my ($self, $tied, $lock, $return_val) = @_; + my ( $self, $return_val ) = @_; - untie $tied; - close $lock; + $self->db->unlock; return $return_val if defined $return_val; # explicit override return DECLINED; } @@ -507,103 +512,21 @@ sub get_karma_key { return $nip->intip; # convert IP to an int } -sub get_dbm_tie { - my ($self, $db, $lock) = @_; - - tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do { - $self->log(LOGCRIT, "error, tie to database $db failed: $!"); - close $lock; - return; - }; - return \%db; -} - -sub get_dbm_location { - my $self = shift; - - # Setup database location - my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); - my @candidate_dirs = ( - $self->{args}{db_dir}, - "/var/lib/qpsmtpd/karma", "$QPHOME/var/db", - "$QPHOME/config", '.' - ); - - my $dbdir; - for my $d (@candidate_dirs) { - next if !$d || !-d $d; # impossible - $dbdir = $d; - last; # first match wins - } - my $db = "$dbdir/karma.dbm"; - $self->log(LOGDEBUG, "using $db as karma database"); - return $db; -} - -sub get_dbm_lock { - my ($self, $db) = @_; - - return $self->get_dbm_lock_nfs($db) if $self->{_args}{nfslock}; - - # Check denysoft db - open(my $lock, ">$db.lock") or do { - $self->log(LOGCRIT, "error, opening lockfile failed: $!"); - return; - }; - - flock($lock, LOCK_EX) or do { - $self->log(LOGCRIT, "error, flock of lockfile failed: $!"); - close $lock; - return; - }; - - return $lock; -} - -sub get_dbm_lock_nfs { - my ($self, $db) = @_; - - require File::NFSLock; - - ### set up a lock - lasts until object looses scope - my $nfslock = new File::NFSLock { - file => "$db.lock", - lock_type => LOCK_EX | LOCK_NB, - blocking_timeout => 10, # 10 sec - stale_lock_timeout => 30 * 60, # 30 min - } - or do { - $self->log(LOGCRIT, "error, nfs lockfile failed: $!"); - return; - }; - - open(my $lock, "+<$db.lock") or do { - $self->log(LOGCRIT, "error, opening nfs lockfile failed: $!"); - return; - }; - - return $lock; -} - sub prune_db { my $self = shift; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return DECLINED; - my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED; - my $count = keys %$tied; + $self->db->lock or return DECLINED; + my $count = $self->db->size; my $pruned = 0; - foreach my $key (keys %$tied) { - my $ts = $tied->{$key}; + foreach my $key ( $self->db->get_keys ) { + my $ts = $self->db->get($key); my $days_old = (time - $ts) / 86400; next if $days_old < $self->{_args}{penalty_days} * 2; - delete $tied->{$key}; + $self->delete($key); $pruned++; } - untie $tied; - close $lock; $self->log(LOGINFO, "pruned $pruned of $count DB entries"); - return $self->cleanup_and_return($tied, $lock, DECLINED); + return $self->cleanup_and_return(DECLINED); } diff --git a/plugins/karma_tool b/plugins/karma_tool index 7307064..0af089d 100755 --- a/plugins/karma_tool +++ b/plugins/karma_tool @@ -4,13 +4,13 @@ package Karma; use strict; use warnings; -BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } -use AnyDBM_File; use Data::Dumper; -use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); use Net::IP qw(:PROC); use POSIX qw(strftime); +use lib 'lib'; +use Qpsmtpd::DB; + my $self = bless({args => {db_dir => 'config'},}, 'Karma'); my $command = $ARGV[0]; @@ -57,6 +57,18 @@ EO_HELP ; } +sub db { + my ( $self ) = @_; + return $self->{db} if $self->{db}; + $self->{db} = Qpsmtpd::DB->new( name => 'karma' ); + $self->{db}->dir( + $self->{args}{db_dir}, + qw( /var/lib/qpsmtpd/karma ./var/db ./config . ) ); + my $path = $self->{db}->path; + print "using karma db at $path\n"; + return $self->{db}; +} + sub capture { my $self = shift; my $ip = shift or return; @@ -65,16 +77,14 @@ sub capture { return; }; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return; - my $tied = $self->get_dbm_tie($db, $lock) or return; + $self->db->lock; my $key = $self->get_karma_key($ip); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, - $tied->{$key}; + $self->db->get( $key ); - $tied->{$key} = join(':', time, $naughty + 1, $nice, $connects); - return $self->cleanup_and_return($tied, $lock); + $self->db->set( $key, join(':', time, $naughty + 1, $nice, $connects) ); + $self->db->unlock; } sub release { @@ -82,28 +92,26 @@ sub release { my $ip = shift or return; is_ip($ip) or do { warn "not an IP: $ip\n"; return; }; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return; - my $tied = $self->get_dbm_tie($db, $lock) or return; + $self->db->lock; my $key = $self->get_karma_key($ip); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, - $tied->{$key}; + $self->db->get( $key ); - $tied->{$key} = join(':', 0, 0, $nice, $connects); - return $self->cleanup_and_return($tied, $lock); + $self->db->set( $key, join(':', 0, 0, $nice, $connects) ); + $self->db->unlock; } sub show_ip { my $self = shift; my $ip = shift or return; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return; - my $tied = $self->get_dbm_tie($db, $lock) or return; + $self->db->lock; + my $key = $self->get_karma_key($ip); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, - $tied->{$key}; + $self->db->get( $key ); + $self->db->unlock; $naughty ||= 0; $nice ||= 0; $connects ||= 0; @@ -122,17 +130,15 @@ sub show_ip { sub main { my $self = shift; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return; - my $tied = $self->get_dbm_tie($db, $lock) or return; + $self->db->lock; my %totals; print " IP Address Penalty Naughty Nice Connects Hostname\n"; - foreach my $r (sort keys %$tied) { + foreach my $r ( $self->db->get_keys ) { my $ip = ip_bintoip(ip_inttobin($r, 4), 4); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, - $tied->{$r}; + $self->db->get( $r ); $naughty ||= ''; $nice ||= ''; $connects ||= ''; @@ -167,6 +173,7 @@ sub main { $totals{nice} += $nice if $nice; $totals{connects} += $connects if $connects; } + $self->db->unlock; print Dumper(\%totals); } @@ -176,114 +183,28 @@ sub is_ip { return 1; } -sub cleanup_and_return { - my ($self, $tied, $lock) = @_; - untie $tied; - close $lock; -} - sub get_karma_key { my $self = shift; my $nip = Net::IP->new(shift) or return; return $nip->intip; # convert IP to an int } -sub get_dbm_tie { - my ($self, $db, $lock) = @_; - - tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do { - warn "tie to database $db failed: $!"; - close $lock; - return; - }; - return \%db; -} - -sub get_dbm_location { - my $self = shift; - - # Setup database location - my @candidate_dirs = ( - $self->{args}{db_dir}, - "/var/lib/qpsmtpd/karma", "./var/db", "./config", '.' - ); - - my $dbdir; - for my $d (@candidate_dirs) { - next if !$d || !-d $d; # impossible - $dbdir = $d; - last; # first match wins - } - my $db = "$dbdir/karma.dbm"; - print "using karma db at $db\n"; - return $db; -} - -sub get_dbm_lock { - my ($self, $db) = @_; - - return $self->get_dbm_lock_nfs($db) if $self->{_args}{nfslock}; - - # Check denysoft db - open(my $lock, ">$db.lock") or do { - warn "opening lockfile failed: $!"; - return; - }; - - flock($lock, LOCK_EX) or do { - warn "flock of lockfile failed: $!"; - close $lock; - return; - }; - - return $lock; -} - -sub get_dbm_lock_nfs { - my ($self, $db) = @_; - - require File::NFSLock; - - ### set up a lock - lasts until object looses scope - my $nfslock = new File::NFSLock { - file => "$db.lock", - lock_type => LOCK_EX | LOCK_NB, - blocking_timeout => 10, # 10 sec - stale_lock_timeout => 30 * 60, # 30 min - } - or do { - warn "nfs lockfile failed: $!"; - return; - }; - - open(my $lock, "+<$db.lock") or do { - warn "opening nfs lockfile failed: $!"; - return; - }; - - return $lock; -} - sub prune_db { my $self = shift; my $prune_days = shift; - my $db = $self->get_dbm_location(); - my $lock = $self->get_dbm_lock($db) or return; - my $tied = $self->get_dbm_tie($db, $lock) or return; - my $count = keys %$tied; + $self->db->lock; + my $count = $self->db->size; my $pruned = 0; - foreach my $key (keys %$tied) { - my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; + foreach my $key ( $self->db->get_keys ) { + my ($ts, $naughty, $nice, $connects) = split /:/, $self->db->get( $key ); my $days_old = (time - $ts) / 86400; next if $days_old < $prune_days; - delete $tied->{$key}; + $self->db->delete( $key ); $pruned++; } - untie $tied; - close $lock; + $self->db->unlock; warn "pruned $pruned of $count DB entries"; - return $self->cleanup_and_return($tied, $lock); } diff --git a/t/plugin_tests/greylisting b/t/plugin_tests/greylisting index 6d0b0ac..83a2be6 100644 --- a/t/plugin_tests/greylisting +++ b/t/plugin_tests/greylisting @@ -19,7 +19,6 @@ sub register_tests { $self->register_test("test_load_exclude_files"); $self->register_test('test_hook_data'); $self->register_test('test_get_greylist_key'); - $self->register_test('test_get_dbm_location'); $self->register_test('test_exclude'); $self->register_test("test_greylist_geoip"); $self->register_test("test_greylist_p0f_genre"); @@ -130,13 +129,6 @@ sub test_get_greylist_key { cmp_ok( $key, 'eq', "3232235777:$test_email:$test_email", "db key: $key"); } -sub test_get_dbm_location { - my $self = shift; - - my $db = $self->get_dbm_location(); - ok( $db, "db location: $db"); -} - sub test_exclude { my ( $self ) = @_;