File Coverage

blib/lib/Mail/SpamAssassin/BayesStore.pm

Criterion	Covered	Total	%
statement	39	187	20.8
branch	4	56	7.1
condition	3	32	9.3
subroutine	8	43	18.6
pod	38	39	97.4
total	92	357	25.7

# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at:
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>

=head1 NAME

Mail::SpamAssassin::BayesStore - Storage Module for default Bayes classifier

=head1 DESCRIPTION

This is the public API for the Bayesian store methods.  Any implementation of
the storage module for the default Bayes classifier must implement these methods.

=cut

package Mail::SpamAssassin::BayesStore;

use strict;
use warnings;
# use bytes;
use re 'taint';
use Mail::SpamAssassin::Logger;

# TODO: if we ever get tuits, it'd be good to make these POD
# method docs more perlish... hardly a biggie.

=head1 METHODS

=over 4

=item new

public class (Mail::SpamAssassin::BayesStore) new (Mail::SpamAssassin::Plugin::Bayes $bayes)

Description:
This method creates a new instance of the Mail::SpamAssassin::BayesStore
object.  You must pass in an instance of the Mail::SpamAssassin::Plugin::Bayes
object, which is stashed for use throughout the module.

=cut

sub new {
  my ($class, $bayes) = @_;

  $class = ref($class) || $class;

  my $self = {
	      'bayes'                => $bayes,
	      'supported_db_version' => 0,
	      'db_version'	     => undef,
	     };

  bless ($self, $class);

  $self;
}

=item DB_VERSION

public instance (Integer) DB_VERSION ()

Description:
This method returns the currently supported database version for the
implementation.

=cut

sub DB_VERSION {
  my ($self) = @_;
  return $self->{supported_db_version};
}

=item read_db_configs

public instance () read_db_configs ()

Description:
This method reads any needed config variables from the configuration object
and then calls the Mail::SpamAssassin::Plugin::Bayes read_db_configs method.

=cut

sub read_db_configs {
  my ($self) = @_;

  # TODO: at some stage, this may be useful to read config items which
  # control database bloat, like
  #
  # - use of hapaxes
  # - use of case-sensitivity
  # - more midrange-hapax-avoidance tactics when parsing headers (future)
  #
  # for now, we just set these settings statically.
  my $conf = $self->{bayes}->{main}->{conf};

  # Minimum desired database size?  Expiry will not shrink the
  # database below this number of entries.  100k entries is roughly
  # equivalent to a 5Mb database file.
  $self->{expiry_max_db_size} = $conf->{bayes_expiry_max_db_size};
  $self->{expiry_pct} = $conf->{bayes_expiry_pct};
  $self->{expiry_period} = $conf->{bayes_expiry_period};
  $self->{expiry_max_exponent} = $conf->{bayes_expiry_max_exponent};

  $self->{bayes}->read_db_configs();
}

=item prefork_init

public instance (Boolean) prefork_init ()

Description:
This optional method is called in the parent process shortly before
forking off child processes.

=cut

# sub prefork_init {
#   my ($self) = @_;
# }

=item spamd_child_init

public instance (Boolean) spamd_child_init ()

Description:
This optional method is called in a child process shortly after being spawned.

=cut

# sub spamd_child_init {
#   my ($self) = @_;
# }

=item tie_db_readonly

public instance (Boolean) tie_db_readonly ()

Description:
This method opens up the database in readonly mode.

=cut

sub tie_db_readonly {
  my ($self) = @_;
  die "bayes: tie_db_readonly: not implemented\n";
}

=item tie_db_writable

public instance (Boolean) tie_db_writable ()

Description:
This method opens up the database in writable mode.

Any callers of this methods should ensure that they call untie_db()
afterwards.

=cut

sub tie_db_writable {
  my ($self) = @_;
  die "bayes: tie_db_writable: not implemented\n";
}

=item untie_db

public instance () untie_db ()

Description:
This method unties the database.

=cut

sub untie_db {
  my $self = shift;
  die "bayes: untie_db: not implemented\n";
}

=item calculate_expire_delta

public instance (%) calculate_expire_delta (Integer $newest_atime,
                                             Integer $start,
                                             Integer $max_expire_mult)

Description:
This method performs a calculation on the data to determine the optimum
atime for token expiration.

=cut

sub calculate_expire_delta {
  my ($self, $newest_atime, $start, $max_expire_mult) = @_;
  die "bayes: calculate_expire_delta: not implemented\n";
}

=item token_expiration

public instance (Integer, Integer,
                 Integer, Integer) token_expiration(\% $opts,
                                                    Integer $newest_atime,
                                                    Integer $newdelta)

Description:
This method performs the database specific expiration of tokens based on
the passed in C<$newest_atime> and C<$newdelta>.

=cut

sub token_expiration {
  my ($self, $opts, $newest_atime, $newdelta) = @_;
  die "bayes: token_expiration: not implemented\n";
}

=item expire_old_tokens

public instance (Boolean) expire_old_tokens (\% hashref)

Description:
This method expires old tokens from the database.

=cut

sub expire_old_tokens {
  my ($self, $opts) = @_;
  my $ret;

  my $eval_stat;
  eval {
    local $SIG{'__DIE__'};	# do not run user die() traps in here
    if ($self->tie_db_writable()) {
      $ret = $self->expire_old_tokens_trapped ($opts);
    }
    1;
  } or do {
    $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
  };

  if (!$self->{bayes}->{main}->{learn_caller_will_untie}) {
    $self->untie_db();
  }

  if (defined $eval_stat) {	# if we died, untie the dbs.
    warn "bayes: expire_old_tokens: $eval_stat\n";
    return 0;
  }
  $ret;
}

=item expire_old_tokens_trapped

public instance (Boolean) expire_old_tokens_trapped (\% $opts)

Description:
This methods does the actual token expiration.

XXX More docs here about the methodology and what not

=cut

sub expire_old_tokens_trapped {
  my ($self, $opts) = @_;

  # Flag that we're doing work
  $self->set_running_expire_tok();

  # We don't need to do an expire, so why were we called?  Oh well.
  if (!$self->expiry_due()) {
    $self->remove_running_expire_tok();
    return 0;
  }

  my $started = time();
  my @vars = $self->get_storage_variables();

  if ( $vars[10] > time ) {
    dbg("bayes: expiry found newest atime in the future, resetting to current time");
    $vars[10] = time;
  }

  # How many tokens do we want to keep?
  my $goal_reduction = int($self->{expiry_max_db_size} * $self->{expiry_pct});
  dbg("bayes: expiry check keep size, ".$self->{expiry_pct}." * max: $goal_reduction");
  # Make sure we keep at least 100000 tokens in the DB
  if ( $goal_reduction < 100000 ) {
    $goal_reduction = 100000;
    dbg("bayes: expiry keep size too small, resetting to 100,000 tokens");
  }
  # Now turn goal_reduction into how many to expire.
  $goal_reduction = $vars[3] - $goal_reduction;
  dbg("bayes: token count: ".$vars[3].", final goal reduction size: $goal_reduction");

  if ( $goal_reduction < 1000 ) { # too few tokens to expire, abort.
    dbg("bayes: reduction goal of $goal_reduction is under 1,000 tokens, skipping expire");
    $self->set_last_expire(time());
    $self->remove_running_expire_tok(); # this won't be cleaned up, so do it now.
    return 1; # we want to indicate things ran as expected
  }

  # Estimate new atime delta based on the last atime delta
  my $newdelta = 0;
  if ( $vars[9] > 0 ) {
    # newdelta = olddelta * old / goal;
    # this may seem backwards, but since we're talking delta here,
    # not actual atime, we want smaller atimes to expire more tokens,
    # and visa versa.
    #
    $newdelta = int($vars[8] * $vars[9] / $goal_reduction);
  }

  # Calculate size difference between last expiration token removal
  # count and the current goal removal count.
  my $ratio = ($vars[9] == 0 || $vars[9] > $goal_reduction) ? $vars[9]/$goal_reduction : $goal_reduction/$vars[9];

  dbg("bayes: first pass?  current: ".time().", Last: ".$vars[4].", atime: ".$vars[8].", count: ".$vars[9].", newdelta: $newdelta, ratio: $ratio, period: ".$self->{expiry_period});

  ## ESTIMATION PHASE
  #
  # Do this for the first expire or "odd" looking results cause a first pass to determine atime:
  #
  # - last expire was more than 30 days ago
  #   assume mail flow stays roughly the same month to month, recompute if it's > 1 month
  # - last atime delta was under expiry period
  #   if we're expiring often max_db_size should go up, but let's recompute just to check
  # - last reduction count was < 1000 tokens
  #   ditto
  # - new estimated atime delta is under expiry period
  #   ditto
  # - difference of last reduction to current goal reduction is > 50%
  #   if the two values are out of balance, estimating atime is going to be funky, recompute
  #
  if ( (time() - $vars[4] > 86400*30) || ($vars[8] < $self->{expiry_period}) || ($vars[9] < 1000)
       || ($newdelta < $self->{expiry_period}) || ($ratio > 1.5) ) {
    dbg("bayes: can't use estimation method for expiry, unexpected result, calculating optimal atime delta (first pass)");

    my $start = $self->{expiry_period}; # exponential search starting at ...?  1/2 day, 1, 2, 4, 8, 16, ...
    my $max_expire_mult = 2**$self->{expiry_max_exponent}; # $max_expire_mult * $start = max expire time (256 days), power of 2.

    dbg("bayes: expiry max exponent: ".$self->{expiry_max_exponent});

    my %delta = $self->calculate_expire_delta($vars[10], $start, $max_expire_mult);

    return 0 unless (%delta);

    # This will skip the for loop if debugging isn't enabled ...
    if (would_log('dbg', 'bayes')) {
      dbg("bayes: atime\ttoken reduction");
      dbg("bayes: ========\t===============");
      for(my $i = 1; $i<=$max_expire_mult; $i <<= 1) {
	dbg("bayes: ".$start*$i."\t".(exists $delta{$i} ? $delta{$i} : 0));
      }
    }

    # Now figure out which max_expire_mult value gives the closest results to goal_reduction, without
    # going over ...  Go from the largest delta backwards so the reduction size increases
    # (tokens that expire at 4 also expire at 3, 2, and 1, so 1 will always be the largest expiry...)
    #
    for( ; $max_expire_mult > 0; $max_expire_mult>>=1 ) {
      next unless exists $delta{$max_expire_mult};
      if ($delta{$max_expire_mult} > $goal_reduction) {
        $max_expire_mult<<=1; # the max expire is actually the next power of 2 out
        last;
      }
    }

    # if max_expire_mult gets to 0, either we can't expire anything, or 1 is <= $goal_reduction
    $max_expire_mult ||= 1;

    # $max_expire_mult is now equal to the value we should use ...
    # Check to see if the atime value we found is really good.
    # It's not good if:
    # - $max_expire_mult would not expire any tokens.  This means that the majority of
    #   tokens are old or new, and more activity is required before an expiry can occur.
    # - reduction count < 1000, not enough tokens to be worth doing an expire.
    #
    if ( !exists $delta{$max_expire_mult} || $delta{$max_expire_mult} < 1000 ) {
      dbg("bayes: couldn't find a good delta atime, need more token difference, skipping expire");
      $self->set_last_expire(time());
      $self->remove_running_expire_tok(); # this won't be cleaned up, so do it now.
      return 1; # we want to indicate things ran as expected
    }

    $newdelta = $start * $max_expire_mult;
    dbg("bayes: first pass decided on $newdelta for atime delta");
  }
  else { # use the estimation method
    dbg("bayes: can do estimation method for expiry, skipping first pass");
  }

  my ($kept, $deleted, $num_hapaxes, $num_lowfreq) = $self->token_expiration($opts, $newdelta, @vars);

  my $done = time();

  my $msg = "expired old bayes database entries in ".($done - $started)." seconds";
  my $msg2 = "$kept entries kept, $deleted deleted";

  if ($opts->{verbose}) {
    my $hapax_pc = ($num_hapaxes * 100) / $kept;
    my $lowfreq_pc = ($num_lowfreq * 100) / $kept;
    print "$msg\n$msg2\n"  or die "Error writing: $!";
    printf "token frequency: 1-occurrence tokens: %3.2f%%\n", $hapax_pc
      or die "Error writing: $!";
    printf "token frequency: less than 8 occurrences: %3.2f%%\n", $lowfreq_pc
      or die "Error writing: $!";
  }
  else {
    dbg("bayes: $msg: $msg2");
  }

  $self->remove_running_expire_tok();
  return 1;
}

=item sync_due

public instance (Boolean) sync_due ()

Description:
This methods determines if a sync is due.

=cut

sub sync_due {
  my ($self) = @_;
  die "bayes: sync_due: not implemented\n";
}

=item expiry_due

public instance (Boolean) expiry_due ()

Description:
This methods determines if an expire is due.

=cut

sub expiry_due {
  my ($self) = @_;

  $self->read_db_configs();	# make sure this has happened here

  # If force expire was called, do the expire no matter what.
  return 1 if ($self->{bayes}->{main}->{learn_force_expire});

  # if config says not to auto expire then no need to continue
  return 0 if ($self->{bayes}->{main}->{conf}->{bayes_auto_expire} == 0);

  # is the database too small for expiry?  (Do *not* use "scalar keys",
  # as this will iterate through the entire db counting them!)
  my @vars = $self->get_storage_variables();
  my $ntoks = $vars[3];

  my $last_expire = time() - $vars[4];
  if (!$self->{bayes}->{main}->{ignore_safety_expire_timeout}) {
    # if we're not ignoring the safety timeout, don't run an expire more
    # than once every 12 hours.
    return 0 if ($last_expire < 43200);
  }
  else {
    # if we are ignoring the safety timeout (e.g.: mass-check), still
    # limit the expiry to only one every 5 minutes.
    return 0 if ($last_expire < 300);
  }

  dbg("bayes: DB expiry: tokens in DB: $ntoks, Expiry max size: ".$self->{expiry_max_db_size}.", Oldest atime: ".$vars[5].", Newest atime: ".$vars[10].", Last expire: ".$vars[4].", Current time: ".time());

  my $conf = $self->{bayes}->{main}->{conf};
  if ($ntoks <= 100000 ||			# keep at least 100k tokens
      $self->{expiry_max_db_size} > $ntoks ||	# not enough tokens to cause an expire
      $vars[10]-$vars[5] < 43200 ||		# delta between oldest and newest < 12h
      $self->{db_version} < $self->DB_VERSION # ignore old db formats
      ) {
    return 0;
  }

  return 1;
}

=item seen_get

public instance (Char) seen_get (String $msgid)

Description:
This method retrieves the stored value, if any, for C<$msgid>.  The return
value is the stored string ('s' for spam and 'h' for ham) or undef if
C<$msgid> is not found.

=cut

sub seen_get {
  my ($self, $msgid) = @_;
  die "bayes: seen_get: not implemented\n";
}

=item seen_put

public instance (Boolean) seen_put (String $msgid, Char $flag)

Description:
This method records C<$msgid> as the type given by C<$flag>.  C<$flag> is
one of two values 's' for spam and 'h' for ham.

=cut

sub seen_put {
  my ($self, $msgid, $flag) = @_;
  die "bayes: seen_put: not implemented\n";
}

=item seen_delete

public instance (Boolean) seen_delete (String $msgid)

Description:
This method removes C<$msgid> from storage.

=cut

sub seen_delete {
  my ($self, $msgid) = @_;
  die "bayes: seen_delete: not implemented\n";
}

=item get_storage_variables

public instance (@) get_storage_variables ()

Description:
This method retrieves the various administrative variables used by
the Bayes storage implementation.

The values returned in the array are in the following order:

0: scan count base

1: number of spam

2: number of ham

3: number of tokens in db

4: last expire atime

5: oldest token in db atime

6: db version value

7: last journal sync

8: last atime delta

9: last expire reduction count

10: newest token in db atime

=cut

sub get_storage_variables {
  my ($self) = @_;
  die "bayes: get_storage_variables: not implemented\n";
}

=item dump_db_toks

public instance () dump_db_toks (String $template, String $regex, @ @vars)

Description:
This method loops over all tokens, computing the probability for the token
and then printing it out according to the passed in template.

=cut

sub dump_db_toks {
  my ($self, $template, $regex, @vars) = @_;
  die "bayes: dump_db_toks: not implemented\n";
}

=item set_last_expire

public instance (Boolean) _set_last_expire (Integer $time)

Description:
This method sets the last expire time.

=cut

sub set_last_expire {
  my ($self, $time) = @_;
  die "bayes: set_last_expire: not implemented\n";
}

=item get_running_expire_tok

public instance (Time) get_running_expire_tok ()

Description:
This method determines if an expire is currently running and returns the time
the expire started.

=cut

sub get_running_expire_tok {
  my ($self) = @_;
  die "bayes: get_running_expire_tok: not implemented\n";
}

=item set_running_expire_tok

public instance (Time) set_running_expire_tok ()

Description:
This method sets the running expire time to the current time.

=cut

sub set_running_expire_tok {
  my ($self) = @_;
  die "bayes: set_running_expire_tok: not implemented\n";
}

=item remove_running_expire_tok

public instance (Boolean) remove_running_expire_tok ()

Description:
This method removes a currently set running expire time.

=cut

sub remove_running_expire_tok {
  my ($self) = @_;
  die "bayes: remove_running_expire_tok: not implemented\n";
}

=item tok_get

public instance (Integer, Integer, Time) tok_get (String $token)

Description:
This method retrieves the specified token (C<$token>) from storage and returns
it's spam count, ham acount and last access time.

=cut

sub tok_get {
  my ($self, $token) = @_;
  die "bayes: tok_get: not implemented\n";
}

=item tok_get_all

public instance (\@) tok_get_all (@ @tokens)

Description:
This method retrieves the specified tokens (C<@tokens>) from storage and
returns an array ref of arrays spam count, ham count and last access time.

=cut

sub tok_get_all {
  my ($self, $tokens) = @_;
  die "bayes: tok_get_all: not implemented\n";
}

=item tok_count_change

public instance (Boolean) tok_count_change (Integer $spam_count,
                                            Integer $ham_count,
                                            String $token,
                                            Time $atime)

Description:
This method takes a C<$spam_count> and C<$ham_count> and adds it to
C<$token> along with updating C<$token>s atime with C<$atime>.

=cut

sub tok_count_change {
  my ($self, $spam_count, $ham_count, $token, $atime) = @_;
  die "bayes: tok_count_change: not implemented\n";
}

=item multi_tok_count_change

public instance (Boolean) multi_tok_count_change (Integer $spam_count,
 					          Integer $ham_count,
				 	          \% $tokens,
					          String $atime)

Description:
This method takes a C<$spam_count> and C<$ham_count> and adds it to all
of the tokens in the C<$tokens> hash ref along with updating each tokens
atime with C<$atime>.

=cut

sub multi_tok_count_change {
  my ($self, $spam_count, $ham_count, $tokens, $atime) = @_;
  die "bayes: multi_tok_count_change: not implemented\n";
}

=item nspam_nham_get

public instance (Integer, Integer) nspam_nham_get ()

Description:
This method retrieves the total number of spam and the total number of ham
currently under storage.

=cut

sub nspam_nham_get {
  my ($self) = @_;
  die "bayes: nspam_nham_get: not implemented\n";
}

=item nspam_nham_change

public instance (Boolean) nspam_nham_change (Integer $num_spam,
                                             Integer $num_ham)

Description:
This method updates the number of spam and the number of ham in the database.

=cut

sub nspam_nham_change {
  my ($self, $num_spam, $num_ham) = @_;
  die "bayes: nspam_nham_change: not implemented\n";
}

=item tok_touch

public instance (Boolean) tok_touch (String $token,
                                     Time $atime)

Description:
This method updates the given tokens (C<$token>) access time.

=cut

sub tok_touch {
  my ($self, $token, $atime) = @_;
  die "bayes: tok_touch: not implemented\n";
}

=item tok_touch_all

public instance (Boolean) tok_touch_all (\@ $tokens,
                                         Time $atime)

Description:
This method does a mass update of the given list of tokens C<$tokens>, if the existing token
atime is < C<$atime>.

=cut

sub tok_touch_all {
  my ($self, $tokens, $atime) = @_;
  die "bayes: tok_touch_all: not implemented\n";
}

=item cleanup

public instance (Boolean) cleanup ()

Description:
This method performs any cleanup necessary before moving onto the next
operation.

=cut

sub cleanup {
  my ($self) = @_;
  die "bayes: cleanup: not implemented\n";
}

=item get_magic_re

public instance get_magic_re (String)

Description:
This method returns a regexp which indicates a magic token.

=cut

sub get_magic_re {
  my ($self) = @_;
  die "bayes: get_magic_re: not implemented\n";
}

=item sync

public instance (Boolean) sync (\% $opts)

Description:
This method performs a sync of the database.

=cut

sub sync {
  my ($self, $opts) = @_;
  die "bayes: sync: not implemented\n";
}

=item perform_upgrade

public instance (Boolean) perform_upgrade (\% $opts)

Description:
This method is a utility method that performs any necessary upgrades
between versions.  It should know how to handle previous versions and
what needs to happen to upgrade them.

A true return value indicates success.

=cut

sub perform_upgrade {
  my ($self, $opts) = @_;
  die "bayes: perform_upgrade: not implemented\n";
}

=item clear_database

public instance (Boolean) clear_database ()

Description:
This method deletes all records for a particular user.

Callers should be aware that any errors returned by this method
could causes the database to be inconsistent for the given user.

=cut

sub clear_database {
  my ($self) = @_;
  die "bayes: clear_database: not implemented\n";
}

=item backup_database

public instance (Boolean) backup_database ()

Description:
This method will dump the users database in a machine readable format.

=cut

sub backup_database {
  my ($self) = @_;
  die "bayes: backup_database: not implemented\n";
}

=item restore_database

public instance (Boolean) restore_database (String $filename, Boolean $showdots)

Description:
This method restores a database from the given filename, C<$filename>.

Callers should be aware that any errors returned by this method
could causes the database to be inconsistent for the given user.

=cut

sub restore_database {
  my ($self, $filename, $showdots) = @_;
  die "bayes: restore_database: not implemented\n";
}

=item db_readable

public instance (Boolean) db_readable ()

Description:
This method returns whether or not the Bayes DB is available in a
readable state.

=cut

sub db_readable {
  my ($self) = @_;
  die "bayes: db_readable: not implemented\n";
}

=item db_writable

public instance (Boolean) db_writable ()

Description:
This method returns whether or not the Bayes DB is available in a
writable state.

=cut

sub db_writable {
  my ($self) = @_;
  die "bayes: db_writable: not implemented\n";
}


sub sa_die { Mail::SpamAssassin::sa_die(@_); }

1;

=back

=cut