You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@spamassassin.apache.org by jm...@apache.org on 2008/01/18 11:28:41 UTC
svn commit: r613124 [1/2] - in /spamassassin/trunk: lib/Mail/
lib/Mail/SpamAssassin/ lib/Mail/SpamAssassin/BayesStore/
lib/Mail/SpamAssassin/Plugin/ masses/bayes-testing/ rules/ t/
Author: jm
Date: Fri Jan 18 02:28:38 2008
New Revision: 613124
URL: http://svn.apache.org/viewvc?rev=613124&view=rev
Log:
bug 5923: pluginize the Bayes subsystem, allowing replacement of our probabilistic classifier with alternative learning plugins. Merged from the bug-5293-pluginized-bayes branch
Modified:
spamassassin/trunk/lib/Mail/SpamAssassin.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Bayes.pm
spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm
spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm
spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgLearner.pm
spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/WLBLEval.pm
spamassassin/trunk/masses/bayes-testing/bayes-10pcv-driver
spamassassin/trunk/rules/23_bayes.cf
spamassassin/trunk/t/bayesdbm.t
spamassassin/trunk/t/bayesdbm_flock.t
spamassassin/trunk/t/bayessdbm.t
spamassassin/trunk/t/bayessdbm_seen_delete.t
spamassassin/trunk/t/bayessql.t
Modified: spamassassin/trunk/lib/Mail/SpamAssassin.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin.pm Fri Jan 18 02:28:38 2008
@@ -671,7 +671,7 @@
sub finish_learner {
my $self = shift;
- $self->{bayes_scanner}->sanity_check_is_untied(1) if $self->{bayes_scanner};
+ $self->{bayes_scanner}->force_close(1) if $self->{bayes_scanner};
1;
}
@@ -1325,7 +1325,7 @@
}
# make sure things are ready for scanning
- $self->{bayes_scanner}->sanity_check_is_untied() if $self->{bayes_scanner};
+ $self->{bayes_scanner}->force_close() if $self->{bayes_scanner};
$self->call_plugins("compile_now_finish",
{ use_user_prefs => $use_user_prefs,
keep_userstate => $deal_with_userstate});
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Bayes.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Bayes.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Bayes.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Bayes.pm Fri Jan 18 02:28:38 2008
@@ -17,30 +17,16 @@
=head1 NAME
-Mail::SpamAssassin::Bayes - determine spammishness using a Bayesian classifier
+Mail::SpamAssassin::Bayes - support for learning classifiers
=head1 DESCRIPTION
-This is a Bayesian-like form of probability-analysis classification, using an
-algorithm based on the one detailed in Paul Graham's I<A Plan For Spam> paper
-at:
+This is the general class used to train a learning classifier with new samples
+of spam and ham mail, and classify based on prior training.
- http://www.paulgraham.com/spam.html
-
-It also incorporates some other aspects taken from Graham Robinson's webpage
-on the subject at:
-
- http://radio.weblogs.com/0101454/stories/2002/09/16/spamDetection.html
-
-And the chi-square probability combiner as described here:
-
- http://www.linuxjournal.com/print.php?sid=6467
-
-The results are incorporated into SpamAssassin as the BAYES_* rules.
-
-=head1 METHODS
-
-=over 4
+Prior to version 3.3.0, the default Bayes implementation was here; if you're
+looking for information on that, it has moved to
+C<Mail::SpamAssassin::Plugin::Bayes>.
=cut
@@ -56,171 +42,7 @@
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Util qw(untaint_var);
-# pick ONLY ONE of these combining implementations.
-use Mail::SpamAssassin::Bayes::CombineChi;
-# use Mail::SpamAssassin::Bayes::CombineNaiveBayes;
-
-use Digest::SHA1 qw(sha1 sha1_hex);
-
-use vars qw{
- @ISA
- $IGNORED_HDRS
- $MARK_PRESENCE_ONLY_HDRS
- %HEADER_NAME_COMPRESSION
- $OPPORTUNISTIC_LOCK_VALID
-};
-
-@ISA = qw();
-
-# Which headers should we scan for tokens? Don't use all of them, as it's easy
-# to pick up spurious clues from some. What we now do is use all of them
-# *less* these well-known headers; that way we can pick up spammers' tracking
-# headers (which are obviously not well-known in advance!).
-
-# Received is handled specially
-$IGNORED_HDRS = qr{(?: (?:X-)?Sender # misc noise
- |Delivered-To |Delivery-Date
- |(?:X-)?Envelope-To
- |X-MIME-Auto[Cc]onverted |X-Converted-To-Plain-Text
-
- |Subject # not worth a tiny gain vs. to db size increase
-
- # Date: can provide invalid cues if your spam corpus is
- # older/newer than ham
- |Date
-
- # List headers: ignore. a spamfiltering mailing list will
- # become a nonspam sign.
- |X-List|(?:X-)?Mailing-List
- |(?:X-)?List-(?:Archive|Help|Id|Owner|Post|Subscribe
- |Unsubscribe|Host|Id|Manager|Admin|Comment
- |Name|Url)
- |X-Unsub(?:scribe)?
- |X-Mailman-Version |X-Been[Tt]here |X-Loop
- |Mail-Followup-To
- |X-eGroups-(?:Return|From)
- |X-MDMailing-List
- |X-XEmacs-List
-
- # gatewayed through mailing list (thanks to Allen Smith)
- |(?:X-)?Resent-(?:From|To|Date)
- |(?:X-)?Original-(?:From|To|Date)
-
- # Spamfilter/virus-scanner headers: too easy to chain from
- # these
- |X-MailScanner(?:-SpamCheck)?
- |X-Spam(?:-(?:Status|Level|Flag|Report|Hits|Score|Checker-Version))?
- |X-Antispam |X-RBL-Warning |X-Mailscanner
- |X-MDaemon-Deliver-To |X-Virus-Scanned
- |X-Mass-Check-Id
- |X-Pyzor |X-DCC-\S{2,25}-Metrics
- |X-Filtered-B[Yy] |X-Scanned-By |X-Scanner
- |X-AP-Spam-(?:Score|Status) |X-RIPE-Spam-Status
- |X-SpamCop-[^:]+
- |X-SMTPD |(?:X-)?Spam-Apparently-To
- |SPAM |X-Perlmx-Spam
- |X-Bogosity
-
- # some noisy Outlook headers that add no good clues:
- |Content-Class |Thread-(?:Index|Topic)
- |X-Original[Aa]rrival[Tt]ime
-
- # Annotations from IMAP, POP, and MH:
- |(?:X-)?Status |X-Flags |Replied |Forwarded
- |Lines |Content-Length
- |X-UIDL? |X-IMAPbase
-
- # Annotations from Bugzilla
- |X-Bugzilla-[^:]+
-
- # Annotations from VM: (thanks to Allen Smith)
- |X-VM-(?:Bookmark|(?:POP|IMAP)-Retrieved|Labels|Last-Modified
- |Summary-Format|VHeader|v\d-Data|Message-Order)
-
- # Annotations from Gnus:
- | X-Gnus-Mail-Source
- | Xref
-
-)}x;
-
-# Note only the presence of these headers, in order to reduce the
-# hapaxen they generate.
-$MARK_PRESENCE_ONLY_HDRS = qr{(?: X-Face
- |X-(?:Gnu-?PG|PGP|GPG)(?:-Key)?-Fingerprint
-)}ix;
-
-# tweaks tested as of Nov 18 2002 by jm: see SpamAssassin-devel list archives
-# for results. The winners are now the default settings.
-use constant IGNORE_TITLE_CASE => 1;
-use constant TOKENIZE_LONG_8BIT_SEQS_AS_TUPLES => 1;
-use constant TOKENIZE_LONG_TOKENS_AS_SKIPS => 1;
-
-# tweaks of May 12 2003, see SpamAssassin-devel archives again.
-use constant PRE_CHEW_ADDR_HEADERS => 1;
-use constant CHEW_BODY_URIS => 1;
-use constant CHEW_BODY_MAILADDRS => 1;
-use constant HDRS_TOKENIZE_LONG_TOKENS_AS_SKIPS => 1;
-use constant BODY_TOKENIZE_LONG_TOKENS_AS_SKIPS => 1;
-use constant URIS_TOKENIZE_LONG_TOKENS_AS_SKIPS => 0;
-use constant IGNORE_MSGID_TOKENS => 0;
-
-# tweaks of 12 March 2004, see bug 2129.
-use constant DECOMPOSE_BODY_TOKENS => 1;
-use constant MAP_HEADERS_MID => 1;
-use constant MAP_HEADERS_FROMTOCC => 1;
-use constant MAP_HEADERS_USERAGENT => 1;
-
-# tweaks, see http://issues.apache.org/SpamAssassin/show_bug.cgi?id=3173#c26
-use constant ADD_INVIZ_TOKENS_I_PREFIX => 1;
-use constant ADD_INVIZ_TOKENS_NO_PREFIX => 0;
-
-# We store header-mined tokens in the db with a "HHeaderName:val" format.
-# some headers may contain lots of gibberish tokens, so allow a little basic
-# compression by mapping the header name at least here. these are the headers
-# which appear with the most frequency in my db. note: this doesn't have to
-# be 2-way (ie. LHSes that map to the same RHS are not a problem), but mixing
-# tokens from multiple different headers may impact accuracy, so might as well
-# avoid this if possible. These are the top ones from my corpus, BTW (jm).
-%HEADER_NAME_COMPRESSION = (
- 'Message-Id' => '*m',
- 'Message-ID' => '*M',
- 'Received' => '*r',
- 'User-Agent' => '*u',
- 'References' => '*f',
- 'In-Reply-To' => '*i',
- 'From' => '*F',
- 'Reply-To' => '*R',
- 'Return-Path' => '*p',
- 'Return-path' => '*rp',
- 'X-Mailer' => '*x',
- 'X-Authentication-Warning' => '*a',
- 'Organization' => '*o',
- 'Organisation' => '*o',
- 'Content-Type' => '*c',
- 'X-Spam-Relays-Trusted' => '*RT',
- 'X-Spam-Relays-Untrusted' => '*RU',
-);
-
-# How many seconds should the opportunistic_expire lock be valid?
-$OPPORTUNISTIC_LOCK_VALID = 300;
-
-# Should we use the Robinson f(w) equation from
-# http://radio.weblogs.com/0101454/stories/2002/09/16/spamDetection.html ?
-# It gives better results, in that scores are more likely to distribute
-# into the <0.5 range for nonspam and >0.5 for spam.
-use constant USE_ROBINSON_FX_EQUATION_FOR_LOW_FREQS => 1;
-
-# How many of the most significant tokens should we use for the p(w)
-# calculation?
-use constant N_SIGNIFICANT_TOKENS => 150;
-
-# How many significant tokens are required for a classifier score to
-# be considered usable?
-use constant REQUIRE_SIGNIFICANT_TOKENS_TO_SCORE => -1;
-
-# How long a token should we hold onto? (note: German speakers typically
-# will require a longer token than English ones.)
-use constant MAX_TOKEN_LENGTH => 15;
+our @ISA = qw();
###########################################################################
@@ -232,434 +54,33 @@
my $self = {
'main' => $main,
'conf' => $main->{conf},
- ## 'log_raw_counts' => 0, # see compute_prob_for_token()
'use_ignores' => 1,
};
bless ($self, $class);
- if ($self->{conf}->{bayes_store_module}) {
- my $module = $self->{conf}->{bayes_store_module};
- $module = untaint_var($module); # good enough?
- my $store;
-
- eval '
- require '.$module.';
- $store = '.$module.'->new($self);
- 1;
- ' or do {
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- die "bayes: (in new) $eval_stat\n";
- };
- $self->{store} = $store;
- }
- else {
- require Mail::SpamAssassin::BayesStore::DBM;
- $self->{store} = Mail::SpamAssassin::BayesStore::DBM->new($self);
- }
-
+ $self->{main}->call_plugins("learner_new");
$self;
}
+###########################################################################
+
sub finish {
my $self = shift;
- #if (!$self->{conf}->{use_bayes}) { return; }
-
- # if we're untying too much, uncomment this...
- # use Carp qw(cluck); cluck "stack trace at untie";
-
- $self->{store}->untie_db();
+ # we don't need to do the plugin; Mail::SpamAssassin::finish() does
+ # that for us
%{$self} = ();
}
-sub sa_die { Mail::SpamAssassin::sa_die(@_); }
-
###########################################################################
-sub sanity_check_is_untied {
+# force the Bayes dbs to be closed, if they haven't already been; called
+# at the end of scan operation, or when switching between user IDs,
+# or when C<Mail::SpamAssassin::finish_learner()> is called.
+#
+sub force_close {
my $self = shift;
my $quiet = shift;
-
- # do a sanity check here. Wierd things happen if we remain tied
- # after compiling; for example, spamd will never see that the
- # number of messages has reached the bayes-scanning threshold.
- if ($self->{store}->db_readable()) {
- warn "bayes: oops! still tied to bayes DBs, untying\n" unless $quiet;
- $self->{store}->untie_db();
- }
-}
-
-###########################################################################
-
-# read configuration items to control bayes behaviour. Called by
-# BayesStore::read_db_configs().
-sub read_db_configs {
- my ($self) = @_;
-
- # use of hapaxes. Set on bayes object, since it controls prob
- # computation.
- $self->{use_hapaxes} = $self->{conf}->{bayes_use_hapaxes};
-}
-
-###########################################################################
-
-# The calling functions expect a uniq'ed array of tokens ...
-sub tokenize {
- my ($self, $msg, $msgdata) = @_;
-
- # the body
- my @tokens = map { $self->tokenize_line ($_, '', 1) }
- @{$msgdata->{bayes_token_body}};
-
- # the URI list
- push (@tokens, map { $self->tokenize_line ($_, '', 2) }
- @{$msgdata->{bayes_token_uris}});
-
- # add invisible tokens
- if (ADD_INVIZ_TOKENS_I_PREFIX) {
- push (@tokens, map { $self->tokenize_line ($_, "I*:", 1) }
- @{$msgdata->{bayes_token_inviz}});
- }
- if (ADD_INVIZ_TOKENS_NO_PREFIX) {
- push (@tokens, map { $self->tokenize_line ($_, "", 1) }
- @{$msgdata->{bayes_token_inviz}});
- }
-
- # Tokenize the headers
- my %hdrs = $self->tokenize_headers ($msg);
- while( my($prefix, $value) = each %hdrs ) {
- push(@tokens, $self->tokenize_line ($value, "H$prefix:", 0));
- }
-
- # Go ahead and uniq the array, skip null tokens (can happen sometimes)
- # generate an SHA1 hash and take the lower 40 bits as our token
- my %tokens;
- foreach my $token (@tokens) {
- next unless length($token); # skip 0 length tokens
- $tokens{substr(sha1($token), -5)} = $token;
- }
-
- # return the keys == tokens ...
- return \%tokens;
-}
-
-sub tokenize_line {
- my $self = $_[0];
- my $tokprefix = $_[2];
- my $region = $_[3];
- local ($_) = $_[1];
-
- my @rettokens;
-
- # include quotes, .'s and -'s for URIs, and [$,]'s for Nigerian-scam strings,
- # and ISO-8859-15 alphas. Do not split on @'s; better results keeping it.
- # Some useful tokens: "$31,000,000" "www.clock-speed.net" "f*ck" "Hits!"
- tr/-A-Za-z0-9,\@\*\!_'"\$.\241-\377 / /cs;
-
- # DO split on "..." or "--" or "---"; common formatting error resulting in
- # hapaxes. Keep the separator itself as a token, though, as long ones can
- # be good spamsigns.
- s/(\w)(\.{3,6})(\w)/$1 $2 $3/gs;
- s/(\w)(\-{2,6})(\w)/$1 $2 $3/gs;
-
- if (IGNORE_TITLE_CASE) {
- if ($region == 1 || $region == 2) {
- # lower-case Title Case at start of a full-stop-delimited line (as would
- # be seen in a Western language).
- s/(?:^|\.\s+)([A-Z])([^A-Z]+)(?:\s|$)/ ' '. (lc $1) . $2 . ' ' /ge;
- }
- }
-
- my $magic_re = $self->{store}->get_magic_re();
-
- foreach my $token (split) {
- $token =~ s/^[-'"\.,]+//; # trim non-alphanum chars at start or end
- $token =~ s/[-'"\.,]+$//; # so we don't get loads of '"foo' tokens
-
- # Skip false magic tokens
- # TVD: we need to do a defined() check since SQL doesn't have magic
- # tokens, so the SQL BayesStore returns undef. I really want a way
- # of optimizing that out, but I haven't come up with anything yet.
- #
- next if ( defined $magic_re && $token =~ /$magic_re/ );
-
- # *do* keep 3-byte tokens; there's some solid signs in there
- my $len = length($token);
-
- # but extend the stop-list. These are squarely in the gray
- # area, and it just slows us down to record them.
- # See http://wiki.apache.org/spamassassin/BayesStopList for more info.
- #
- next if $len < 3 ||
- ($token =~ /^(?:a(?:ble|l(?:ready|l)|n[dy]|re)|b(?:ecause|oth)|c(?:an|ome)|e(?:ach|mail|ven)|f(?:ew|irst|or|rom)|give|h(?:a(?:ve|s)|ttp)|i(?:n(?:formation|to)|t\'s)|just|know|l(?:ike|o(?:ng|ok))|m(?:a(?:de|il(?:(?:ing|to))?|ke|ny)|o(?:re|st)|uch)|n(?:eed|o[tw]|umber)|o(?:ff|n(?:ly|e)|ut|wn)|p(?:eople|lace)|right|s(?:ame|ee|uch)|t(?:h(?:at|is|rough|e)|ime)|using|w(?:eb|h(?:ere|y)|ith(?:out)?|or(?:ld|k))|y(?:ears?|ou(?:(?:\'re|r))?))$/i);
-
- # are we in the body? If so, apply some body-specific breakouts
- if ($region == 1 || $region == 2) {
- if (CHEW_BODY_MAILADDRS && $token =~ /\S\@\S/i) {
- push (@rettokens, $self->tokenize_mail_addrs ($token));
- }
- elsif (CHEW_BODY_URIS && $token =~ /\S\.[a-z]/i) {
- push (@rettokens, "UD:".$token); # the full token
- my $bit = $token; while ($bit =~ s/^[^\.]+\.(.+)$/$1/gs) {
- push (@rettokens, "UD:".$1); # UD = URL domain
- }
- }
- }
-
- # note: do not trim down overlong tokens if they contain '*'. This is
- # used as part of split tokens such as "HTo:D*net" indicating that
- # the domain ".net" appeared in the To header.
- #
- if ($len > MAX_TOKEN_LENGTH && $token !~ /\*/) {
- if (TOKENIZE_LONG_8BIT_SEQS_AS_TUPLES && $token =~ /[\xa0-\xff]{2}/) {
- # Matt sez: "Could be asian? Autrijus suggested doing character ngrams,
- # but I'm doing tuples to keep the dbs small(er)." Sounds like a plan
- # to me! (jm)
- while ($token =~ s/^(..?)//) {
- push (@rettokens, "8:$1");
- }
- next;
- }
-
- if (($region == 0 && HDRS_TOKENIZE_LONG_TOKENS_AS_SKIPS)
- || ($region == 1 && BODY_TOKENIZE_LONG_TOKENS_AS_SKIPS)
- || ($region == 2 && URIS_TOKENIZE_LONG_TOKENS_AS_SKIPS))
- {
- # if (TOKENIZE_LONG_TOKENS_AS_SKIPS)
- # Spambayes trick via Matt: Just retain 7 chars. Do not retain
- # the length, it does not help; see my mail to -devel of Nov 20 2002.
- # "sk:" stands for "skip".
- $token = "sk:".substr($token, 0, 7);
- }
- }
-
- # decompose tokens? do this after shortening long tokens
- if ($region == 1 || $region == 2) {
- if (DECOMPOSE_BODY_TOKENS) {
- if ($token =~ /[^\w:\*]/) {
- my $decompd = $token; # "Foo!"
- $decompd =~ s/[^\w:\*]//gs;
- push (@rettokens, $tokprefix.$decompd); # "Foo"
- }
-
- if ($token =~ /[A-Z]/) {
- my $decompd = $token; $decompd = lc $decompd;
- push (@rettokens, $tokprefix.$decompd); # "foo!"
-
- if ($token =~ /[^\w:\*]/) {
- $decompd =~ s/[^\w:\*]//gs;
- push (@rettokens, $tokprefix.$decompd); # "foo"
- }
- }
- }
- }
-
- push (@rettokens, $tokprefix.$token);
- }
-
- return @rettokens;
-}
-
-sub tokenize_headers {
- my ($self, $msg) = @_;
-
- my %parsed;
-
- my %user_ignore;
- $user_ignore{lc $_} = 1 for @{$self->{main}->{conf}->{bayes_ignore_headers}};
-
- # get headers in array context
- my @hdrs;
- my @rcvdlines;
- for ($msg->get_all_headers()) {
- # first, keep a copy of Received headers, so we can strip down to last 2
- if (/^Received:/i) {
- push(@rcvdlines, $_);
- next;
- }
- # and now skip lines for headers we don't want (including all Received)
- next if /^${IGNORED_HDRS}:/i;
- next if IGNORE_MSGID_TOKENS && /^Message-ID:/i;
- push(@hdrs, $_);
- }
- push(@hdrs, $msg->get_all_metadata());
-
- # and re-add the last 2 received lines: usually a good source of
- # spamware tokens and HELO names.
- if ($#rcvdlines >= 0) { push(@hdrs, $rcvdlines[$#rcvdlines]); }
- if ($#rcvdlines >= 1) { push(@hdrs, $rcvdlines[$#rcvdlines-1]); }
-
- for (@hdrs) {
- next unless /\S/;
- my ($hdr, $val) = split(/:/, $_, 2);
-
- # remove user-specified headers here, after Received, in case they
- # want to ignore that too
- next if exists $user_ignore{lc $hdr};
-
- # Prep the header value
- $val ||= '';
- chomp($val);
-
- # special tokenization for some headers:
- if ($hdr =~ /^(?:|X-|Resent-)Message-Id$/i) {
- $val = $self->pre_chew_message_id ($val);
- }
- elsif (PRE_CHEW_ADDR_HEADERS && $hdr =~ /^(?:|X-|Resent-)
- (?:Return-Path|From|To|Cc|Reply-To|Errors-To|Mail-Followup-To|Sender)$/ix)
- {
- $val = $self->pre_chew_addr_header ($val);
- }
- elsif ($hdr eq 'Received') {
- $val = $self->pre_chew_received ($val);
- }
- elsif ($hdr eq 'Content-Type') {
- $val = $self->pre_chew_content_type ($val);
- }
- elsif ($hdr eq 'MIME-Version') {
- $val =~ s/1\.0//; # totally innocuous
- }
- elsif ($hdr =~ /^${MARK_PRESENCE_ONLY_HDRS}$/i) {
- $val = "1"; # just mark the presence, they create lots of hapaxen
- }
-
- if (MAP_HEADERS_MID) {
- if ($hdr =~ /^(?:In-Reply-To|References|Message-ID)$/i) {
- $parsed{"*MI"} = $val;
- }
- }
- if (MAP_HEADERS_FROMTOCC) {
- if ($hdr =~ /^(?:From|To|Cc)$/i) {
- $parsed{"*Ad"} = $val;
- }
- }
- if (MAP_HEADERS_USERAGENT) {
- if ($hdr =~ /^(?:X-Mailer|User-Agent)$/i) {
- $parsed{"*UA"} = $val;
- }
- }
-
- # replace hdr name with "compressed" version if possible
- if (defined $HEADER_NAME_COMPRESSION{$hdr}) {
- $hdr = $HEADER_NAME_COMPRESSION{$hdr};
- }
-
- if (exists $parsed{$hdr}) {
- $parsed{$hdr} .= " ".$val;
- } else {
- $parsed{$hdr} = $val;
- }
- if (would_log('dbg', 'bayes') > 1) {
- dbg("bayes: header tokens for $hdr = \"$parsed{$hdr}\"");
- }
- }
-
- return %parsed;
-}
-
-sub pre_chew_content_type {
- my ($self, $val) = @_;
-
- # hopefully this will retain good bits without too many hapaxen
- if ($val =~ s/boundary=[\"\'](.*?)[\"\']/ /ig) {
- my $boundary = $1;
- $boundary =~ s/[a-fA-F0-9]/H/gs;
- # break up blocks of separator chars so they become their own tokens
- $boundary =~ s/([-_\.=]+)/ $1 /gs;
- $val .= $boundary;
- }
-
- # stop-list words for Content-Type header: these wind up totally gray
- $val =~ s/\b(?:text|charset)\b//;
-
- $val;
-}
-
-sub pre_chew_message_id {
- my ($self, $val) = @_;
- # we can (a) get rid of a lot of hapaxen and (b) increase the token
- # specificity by pre-parsing some common formats.
-
- # Outlook Express format:
- $val =~ s/<([0-9a-f]{4})[0-9a-f]{4}[0-9a-f]{4}\$
- ([0-9a-f]{4})[0-9a-f]{4}\$
- ([0-9a-f]{8})\@(\S+)>/ OEA$1 OEB$2 OEC$3 $4 /gx;
-
- # Exim:
- $val =~ s/<[A-Za-z0-9]{7}-[A-Za-z0-9]{6}-0[A-Za-z0-9]\@//;
-
- # Sendmail:
- $val =~ s/<20\d\d[01]\d[0123]\d[012]\d[012345]\d[012345]\d\.
- [A-F0-9]{10,12}\@//gx;
-
- # try to split Message-ID segments on probable ID boundaries. Note that
- # Outlook message-ids seem to contain a server identifier ID in the last
- # 8 bytes before the @. Make sure this becomes its own token, it's a
- # great spam-sign for a learning system! Be sure to split on ".".
- $val =~ s/[^_A-Za-z0-9]/ /g;
- $val;
-}
-
-sub pre_chew_received {
- my ($self, $val) = @_;
-
- # Thanks to Dan for these. Trim out "useless" tokens; sendmail-ish IDs
- # and valid-format RFC-822/2822 dates
-
- $val =~ s/\swith\sSMTP\sid\sg[\dA-Z]{10,12}\s/ /gs; # Sendmail
- $val =~ s/\swith\sESMTP\sid\s[\dA-F]{10,12}\s/ /gs; # Sendmail
- $val =~ s/\bid\s[a-zA-Z0-9]{7,20}\b/ /gs; # Sendmail
- $val =~ s/\bid\s[A-Za-z0-9]{7}-[A-Za-z0-9]{6}-0[A-Za-z0-9]/ /gs; # exim
-
- $val =~ s/(?:(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun),\s)?
- [0-3\s]?[0-9]\s
- (?:Jan|Feb|Ma[ry]|Apr|Ju[nl]|Aug|Sep|Oct|Nov|Dec)\s
- (?:19|20)?[0-9]{2}\s
- [0-2][0-9](?:\:[0-5][0-9]){1,2}\s
- (?:\s*\(|\)|\s*(?:[+-][0-9]{4})|\s*(?:UT|[A-Z]{2,3}T))*
- //gx;
-
- # IPs: break down to nearest /24, to reduce hapaxes -- EXCEPT for
- # IPs in the 10 and 192.168 ranges, they gets lots of significant tokens
- # (on both sides)
- # also make a dup with the full IP, as fodder for
- # bayes_dump_to_trusted_networks: "H*r:ip*aaa.bbb.ccc.ddd"
- $val =~ s{\b(\d{1,3}\.)(\d{1,3}\.)(\d{1,3})(\.\d{1,3})\b}{
- if ($2 eq '10' || ($2 eq '192' && $3 eq '168')) {
- $1.$2.$3.$4.
- " ip*".$1.$2.$3.$4." ";
- } else {
- $1.$2.$3.
- " ip*".$1.$2.$3.$4." ";
- }
- }gex;
-
- # trim these: they turn out as the most common tokens, but with a
- # prob of about .5. waste of space!
- $val =~ s/\b(?:with|from|for|SMTP|ESMTP)\b/ /g;
-
- $val;
-}
-
-sub pre_chew_addr_header {
- my ($self, $val) = @_;
- local ($_);
-
- my @addrs = $self->{main}->find_all_addrs_in_line ($val);
- my @toks;
- foreach (@addrs) {
- push (@toks, $self->tokenize_mail_addrs ($_));
- }
- return join (' ', @toks);
-}
-
-sub tokenize_mail_addrs {
- my ($self, $addr) = @_;
-
- ($addr =~ /(.+)\@(.+)$/) or return ();
- my @toks;
- push(@toks, "U*".$1, "D*".$2);
- $_ = $2; while (s/^[^\.]+\.(.+)$/$1/gs) { push(@toks, "D*".$1); }
- return @toks;
+ $self->{main}->call_plugins("learner_close", { quiet => $quiet });
}
###########################################################################
@@ -669,13 +90,13 @@
return 0 unless $self->{use_ignores};
- my $ig_from = $self->{main}->call_plugins ("check_wb_list", { permsgstatus => $PMS, type => 'from', list => 'bayes_ignore_from' });
- my $ig_to = $self->{main}->call_plugins ("check_wb_list", { permsgstatus => $PMS, type => 'to', list => 'bayes_ignore_to' });
+ my $ig_from = $self->{main}->call_plugins ("check_wb_list",
+ { permsgstatus => $PMS, type => 'from', list => 'bayes_ignore_from' });
+ my $ig_to = $self->{main}->call_plugins ("check_wb_list",
+ { permsgstatus => $PMS, type => 'to', list => 'bayes_ignore_to' });
my $ignore = $ig_from || $ig_to;
-
dbg("bayes: not using bayes, bayes_ignore_from or _to rule") if $ignore;
-
return $ignore;
}
@@ -683,9 +104,8 @@
sub learn {
my ($self, $isspam, $msg, $id) = @_;
-
- if (!$self->{conf}->{use_bayes}) { return; }
- if (!defined $msg) { return; }
+ return unless $self->{conf}->{use_learner};
+ return unless defined $msg;
if( $self->{use_ignores} ) # Remove test when PerMsgStatus available.
{
@@ -697,321 +117,29 @@
return 0 if $ignore;
}
- my $msgdata = $self->get_body_from_msg ($msg);
- my $ret;
-
- eval {
- local $SIG{'__DIE__'}; # do not run user die() traps in here
-
- my $ok;
- if ($self->{main}->{learn_to_journal}) {
- # If we're going to learn to journal, we'll try going r/o first...
- # If that fails for some reason, let's try going r/w. This happens
- # if the DB doesn't exist yet.
- $ok = $self->{store}->tie_db_readonly() || $self->{store}->tie_db_writable();
- } else {
- $ok = $self->{store}->tie_db_writable();
- }
-
- if ($ok) {
- $ret = $self->learn_trapped ($isspam, $msg, $msgdata, $id);
-
- if (!$self->{main}->{learn_caller_will_untie}) {
- $self->{store}->untie_db();
- }
- }
- 1;
- } or do { # if we died, untie the dbs.
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- $self->{store}->untie_db();
- die "bayes: (in learn) $eval_stat\n";
- };
-
- return $ret;
-}
-
-# this function is trapped by the wrapper above
-sub learn_trapped {
- my ($self, $isspam, $msg, $msgdata, $msgid) = @_;
- my @msgid = ( $msgid );
-
- if (!defined $msgid) {
- @msgid = $self->get_msgid($msg);
- }
-
- foreach $msgid ( @msgid ) {
- my $seen = $self->{store}->seen_get ($msgid);
-
- if (defined ($seen)) {
- if (($seen eq 's' && $isspam) || ($seen eq 'h' && !$isspam)) {
- dbg("bayes: $msgid already learnt correctly, not learning twice");
- return 0;
- } elsif ($seen !~ /^[hs]$/) {
- warn("bayes: db_seen corrupt: value='$seen' for $msgid, ignored");
- } else {
- # bug 3704: If the message was already learned, don't try learning it again.
- # this prevents, for instance, manually learning as spam, then autolearning
- # as ham, or visa versa.
- if ($self->{main}->{learn_no_relearn}) {
- dbg("bayes: $msgid already learnt as opposite, not re-learning");
- return 0;
- }
-
- dbg("bayes: $msgid already learnt as opposite, forgetting first");
-
- # kluge so that forget() won't untie the db on us ...
- my $orig = $self->{main}->{learn_caller_will_untie};
- $self->{main}->{learn_caller_will_untie} = 1;
-
- my $fatal = !defined $self->forget ($msg);
-
- # reset the value post-forget() ...
- $self->{main}->{learn_caller_will_untie} = $orig;
-
- # forget() gave us a fatal error, so propagate that up
- if ($fatal) {
- dbg("bayes: forget() returned a fatal error, so learn() will too");
- return;
- }
- }
-
- # we're only going to have seen this once, so stop if it's been
- # seen already
- last;
- }
- }
-
- # Now that we're sure we haven't seen this message before ...
- $msgid = $msgid[0];
-
- if ($isspam) {
- $self->{store}->nspam_nham_change (1, 0);
- } else {
- $self->{store}->nspam_nham_change (0, 1);
- }
-
- my $msgatime = $msg->receive_date();
-
- # If the message atime comes back as being more than 1 day in the
- # future, something's messed up and we should revert to current time as
- # a safety measure.
- #
- $msgatime = time if ( $msgatime - time > 86400 );
-
- my $tokens = $self->tokenize($msg, $msgdata);
-
- if ($isspam) {
- $self->{store}->multi_tok_count_change(1, 0, $tokens, $msgatime);
- } else {
- $self->{store}->multi_tok_count_change(0, 1, $tokens, $msgatime);
- }
-
- $self->{store}->seen_put ($msgid, ($isspam ? 's' : 'h'));
- $self->{store}->cleanup();
-
- $self->{main}->call_plugins("bayes_learn", { toksref => $tokens,
- isspam => $isspam,
- msgid => $msgid,
- msgatime => $msgatime,
- });
-
- dbg("bayes: learned '$msgid', atime: $msgatime");
-
- 1;
+ return $self->{main}->call_plugins("learn_message", { isspam => $isspam, msg => $msg, id => $id });
}
###########################################################################
sub forget {
my ($self, $msg, $id) = @_;
-
- if (!$self->{conf}->{use_bayes}) { return; }
- if (!defined $msg) { return; }
-
- my $msgdata = $self->get_body_from_msg ($msg);
- my $ret;
-
- # we still tie for writing here, since we write to the seen db
- # synchronously
- eval {
- local $SIG{'__DIE__'}; # do not run user die() traps in here
-
- my $ok;
- if ($self->{main}->{learn_to_journal}) {
- # If we're going to learn to journal, we'll try going r/o first...
- # If that fails for some reason, let's try going r/w. This happens
- # if the DB doesn't exist yet.
- $ok = $self->{store}->tie_db_readonly() || $self->{store}->tie_db_writable();
- } else {
- $ok = $self->{store}->tie_db_writable();
- }
-
- if ($ok) {
- $ret = $self->forget_trapped ($msg, $msgdata, $id);
-
- if (!$self->{main}->{learn_caller_will_untie}) {
- $self->{store}->untie_db();
- }
- }
- 1;
- } or do { # if we died, untie the dbs.
- my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- $self->{store}->untie_db();
- die "bayes: (in forget) $eval_stat\n";
- };
-
- return $ret;
-}
-
-# this function is trapped by the wrapper above
-sub forget_trapped {
- my ($self, $msg, $msgdata, $msgid) = @_;
- my @msgid = ( $msgid );
- my $isspam;
-
- if (!defined $msgid) {
- @msgid = $self->get_msgid($msg);
- }
-
- while( $msgid = shift @msgid ) {
- my $seen = $self->{store}->seen_get ($msgid);
-
- if (defined ($seen)) {
- if ($seen eq 's') {
- $isspam = 1;
- } elsif ($seen eq 'h') {
- $isspam = 0;
- } else {
- dbg("bayes: forget: msgid $msgid seen entry is neither ham nor spam, ignored");
- return 0;
- }
-
- # messages should only be learned once, so stop if we find a msgid
- # which was seen before
- last;
- }
- else {
- dbg("bayes: forget: msgid $msgid not learnt, ignored");
- }
- }
-
- # This message wasn't learnt before, so return
- if (!defined $isspam) {
- dbg("bayes: forget: no msgid from this message has been learnt, skipping message");
- return 0;
- }
- elsif ($isspam) {
- $self->{store}->nspam_nham_change (-1, 0);
- }
- else {
- $self->{store}->nspam_nham_change (0, -1);
- }
-
- my $tokens = $self->tokenize($msg, $msgdata);
-
- if ($isspam) {
- $self->{store}->multi_tok_count_change (-1, 0, $tokens);
- } else {
- $self->{store}->multi_tok_count_change (0, -1, $tokens);
- }
-
- $self->{store}->seen_delete ($msgid);
- $self->{store}->cleanup();
-
- $self->{main}->call_plugins("bayes_forget", { toksref => $tokens,
- isspam => $isspam,
- msgid => $msgid,
- });
-
- 1;
-}
-
-###########################################################################
-
-sub get_msgid {
- my ($self, $msg) = @_;
-
- my @msgid;
-
- my $msgid = $msg->get_header("Message-Id");
- if (defined $msgid && $msgid ne '' && $msgid !~ /^\s*<\s*(?:\@sa_generated)?>.*$/) {
- # remove \r and < and > prefix/suffixes
- chomp $msgid;
- $msgid =~ s/^<//; $msgid =~ s/>.*$//g;
- push(@msgid, $msgid);
- }
-
- # Use sha1_hex(Date:, last received: and top N bytes of body)
- # where N is MIN(1024 bytes, 1/2 of body length)
- #
- my $date = $msg->get_header("Date");
- $date = "None" if (!defined $date || $date eq ''); # No Date?
-
- my @rcvd = $msg->get_header("Received");
- my $rcvd = $rcvd[$#rcvd];
- $rcvd = "None" if (!defined $rcvd || $rcvd eq ''); # No Received?
-
- # Make a copy since pristine_body is a reference ...
- my $body = join('', $msg->get_pristine_body());
- if (length($body) > 64) { # Small Body?
- my $keep = ( length $body > 2048 ? 1024 : int(length($body) / 2) );
- substr($body, $keep) = '';
- }
-
- unshift(@msgid, sha1_hex($date."\000".$rcvd."\000".$body).'@sa_generated');
-
- return wantarray ? @msgid : $msgid[0];
-}
-
-sub get_body_from_msg {
- my ($self, $msg) = @_;
-
- if (!ref $msg) {
- # I have no idea why this seems to happen. TODO
- warn "bayes: msg not a ref: '$msg'";
- return { };
- }
-
- my $permsgstatus =
- Mail::SpamAssassin::PerMsgStatus->new($self->{main}, $msg);
- $msg->extract_message_metadata ($permsgstatus);
- my $msgdata = $self->get_msgdata_from_permsgstatus ($permsgstatus);
- $permsgstatus->finish();
-
- if (!defined $msgdata) {
- # why?!
- warn "bayes: failed to get body for ".scalar($self->get_msgid($self->{msg}))."\n";
- return { };
- }
-
- return $msgdata;
-}
-
-sub get_msgdata_from_permsgstatus {
- my ($self, $msg) = @_;
-
- my $msgdata = { };
- $msgdata->{bayes_token_body} = $msg->{msg}->get_visible_rendered_body_text_array();
- $msgdata->{bayes_token_inviz} = $msg->{msg}->get_invisible_rendered_body_text_array();
- @{$msgdata->{bayes_token_uris}} = $msg->get_uri_list();
- return $msgdata;
+ return unless $self->{conf}->{use_learner};
+ return unless defined $msg;
+ return $self->{main}->call_plugins("forget_message", { msg => $msg, id => $id });
}
###########################################################################
sub sync {
my ($self, $sync, $expire, $opts) = @_;
- if (!$self->{conf}->{use_bayes}) { return 0; }
+ return 0 unless $self->{conf}->{use_learner};
if ($sync) {
- dbg("bayes: bayes journal sync starting");
- $self->{store}->sync($opts);
- dbg("bayes: bayes journal sync completed");
+ $self->{main}->call_plugins("learner_sync", $opts );
}
if ($expire) {
- dbg("bayes: expiry starting");
- $self->{store}->expire_old_tokens($opts);
- dbg("bayes: expiry completed");
+ $self->{main}->call_plugins("learner_expire_old_training", $opts );
}
return 0;
@@ -1019,408 +147,21 @@
###########################################################################
-# compute the probability that a token is spammish
-sub compute_prob_for_token {
- my ($self, $token, $ns, $nn, $s, $n) = @_;
-
- # we allow the caller to give us the token information, just
- # to save a potentially expensive lookup
- if (!defined($s) || !defined($n)) {
- ($s, $n, undef) = $self->{store}->tok_get ($token);
- }
-
- return if ($s == 0 && $n == 0);
-
- if (!USE_ROBINSON_FX_EQUATION_FOR_LOW_FREQS) {
- return if ($s + $n < 10); # ignore low-freq tokens
- }
-
- if (!$self->{use_hapaxes}) {
- return if ($s + $n < 2);
- }
-
- return if ( $ns == 0 || $nn == 0 );
-
- my $ratios = ($s / $ns);
- my $ration = ($n / $nn);
-
- my $prob;
-
- if ($ratios == 0 && $ration == 0) {
- warn "bayes: oops? ratios == ration == 0";
- return;
- } else {
- $prob = ($ratios) / ($ration + $ratios);
- }
-
- if (USE_ROBINSON_FX_EQUATION_FOR_LOW_FREQS) {
- # use Robinson's f(x) equation for low-n tokens, instead of just
- # ignoring them
- my $robn = $s+$n;
- $prob = ($Mail::SpamAssassin::Bayes::Combine::FW_S_DOT_X + ($robn * $prob))
- /
- ($Mail::SpamAssassin::Bayes::Combine::FW_S_CONSTANT + $robn);
- }
-
- # 'log_raw_counts' is used to log the raw data for the Bayes equations during
- # a mass-check, allowing the S and X constants to be optimized quickly
- # without requiring re-tokenization of the messages for each attempt. There's
- # really no need for this code to be uncommented in normal use, however. It
- # has never been publicly documented, so commenting it out is fine. ;)
-
- ## if ($self->{log_raw_counts}) {
- ## $self->{raw_counts} .= " s=$s,n=$n ";
- ## }
-
- return $prob;
-}
-
-###########################################################################
-# If a token is neither hammy nor spammy, return 0.
-# For a spammy token, return the minimum number of additional ham messages
-# it would have had to appear in to no longer be spammy. Hammy tokens
-# are handled similarly. That's what the function does (at the time
-# of this writing, 31 July 2003, 16:02:55 CDT). It would be slightly
-# more useful if it returned the number of /additional/ ham messages
-# a spammy token would have to appear in to no longer be spammy but I
-# fear that might require the solution to a cubic equation, and I
-# just don't have the time for that now.
-
-sub compute_declassification_distance {
- my ($self, $Ns, $Nn, $ns, $nn, $prob) = @_;
-
- return 0 if $ns == 0 && $nn == 0;
-
- if (!USE_ROBINSON_FX_EQUATION_FOR_LOW_FREQS) {return 0 if ($ns + $nn < 10);}
- if (!$self->{use_hapaxes}) {return 0 if ($ns + $nn < 2);}
-
- return 0 if $Ns == 0 || $Nn == 0;
- return 0 if abs( $prob - 0.5 ) <
- $Mail::SpamAssassin::Bayes::Combine::MIN_PROB_STRENGTH;
-
- my ($Na,$na,$Nb,$nb) = $prob > 0.5 ? ($Nn,$nn,$Ns,$ns) : ($Ns,$ns,$Nn,$nn);
- my $p = 0.5 - $Mail::SpamAssassin::Bayes::Combine::MIN_PROB_STRENGTH;
-
- return int( 1.0 - 1e-6 + $nb * $Na * $p / ($Nb * ( 1 - $p )) ) - $na
- unless USE_ROBINSON_FX_EQUATION_FOR_LOW_FREQS;
-
- my $s = $Mail::SpamAssassin::Bayes::Combine::FW_S_CONSTANT;
- my $sx = $Mail::SpamAssassin::Bayes::Combine::FW_S_DOT_X;
- my $a = $Nb * ( 1 - $p );
- my $b = $Nb * ( $sx + $nb * ( 1 - $p ) - $p * $s ) - $p * $Na * $nb;
- my $c = $Na * $nb * ( $sx - $p * ( $s + $nb ) );
- my $discrim = $b * $b - 4 * $a * $c;
- my $disc_max_0 = $discrim < 0 ? 0 : $discrim;
- my $dd_exact = ( 1.0 - 1e-6 + ( -$b + sqrt( $disc_max_0 ) ) / ( 2*$a ) ) - $na;
-
- # This shouldn't be necessary. Should not be < 1
- return $dd_exact < 1 ? 1 : int($dd_exact);
-}
-
-
-# Check to make sure we can tie() the DB, and we have enough entries to do a scan
-# if we're told the caller will untie(), go ahead and leave the db tied.
sub is_scan_available {
my $self = shift;
-
- return 0 unless $self->{conf}->{use_bayes};
- return 0 unless $self->{store}->tie_db_readonly();
-
- # We need the DB to stay tied, so if the journal sync occurs, don't untie!
- my $caller_untie = $self->{main}->{learn_caller_will_untie};
- $self->{main}->{learn_caller_will_untie} = 1;
-
- # Do a journal sync if necessary. Do this before the nspam_nham_get()
- # call since the sync may cause an update in the number of messages
- # learnt.
- $self->opportunistic_calls(1);
-
- # Reset the variable appropriately
- $self->{main}->{learn_caller_will_untie} = $caller_untie;
-
- my ($ns, $nn) = $self->{store}->nspam_nham_get();
-
- if ($ns < $self->{conf}->{bayes_min_spam_num}) {
- dbg("bayes: not available for scanning, only $ns spam(s) in bayes DB < ".$self->{conf}->{bayes_min_spam_num});
- if (!$self->{main}->{learn_caller_will_untie}) {
- $self->{store}->untie_db();
- }
- return 0;
- }
- if ($nn < $self->{conf}->{bayes_min_ham_num}) {
- dbg("bayes: not available for scanning, only $nn ham(s) in bayes DB < ".$self->{conf}->{bayes_min_ham_num});
- if (!$self->{main}->{learn_caller_will_untie}) {
- $self->{store}->untie_db();
- }
- return 0;
- }
-
- return 1;
-}
-
-###########################################################################
-# Finally, the scoring function for testing mail.
-
-sub scan {
- my ($self, $permsgstatus, $msg) = @_;
- my $score;
-
- # When we're doing a scan, we'll guarantee that we'll do the untie,
- # so override the global setting until we're done.
- my $caller_untie = $self->{main}->{learn_caller_will_untie};
- $self->{main}->{learn_caller_will_untie} = 1;
-
- goto skip if ($self->ignore_message($permsgstatus));
-
- goto skip unless $self->is_scan_available();
-
- my ($ns, $nn) = $self->{store}->nspam_nham_get();
-
- ## if ($self->{log_raw_counts}) { # see compute_prob_for_token()
- ## $self->{raw_counts} = " ns=$ns nn=$nn ";
- ## }
-
- dbg("bayes: corpus size: nspam = $ns, nham = $nn");
-
- my $msgdata = $self->get_msgdata_from_permsgstatus ($permsgstatus);
-
- my $msgtokens = $self->tokenize($msg, $msgdata);
-
- my $tokensdata = $self->{store}->tok_get_all(keys %{$msgtokens});
-
- my %pw;
-
- foreach my $tokendata (@{$tokensdata}) {
- my ($token, $tok_spam, $tok_ham, $atime) = @{$tokendata};
- my $prob = $self->compute_prob_for_token($token, $ns, $nn, $tok_spam, $tok_ham);
- next unless defined $prob;
-
- $pw{$token} = {
- prob => $prob,
- spam_count => $tok_spam,
- ham_count => $tok_ham,
- atime => $atime
- };
- }
-
- # If none of the tokens were found in the DB, we're going to skip
- # this message...
- if (!keys %pw) {
- dbg("bayes: cannot use bayes on this message; none of the tokens were found in the database");
- goto skip;
- }
-
- my $tcount_total = keys %{$msgtokens};
- my $tcount_learned = keys %pw;
-
- # Figure out the message receive time (used as atime below)
- # If the message atime comes back as being in the future, something's
- # messed up and we should revert to current time as a safety measure.
- #
- my $msgatime = $msg->receive_date();
- my $now = time;
- $msgatime = $now if ( $msgatime > $now );
-
- # now take the $count most significant tokens and calculate probs using
- # Robinson's formula.
- my $count = N_SIGNIFICANT_TOKENS;
- my @sorted;
-
- my @touch_tokens;
- my $tinfo_spammy = $permsgstatus->{bayes_token_info_spammy} = [];
- my $tinfo_hammy = $permsgstatus->{bayes_token_info_hammy} = [];
-
- my %tok_strength = map { $_ => (abs($pw{$_}->{prob} - 0.5)) } keys %pw;
- my $log_each_token = (would_log('dbg', 'bayes') > 1);
-
- foreach my $tok (sort {
- $tok_strength{$b} <=> $tok_strength{$a}
- } keys %pw)
- {
- if ($count-- < 0) { last; }
- next if ($tok_strength{$tok} <
- $Mail::SpamAssassin::Bayes::Combine::MIN_PROB_STRENGTH);
-
- my $pw = $pw{$tok}->{prob};
-
- # What's more expensive, scanning headers for HAMMYTOKENS and
- # SPAMMYTOKENS tags that aren't there or collecting data that
- # won't be used? Just collecting the data is certainly simpler.
- #
- my $raw_token = $msgtokens->{$tok} || "(unknown)";
- my $s = $pw{$tok}->{spam_count};
- my $n = $pw{$tok}->{ham_count};
- my $a = $pw{$tok}->{atime};
-
- if ($pw < 0.5) {
- push @$tinfo_hammy, [$raw_token,$pw,$s,$n,$a];
- } else {
- push @$tinfo_spammy, [$raw_token,$pw,$s,$n,$a];
- }
-
- push (@sorted, $pw);
-
- # update the atime on this token, it proved useful
- push(@touch_tokens, $tok);
-
- if ($log_each_token) {
- dbg("bayes: token '$raw_token' => $pw");
- }
- }
-
- if (!@sorted || (REQUIRE_SIGNIFICANT_TOKENS_TO_SCORE > 0 &&
- $#sorted <= REQUIRE_SIGNIFICANT_TOKENS_TO_SCORE))
- {
- dbg("bayes: cannot use bayes on this message; not enough usable tokens found");
- goto skip;
- }
-
- $score = Mail::SpamAssassin::Bayes::Combine::combine($ns, $nn, \@sorted);
-
- # Couldn't come up with a probability?
- goto skip unless defined $score;
-
- dbg("bayes: score = $score");
-
- # no need to call tok_touch_all unless there were significant
- # tokens and a score was returned
- # we don't really care about the return value here
- $self->{store}->tok_touch_all(\@touch_tokens, $msgatime);
-
- $permsgstatus->{bayes_nspam} = $ns;
- $permsgstatus->{bayes_nham} = $nn;
-
- ## if ($self->{log_raw_counts}) { # see compute_prob_for_token()
- ## print "#Bayes-Raw-Counts: $self->{raw_counts}\n";
- ## }
-
- $self->{main}->call_plugins("bayes_scan", { toksref => $msgtokens,
- probsref => \%pw,
- score => $score,
- msgatime => $msgatime,
- significant_tokens => \@touch_tokens,
- });
-
-skip:
- if (!defined $score) {
- dbg("bayes: not scoring message, returning undef");
- }
-
- # Take any opportunistic actions we can take
- if ($self->{main}->{opportunistic_expire_check_only}) {
- # we're supposed to report on expiry only -- so do the
- # opportunistic_calls() run for the journal only.
- $self->opportunistic_calls(1);
- $permsgstatus->{bayes_expiry_due} = $self->{store}->expiry_due();
- }
- else {
- $self->opportunistic_calls();
- }
-
- # Do any cleanup we need to do
- $self->{store}->cleanup();
-
- # Reset the value accordingly
- $self->{main}->{learn_caller_will_untie} = $caller_untie;
-
- # If our caller won't untie the db, we need to do it.
- if (!$caller_untie) {
- $self->{store}->untie_db();
- }
-
- $permsgstatus->{tag_data}{BAYESTCHAMMY} =
- ($tinfo_hammy ? scalar @{$tinfo_hammy} : 0);
- $permsgstatus->{tag_data}{BAYESTCSPAMMY} =
- ($tinfo_spammy ? scalar @{$tinfo_spammy} : 0);
- $permsgstatus->{tag_data}{BAYESTCLEARNED} = $tcount_learned;
- $permsgstatus->{tag_data}{BAYESTC} = $tcount_total;
-
- return $score;
-}
-
-sub opportunistic_calls {
- my($self, $journal_only) = @_;
-
- # If we're not already tied, abort.
- if (!$self->{store}->db_readable()) {
- dbg("bayes: opportunistic call attempt failed, DB not readable");
- return;
- }
-
- # Is an expire or sync running?
- my $running_expire = $self->{store}->get_running_expire_tok();
- if ( defined $running_expire && $running_expire+$OPPORTUNISTIC_LOCK_VALID > time() ) {
- dbg("bayes: opportunistic call attempt skipped, found fresh running expire magic token");
- return;
- }
-
- # handle expiry and syncing
- if (!$journal_only && $self->{store}->expiry_due()) {
- dbg("bayes: opportunistic call found expiry due");
-
- # sync will bring the DB R/W as necessary, and the expire will remove
- # the running_expire token, may untie as well.
- $self->sync(1,1);
- }
- elsif ( $self->{store}->sync_due() ) {
- dbg("bayes: opportunistic call found journal sync due");
-
- # sync will bring the DB R/W as necessary, may untie as well
- $self->sync(1,0);
-
- # We can only remove the running_expire token if we're doing R/W
- if ($self->{store}->db_writable()) {
- $self->{store}->remove_running_expire_tok();
- }
- }
-
- return;
+ return 0 unless $self->{conf}->{use_learner};
+ return $self->{main}->call_plugins("learner_is_scan_available");
}
###########################################################################
sub dump_bayes_db {
my($self, $magic, $toks, $regex) = @_;
-
- # allow dump to occur even if use_bayes disables everything else ...
- #return 0 unless $self->{conf}->{use_bayes};
- return 0 unless $self->{store}->tie_db_readonly();
-
- my @vars = $self->{store}->get_storage_variables();
-
- my($sb,$ns,$nh,$nt,$le,$oa,$bv,$js,$ad,$er,$na) = @vars;
-
- my $template = '%3.3f %10u %10u %10u %s'."\n";
-
- if ( $magic ) {
- printf ($template, 0.0, 0, $bv, 0, 'non-token data: bayes db version');
- printf ($template, 0.0, 0, $ns, 0, 'non-token data: nspam');
- printf ($template, 0.0, 0, $nh, 0, 'non-token data: nham');
- printf ($template, 0.0, 0, $nt, 0, 'non-token data: ntokens');
- printf ($template, 0.0, 0, $oa, 0, 'non-token data: oldest atime');
- printf ($template, 0.0, 0, $na, 0, 'non-token data: newest atime') if ( $bv >= 2 );
- printf ($template, 0.0, 0, $sb, 0, 'non-token data: current scan-count') if ( $bv < 2 );
- printf ($template, 0.0, 0, $js, 0, 'non-token data: last journal sync atime') if ( $bv >= 2 );
- printf ($template, 0.0, 0, $le, 0, 'non-token data: last expiry atime');
- if ( $bv >= 2 ) {
- printf ($template, 0.0, 0, $ad, 0, 'non-token data: last expire atime delta');
- printf ($template, 0.0, 0, $er, 0, 'non-token data: last expire reduction count');
- }
- }
-
- if ( $toks ) {
- # let the store sort out the db_toks
- $self->{store}->dump_db_toks($template, $regex, @vars);
- }
-
- if (!$self->{main}->{learn_caller_will_untie}) {
- $self->{store}->untie_db();
- }
- return 1;
+ return 0 unless $self->{conf}->{use_learner};
+ return $self->{main}->call_plugins("learner_dump_database", {
+ magic => $magic, toks => $toks, regex => $regex });
}
1;
-
-=back
=cut
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm Fri Jan 18 02:28:38 2008
@@ -17,12 +17,12 @@
=head1 NAME
-Mail::SpamAssassin::BayesStore - Bayesian Storage Module
+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 must implement these methods.
+the storage module for the default Bayes classifier must implement these methods.
=cut
@@ -43,12 +43,12 @@
=item new
-public class (Mail::SpamAssassin::BayesStore) new (Mail::SpamAssassin::Bayes $bayes)
+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:Bayes object,
-which is stashed for use throughout the module.
+object. You must pass in an instance of the Mail::SpamAssassin::Plugin::Bayes
+object, which is stashed for use throughout the module.
=cut
@@ -89,7 +89,7 @@
Description:
This method reads any needed config variables from the configuration
-object and then calls the Mail::SpamAssassin::Bayes read_db_configs method.
+object and then calls the Mail::SpamAssassin::Plugin::Plugin::Bayes read_db_configs method.
=cut
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm Fri Jan 18 02:28:38 2008
@@ -1017,7 +1017,7 @@
# We have the value already, so just unpack it.
my ($ts, $th, $atime) = $self->tok_unpack ($tokvalue);
- my $prob = $self->{bayes}->compute_prob_for_token($tok, $vars[1], $vars[2], $ts, $th);
+ my $prob = $self->{bayes}->_compute_prob_for_token($tok, $vars[1], $vars[2], $ts, $th);
$prob ||= 0.5;
my $encoded_tok = unpack("H*",$tok);
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm Fri Jan 18 02:28:38 2008
@@ -48,7 +48,7 @@
=head2 new
-public class (Mail::SpamAssassin::BayesStore::SQL) new (Mail::Spamassassin::Bayes $bayes)
+public class (Mail::SpamAssassin::BayesStore::SQL) new (Mail::Spamassassin::Plugin::Bayes $bayes)
Description:
This methods creates a new instance of the Mail::SpamAssassin::BayesStore::SQL
@@ -648,7 +648,7 @@
}
while (my ($token, $spam_count, $ham_count, $atime) = $sth->fetchrow_array()) {
- my $prob = $self->{bayes}->compute_prob_for_token($token, $vars[1], $vars[2],
+ my $prob = $self->{bayes}->_compute_prob_for_token($token, $vars[1], $vars[2],
$spam_count, $ham_count);
$prob ||= 0.5;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Conf.pm Fri Jan 18 02:28:38 2008
@@ -1278,6 +1278,20 @@
=over 4
+=item use_learner ( 0 | 1 ) (default: 1)
+
+Whether to use any machine-learning classifiers with SpamAssassin, such as the
+default 'BAYES_*' rules. Setting this to 0 will disable use of any and all
+human-trained classifiers.
+
+=cut
+
+ push (@cmds, {
+ setting => 'use_learner',
+ default => 1,
+ type => $CONF_TYPE_BOOL
+ });
+
=item use_bayes ( 0 | 1 ) (default: 1)
Whether to use the naive-Bayesian-style classifier built into
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgLearner.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgLearner.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgLearner.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgLearner.pm Fri Jan 18 02:28:38 2008
@@ -90,8 +90,8 @@
# Learn the message as spam.
#
# C<$id> is an optional message-identification string, used internally
-# to tag the message. If it is C<undef>, the Message-Id of the message
-# will be used. It should be unique to that message.
+# to tag the message. If it is C<undef>, one will be generated.
+# It should be unique to that message.
#
# This is a semi-private API; callers should use
# C<$spamtest-E<gt>learn($mail,$id,$isspam,$forget)> instead.
@@ -117,8 +117,8 @@
# Learn the message as ham.
#
# C<$id> is an optional message-identification string, used internally
-# to tag the message. If it is C<undef>, the Message-Id of the message
-# will be used. It should be unique to that message.
+# to tag the message. If it is C<undef>, one will be generated.
+# It should be unique to that message.
#
# This is a semi-private API; callers should use
# C<$spamtest-E<gt>learn($mail,$id,$isspam,$forget)> instead.
@@ -141,8 +141,8 @@
# Forget about a previously-learned message.
#
# C<$id> is an optional message-identification string, used internally
-# to tag the message. If it is C<undef>, the Message-Id of the message
-# will be used. It should be unique to that message.
+# to tag the message. If it is C<undef>, one will be generated.
+# It should be unique to that message.
#
# This is a semi-private API; callers should use
# C<$spamtest-E<gt>learn($mail,$id,$isspam,$forget)> instead.
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm Fri Jan 18 02:28:38 2008
@@ -244,7 +244,7 @@
$self->{main}->finish_learner(); # for now
if (exists $self->{main}->{bayes_scanner}) {
- $self->{main}->{bayes_scanner}->sanity_check_is_untied();
+ $self->{main}->{bayes_scanner}->force_close();
}
1;
} or do {
@@ -988,52 +988,6 @@
return $text;
}
-sub bayes_report_make_list {
- my $self = shift;
- my $info = shift;
- my $param = shift || "5";
- my ($limit,$fmt_arg,$more) = split /,/, $param;
-
- return "Tokens not available." unless defined $info;
-
- my %formats = (
- short => '$t',
- Short => 'Token: \"$t\"',
- compact => '$p-$D--$t',
- Compact => 'Probability $p -declassification distance $D (\"+\" means > 9) --token: \"$t\"',
- medium => '$p-$D-$N--$t',
- long => '$p-$d--${h}h-${s}s--${a}d--$t',
- Long => 'Probability $p -declassification distance $D --in ${h} ham messages -and ${s} spam messages --$a} days old--token:\"$t\"'
- );
-
- my $raw_fmt = (!$fmt_arg ? '$p-$D--$t' : $formats{$fmt_arg});
-
- return "Invalid format, must be one of: ".join(",",keys %formats)
- unless defined $raw_fmt;
-
- my $fmt = '"'.$raw_fmt.'"';
- my $amt = $limit < @$info ? $limit : @$info;
- return "" unless $amt;
-
- my $Bayes = $self->{main}{bayes_scanner};
- return "Bayes not available" unless defined $Bayes;
- my $ns = $self->{bayes_nspam};
- my $nh = $self->{bayes_nham};
- my $digit = sub { $_[0] > 9 ? "+" : $_[0] };
- my $now = time;
-
- join ', ', map {
- my($t,$prob,$s,$h,$u) = @$_;
- my $a = int(($now - $u)/(3600 * 24));
- my $d = $Bayes->compute_declassification_distance($ns,$nh,$s,$h,$prob);
- my $p = sprintf "%.3f", $prob;
- my $n = $s + $h;
- my ($c,$o) = $prob < 0.5 ? ($h,$s) : ($s,$h);
- my ($D,$S,$H,$C,$O,$N) = map &$digit($_), ($d,$s,$h,$c,$o,$n);
- eval $fmt; ## no critic
- } @{$info}[0..$amt-1];
-}
-
###########################################################################
# public API for plugins
@@ -1214,33 +1168,6 @@
BAYES => sub {
defined($self->{bayes_score}) ?
sprintf("%3.4f", $self->{bayes_score}) : "0.5"
- },
-
- HAMMYTOKENS => sub {
- $self->bayes_report_make_list
- ( $self->{bayes_token_info_hammy}, shift );
- },
-
- SPAMMYTOKENS => sub {
- $self->bayes_report_make_list
- ( $self->{bayes_token_info_spammy}, shift );
- },
-
- TOKENSUMMARY => sub {
- if( defined $self->{tag_data}{BAYESTC} )
- {
- my $tcount_neutral = $self->{tag_data}{BAYESTCLEARNED}
- - $self->{tag_data}{BAYESTCSPAMMY}
- - $self->{tag_data}{BAYESTCHAMMY};
- my $tcount_new = $self->{tag_data}{BAYESTC}
- - $self->{tag_data}{BAYESTCLEARNED};
- "Tokens: new, $tcount_new; "
- ."hammy, $self->{tag_data}{BAYESTCHAMMY}; "
- ."neutral, $tcount_neutral; "
- ."spammy, $self->{tag_data}{BAYESTCSPAMMY}."
- } else {
- "Bayes not run.";
- }
},
DATE => \&Mail::SpamAssassin::Util::time_to_rfc822_date,
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin.pm?rev=613124&r1=613123&r2=613124&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin.pm Fri Jan 18 02:28:38 2008
@@ -837,6 +837,106 @@
%{$self} = ();
}
+=item $plugin->learner_new ()
+
+Used to support human-trained probabilistic classifiers like the BAYES_* ruleset.
+Called when a new C<Mail::SpamAssassin::Bayes> object has been created; typically
+when a new user's scan is about to start.
+
+=item $plugin->learn_message ()
+
+Train the classifier with a training message.
+
+=over 4
+
+=item isspam
+
+1 if the message is spam, 0 if it's non-spam.
+
+=item msg
+
+The message's C<Mail::SpamAssassin::Message> object.
+
+=item id
+
+An optional message-identification string, used internally to tag the message.
+If it is C<undef>, one will be generated. It should be unique to that message.
+
+=back
+
+=item $plugin->forget_message ()
+
+Tell the classifier to 'forget' its training about a specific message.
+
+=over 4
+
+=item msg
+
+The message's C<Mail::SpamAssassin::Message> object.
+
+=item id
+
+An optional message-identification string, used internally to tag the message.
+If it is C<undef>, one will be generated. It should be unique to that message.
+
+=back
+
+=item $plugin->learner_sync ()
+
+Tell the classifier to 'sync' any pending changes against the current
+user's training database. This is called by C<sa-learn --sync>.
+
+If you do not need to implement these for your classifier, create an
+implementation that just contains C<return 1>.
+
+=item $plugin->learner_expire_old_training ()
+
+Tell the classifier to perform infrequent, time-consuming cleanup of
+the current user's training database. This is called by C<sa-learn
+--force-expire>.
+
+If you do not need to implement these for your classifier, create an
+implementation that just contains C<return 1>.
+
+=item $plugin->learner_is_scan_available ()
+
+Should return 1 if it is possible to use the current user's training data for
+a message-scan operation, or 0 otherwise.
+
+=item $plugin->learner_dump_database ()
+
+Dump information about the current user's training data to C<stdout>.
+This is called by C<sa-learn --dump>.
+
+=over 4
+
+=item magic
+
+Set to 1 if "magic" name-value metadata should be dumped.
+
+=item toks
+
+Set to 1 if the database of tokens should be dumped.
+
+=item regex
+
+Either C<undef> to dump all tokens, or a value which specifies a regular expression
+subset of the tokens to dump.
+
+=back
+
+=item $plugin->learner_close ()
+
+Close any open databases.
+
+=over 4
+
+=item quiet
+
+Set to 1 if warning messages should be suppressed.
+
+=back
+
=head1 HELPER APIS
These methods provide an API for plugins to register themselves