blob: 4f30817ffb029d466506a165896b1b3ffba1b5ae [file] [log] [blame]
package Mail::SpamAssassin::DBBasedAddrList;
use strict;
# tell AnyDBM_File to prefer DB_File, if possible.
# BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File SDBM_File); }
# off until 3.0; there's lots of existing AWLs out there this breaks.
use AnyDBM_File;
use Mail::SpamAssassin::PersistentAddrList;
use Fcntl ':DEFAULT',':flock';
use Sys::Hostname;
use vars qw{
@ISA
};
@ISA = qw(Mail::SpamAssassin::PersistentAddrList);
###########################################################################
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = $class->SUPER::new(@_);
$self->{class} = $class;
bless ($self, $class);
$self;
}
###########################################################################
sub new_checker {
my ($factory, $main) = @_;
my $class = $factory->{class};
my $self = {
'main' => $main,
'accum' => { },
'is_locked' => 0,
'lock_file' => '',
'hostname' => hostname,
};
my $path;
if(defined($main->{conf}->{auto_whitelist_path})) # if undef then don't worry -- empty hash!
{
$path = $main->sed_path ($main->{conf}->{auto_whitelist_path});
#NFS Safe Lockng (I hope!)
#Attempt to lock the dbfile, using NFS safe locking
#Locking code adapted from code by Alexis Rosen <alexis@panix.com>
#Kelsey Cummings <kgc@sonic.net>
my $lock_file = $self->{lock_file} = $path.'.lock';
my $lock_tmp = $lock_file . '.' . $self->{hostname} . '.'. $$;
my $max_lock_age = 300; #seconds
my $lock_tries = 30;
open(LTMP, ">$lock_tmp") || die "Cannot create tmp lockfile $lock_file : $!\n";
my $old_fh = select(LTMP);
$|=1;
select($old_fh);
for (my $i = 0; $i < $lock_tries; $i++) #try $lock_tries (seconds) times to get lock
{
dbg("$$ Trying to get lock on $path pass $i");
print LTMP $self->{hostname}.".$$\n"; #updates tmp lockfile to current time
if ( link ($lock_tmp,$lock_file) )
{
$self->{is_locked} = 1;
last;
}
else
{
#link _may_ return false even if the link _is_ created
if ( (stat($lock_tmp))[3] > 1 ) {
$self->{is_locked} = 1;
last;
}
#check to see how old the lockfile is
my $lock_age = (stat($lock_file))[10];
my $now = (stat($lock_tmp))[10];
if ($lock_age < $now - $max_lock_age) {
#we got a stale lock, break it
dbg("$$ Breaking Stale Lockfile!");
unlink "$lock_file";
}
sleep(1);
}
}
# TODO: trap signals to unlock the db file here on SIGINT and SIGTERM
close(LTMP);
unlink($lock_tmp);
if ($self->{is_locked})
{
dbg("Tie-ing to DB file R/W in $path");
tie %{$self->{accum}},"AnyDBM_File",$path, O_RDWR|O_CREAT, #open rw w/lock
(oct ($main->{conf}->{auto_whitelist_file_mode}) & 0666)
or goto failed_to_tie;
}
else
{
dbg("Tie-ing to DB file R/O in $path");
tie %{$self->{accum}},"AnyDBM_File",$path, O_RDONLY, #open ro w/o lock
(oct ($main->{conf}->{auto_whitelist_file_mode}) & 0666)
or goto failed_to_tie;
}
}
bless ($self, $class);
return $self;
failed_to_tie:
unlink($self->{lock_file}) ||
dbg ("Couldn't unlink " . $self->{lock_file} . ": $!\n");
die "Cannot open auto_whitelist_path $path: $!\n";
}
###########################################################################
sub finish {
my $self = shift;
dbg("DB addr list: untie-ing and destroying lockfile.");
untie %{$self->{accum}};
if ($self->{is_locked}) {
dbg ("DB addr list: file locked, breaking lock.");
unlink($self->{lock_file}) ||
dbg ("Couldn't unlink " . $self->{lock_file} . ": $!\n");
}
# TODO: untrap signals to unlock the db file here
}
###########################################################################
sub get_addr_entry {
my ($self, $addr) = @_;
my $entry = {
addr => $addr,
};
$entry->{count} = $self->{accum}->{$addr} || 0;
$entry->{totscore} = $self->{accum}->{$addr.'|totscore'};
# if we had old-style AWL DB, ie no totscore, then just pretend we never saw this address before
if(!defined($entry->{totscore}))
{
$entry->{totscore} = 0;
$entry->{count} = 0;
}
dbg ("auto-whitelist (db-based): $addr scores ".$entry->{count}.'/'.$entry->{totscore});
return $entry;
}
###########################################################################
sub add_score {
my($self, $entry, $score) = @_;
$entry->{count} ||= 0;
$entry->{addr} ||= '';
$entry->{count}++;
$entry->{totscore} += $score;
dbg("add_score: New count: ".$entry->{count}.", new totscore: ".$entry->{totscore});
$self->{accum}->{$entry->{addr}} = $entry->{count};
$self->{accum}->{$entry->{addr}.'|totscore'} = $entry->{totscore};
return $entry;
}
###########################################################################
sub remove_entry {
my ($self, $entry) = @_;
my $addr = $entry->{addr};
delete $self->{accum}->{$addr};
delete $self->{accum}->{$addr.'|totscore'};
# try to delete any per-IP entries for this addr as well.
# could be slow...
my @keys = grep { /^\Q$addr\E\|ip=/ } keys %{$self->{accum}};
foreach my $key (@keys) {
delete $self->{accum}->{$key};
delete $self->{accum}->{$key.'|totscore'};
}
}
###########################################################################
sub dbg { Mail::SpamAssassin::dbg (@_); }
1;