Move the rest of DBM operations to Qpsmtpd::DB
This commit is contained in:
parent
66ba031240
commit
72c9c79f31
@ -13,11 +13,16 @@ sub file_extension {
|
|||||||
return $self->{file_extension} ||= '.dbm';
|
return $self->{file_extension} ||= '.dbm';
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_lock {
|
sub lock {
|
||||||
my ( $self ) = @_;
|
my ( $self ) = @_;
|
||||||
my $db_file = $self->path;
|
$self->nfs_locking ? $self->nfs_file_lock : $self->file_lock;
|
||||||
return $self->get_nfs_lock if $self->nfs_locking;
|
$self->tie_dbm;
|
||||||
open(my $lock, '>', "$db_file.lock") or do {
|
}
|
||||||
|
|
||||||
|
sub file_lock {
|
||||||
|
my ( $self ) = @_;
|
||||||
|
my $path = $self->path;
|
||||||
|
open(my $lock, '>', "$path.lock") or do {
|
||||||
warn "opening lockfile failed: $!\n";
|
warn "opening lockfile failed: $!\n";
|
||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
@ -27,19 +32,18 @@ sub get_lock {
|
|||||||
close $lock;
|
close $lock;
|
||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
|
$self->{lock} = $lock;
|
||||||
return $lock;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_nfs_lock {
|
sub nfs_file_lock {
|
||||||
my ( $self ) = @_;
|
my ( $self ) = @_;
|
||||||
my $db_file = $self->path;
|
my $path = $self->path;
|
||||||
|
|
||||||
require File::NFSLock;
|
require File::NFSLock;
|
||||||
|
|
||||||
### set up a lock - lasts until object looses scope
|
### set up a lock - lasts until object looses scope
|
||||||
my $nfslock = new File::NFSLock {
|
my $nfslock = new File::NFSLock {
|
||||||
file => "$db_file.lock",
|
file => "$path.lock",
|
||||||
lock_type => LOCK_EX | LOCK_NB,
|
lock_type => LOCK_EX | LOCK_NB,
|
||||||
blocking_timeout => 10, # 10 sec
|
blocking_timeout => 10, # 10 sec
|
||||||
stale_lock_timeout => 30 * 60, # 30 min
|
stale_lock_timeout => 30 * 60, # 30 min
|
||||||
@ -49,12 +53,24 @@ sub get_nfs_lock {
|
|||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
|
|
||||||
open(my $lock, '+<', "$db_file.lock") or do {
|
open(my $lock, '+<', "$path.lock") or do {
|
||||||
warn "opening nfs lockfile failed: $!\n";
|
warn "opening nfs lockfile failed: $!\n";
|
||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
|
|
||||||
return $lock;
|
$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;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub nfs_locking {
|
sub nfs_locking {
|
||||||
@ -63,4 +79,72 @@ sub nfs_locking {
|
|||||||
return $self->{nfs_locking} = shift;
|
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;
|
1;
|
||||||
|
@ -356,30 +356,28 @@ sub greylist {
|
|||||||
return DECLINED if $self->exclude();
|
return DECLINED if $self->exclude();
|
||||||
|
|
||||||
|
|
||||||
my $lock = $self->db->get_lock() or return DECLINED;
|
|
||||||
my $db = $self->db->path;
|
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED;
|
|
||||||
my $key = $self->get_greylist_key($sender, $rcpt) or return DECLINED;
|
my $key = $self->get_greylist_key($sender, $rcpt) or return DECLINED;
|
||||||
|
|
||||||
my $fmt = "%s:%d:%d:%d";
|
my $fmt = "%s:%d:%d:%d";
|
||||||
|
|
||||||
|
my $value = $self->db->get($key);
|
||||||
|
if ( ! $value ) {
|
||||||
# new IP or entry timed out - record new
|
# new IP or entry timed out - record new
|
||||||
if (!$tied->{$key}) {
|
$self->db->set( $key, sprintf $fmt, time, 1, 0, 0 );
|
||||||
$tied->{$key} = sprintf $fmt, time, 1, 0, 0;
|
|
||||||
$self->log(LOGWARN, "fail: initial DENYSOFT, unknown");
|
$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);
|
$self->log(LOGDEBUG, "ts: " . localtime($ts) . ", now: " . localtime);
|
||||||
|
|
||||||
if ($white) {
|
if ($white) {
|
||||||
|
|
||||||
# white IP - accept unless timed out
|
# white IP - accept unless timed out
|
||||||
if (time - $ts < $config->{white_timeout}) {
|
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");
|
$self->log(LOGINFO, "pass: white, $white deliveries");
|
||||||
return $self->cleanup_and_return($tied, $lock, DECLINED);
|
return $self->cleanup_and_return(DECLINED);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$self->log(LOGINFO, "key $key has timed out (white)");
|
$self->log(LOGINFO, "key $key has timed out (white)");
|
||||||
@ -388,28 +386,26 @@ sub greylist {
|
|||||||
|
|
||||||
# Black IP - deny, but don't update timestamp
|
# Black IP - deny, but don't update timestamp
|
||||||
if (time - $ts < $config->{black_timeout}) {
|
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,
|
$self->log(LOGWARN,
|
||||||
"fail: black DENYSOFT - $black deferred connections");
|
"fail: black DENYSOFT - $black deferred connections");
|
||||||
return $self->cleanup_and_return($tied, $lock);
|
return $self->cleanup_and_return();
|
||||||
}
|
}
|
||||||
|
|
||||||
# Grey IP - accept unless timed out
|
# Grey IP - accept unless timed out
|
||||||
elsif (time - $ts < $config->{grey_timeout}) {
|
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");
|
$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)");
|
$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 {
|
sub cleanup_and_return {
|
||||||
my ($self, $tied, $lock, $return_val) = @_;
|
my ($self, $return_val) = @_;
|
||||||
|
|
||||||
untie $tied;
|
|
||||||
close $lock;
|
|
||||||
return $return_val if defined $return_val; # explicit override
|
return $return_val if defined $return_val; # explicit override
|
||||||
return DECLINED
|
return DECLINED
|
||||||
if defined $self->{_args}{reject} && !$self->{_args}{reject};
|
if defined $self->{_args}{reject} && !$self->{_args}{reject};
|
||||||
@ -436,62 +432,45 @@ sub get_greylist_key {
|
|||||||
return join ':', @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 convert_db {
|
sub convert_db {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
my $lock = $self->db->get_lock() or return DECLINED;
|
$self->db->lock;
|
||||||
my $db = $self->db->path();
|
my $count = $self->db->size;
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED;
|
|
||||||
my $count = keys %$tied;
|
|
||||||
|
|
||||||
my $converted = 0;
|
my $converted = 0;
|
||||||
foreach my $key (keys %$tied) {
|
foreach my $key ( $self->db->get_keys ) {
|
||||||
my (@parts) = split /:/, $key;
|
my (@parts) = split /:/, $key;
|
||||||
next if $parts[0] =~ /^[\d]+$/; # already converted
|
next if $parts[0] =~ /^[\d]+$/; # already converted
|
||||||
$converted++;
|
$converted++;
|
||||||
my $nip = Net::IP->new($parts[0]);
|
my $nip = Net::IP->new($parts[0]);
|
||||||
$parts[0] = $nip->intip; # convert IP to integer
|
$parts[0] = $nip->intip; # convert IP to integer
|
||||||
my $new_key = join ':', @parts;
|
my $new_key = join ':', @parts;
|
||||||
$tied->{$new_key} = $tied->{$key};
|
$self->db->set( $new_key, $self->db->get($key) );
|
||||||
delete $tied->{$key};
|
$self->db->delete( $key );
|
||||||
}
|
}
|
||||||
untie $tied;
|
$self->db->unlock;
|
||||||
close $lock;
|
|
||||||
$self->log(LOGINFO, "converted $converted of $count DB entries");
|
$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 {
|
sub prune_db {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
my $lock = $self->db->get_lock() or return DECLINED;
|
$self->db->lock;
|
||||||
my $db = $self->db->path;
|
my $count = $self->db->size;
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return DECLINED;
|
|
||||||
my $count = keys %$tied;
|
|
||||||
|
|
||||||
my $pruned = 0;
|
my $pruned = 0;
|
||||||
foreach my $key (keys %$tied) {
|
foreach my $key ( $self->db->get_keys ) {
|
||||||
my ($ts, $new, $black, $white) = split /:/, $tied->{$key};
|
my ($ts, $new, $black, $white) = split /:/, $self->db->get($key);
|
||||||
my $age = time - $ts;
|
my $age = time - $ts;
|
||||||
next if $age < $self->{_args}{white_timeout};
|
next if $age < $self->{_args}{white_timeout};
|
||||||
$pruned++;
|
$pruned++;
|
||||||
delete $tied->{$key};
|
$self->db->delete($key);
|
||||||
}
|
}
|
||||||
untie $tied;
|
$self->db->unlock;
|
||||||
close $lock;
|
|
||||||
$self->log(LOGINFO, "pruned $pruned of $count DB entries");
|
$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 {
|
sub exclude {
|
||||||
|
Loading…
Reference in New Issue
Block a user