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;