byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #160 from jaredj/abstract-dbm

Browse Source 
Move DBM functions to Qpsmtpd::DB
This commit is contained in:
Matt Simerson 2014-12-01 14:44:41 -08:00
commit df2ef1cb64
8 changed files with 344 additions and 371 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lib/Qpsmtpd/DB.pm Normal file
View File

@ -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;

34
lib/Qpsmtpd/DB/File.pm Normal file
View File

@ -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;

155
lib/Qpsmtpd/DB/File/DBM.pm Normal file
View File

@ -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;

6
lib/Qpsmtpd/Plugin.pm
View File

@ -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;

179
plugins/greylisting
View File

@ -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";
$self->db->lock or return DECLINED;
my $value = $self->db->get($key);
if ( ! $value ) {
# new IP or entry timed out - record new
if (!$tied->{$key}) {
$tied->{$key} = sprintf $fmt, time, 1, 0, 0;
$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 {

157
plugins/karma
View File

@ -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);
}

153
plugins/karma_tool
View File

@ -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);
}

8
t/plugin_tests/greylisting
View File

@ -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 ) = @_;