=head1 NAME
SentOutDB - provides eval test using info about sent mails.
=head1 SYNOPSIS
loadplugin Mail::SpamAssassin::Plugin::SentOutDB /usr/local/etc/mail/spamassassin/plugins/SentOutDB.pm
sentoutdb_sql_dsn DBI:mysql:dbname:localhost
sentoutdb_sql_username user
sentoutdb_sql_password pass
describe SODB_REPLY Reply to outgoing message
header SODB_REPLY eval:sentoutdb_reply()
score SODB_REPLY -2.0
describe SODB_PROBABLE_REPLY Probably a reply to outgoing message
header SODB_PROBABLE_REPLY eval:sentoutdb_probable_reply('exclusive')
score SODB_PROBABLE_REPLY -1.0
describe SODB_POSSIBLE_REPLY Might be a reply or DSN to outgoing message
header SODB_POSSIBLE_REPLY eval:sentoutdb_possible_reply('exclusive')
score SODB_POSSIBLE_REPLY -0.5
=head1 DESCRIPTION
This module provides eval tests that uses check a database to see if an
incoming mail seems to be a reply to an outgloing one.
=head1 REQUIREMENT
This plugin uses the database used by the MIMEDefang filter at
http://whatever.frukt.org.
=head1 CONFIGURATION
=head2 Eval tests
=over
=item sentoutdb_reply
True if it is fairly certain that a message is a reply.
=item sentoutdb_probable_reply
True if a mail probably is a reply.
If a string with an X is sent as the first parameter, this will only be true if
eval:sentoutdb_reply() isn't.
=item sentoutdb_possible_reply
True if a mail might be a reply.
If a string with an X is sent as the first parameter, this will only be true if
eval:sentoutdb_reply() and eval:sentoutdb_probable_reply() isn't.
=back
=head2 Options
=over
=item sentoutdb_sql_dsn
Wich database driver and database to use.
=item sentoutdb_sql_username
User name for the database connection.
=item sentoutdb_sql_password
Password for the database connection.
=back
=cut
package Mail::SpamAssassin::Plugin::SentOutDB;
# $Id: SentOutDB.pm,v 1.7 2009/06/26 11:52:16 jonas Exp $
use strict;
use base 'Mail::SpamAssassin::Plugin';
use DBI;
sub dbg {
my $msg = shift;
Mail::SpamAssassin::Plugin::dbg(sprintf("sentoutdb: $msg",@_));
}
sub new {
my ($class,$mailsa) = @_;
$class = ref($class) || $class;
my $self = $class->SUPER::new($mailsa);
bless($self,$class);
$self->{sqldb} = undef;
$self->register_eval_rule('sentoutdb_reply');
$self->register_eval_rule('sentoutdb_probable_reply');
$self->register_eval_rule('sentoutdb_possible_reply');
$self->{main}->{conf}->{sentoutdb_sql_dsn} = 'DBI:mysql:mdf:localhost';
$self->{main}->{conf}->{sentoutdb_sql_username} = 'sa';
$self->{main}->{conf}->{sentoutdb_sql_password} = 'pwd';
#dbg('registered');
return $self;
}
sub parse_config {
my ($self,$pars) = @_;
return 0 if ($pars->{user_config});
return 0 unless ($pars->{key} =~ /^sentoutdb_(sql_dsn|sql_username|sql_password)$/);
my $key = $1;
my $val = $pars->{value};
$val = '' if ($key =~ /(username|password)/);
$val = " = $val" if ($val);
dbg('config %s%s',$key,$val);
$self->{main}->{conf}->{$pars->{key}} = $pars->{value};
$self->inhibit_further_callbacks();
return 1;
}
sub _sql_connect {
my ($self) = @_;
return 1 if ($self->{sqldb});
#dbg('sql connect');
$self->{sqldb} = DBI->connect_cached(
$self->{main}->{conf}->{sentoutdb_sql_dsn},
$self->{main}->{conf}->{sentoutdb_sql_username},
$self->{main}->{conf}->{sentoutdb_sql_password},
{RaiseError=>0}
);
return 1 if ($self->{sqldb});
dbg('sql connect failed');
return 0;
}
sub _sql_disconnect {
my ($self) = @_;
if ($self->{sqldb}) {
#dbg('sql disconnect');
$self->{sqldb}->disconnect();
}
$self->{sqldb} = undef;
}
sub _sql_quote {
my ($self,$s) = @_;
#return $s unless ($self->_sql_connect());
return $self->{sqldb}->quote($s);
}
sub _sql_select_one {
my $self = shift;
my $stamp = shift;
return undef unless (@_);
#return undef unless ($self->_sql_connect());
my $where = '';
while (@_) {
$where .= ' AND ' if ($where);
$where .= sprintf('(%s)',shift @_);
}
$stamp = 0 unless ($stamp);
if ($self->{main}->{conf}->{sentoutdb_expire}) {
my $ts = time-($self->{main}->{conf}->{sentoutdb_expire}*24*60*60);
$stamp = $ts if ($ts > $stamp);
}
my $cmd = "SELECT out_stamp FROM sentout WHERE $where AND (out_stamp>$stamp) LIMIT 1";
#dbg('sql %s',$cmd);
my $st = $self->{sqldb}->prepare($cmd);
unless ($st) {
dbg('sql prepare failed');
return undef;
}
$st->execute;
my @res = $st->fetchrow_array;
$st->finish;
return undef unless (@res);
#dbg('sql result %u',$res[0]);
return $res[0];
}
sub _subject {
my ($self,$pms) = @_;
unless ($pms->{sentoutdb_got_subject}) {
#dbg('get subject');
$pms->{sentoutdb_got_subject} = 1;
my $subj = $pms->get('Subject');
$subj =~ s/[\r\n]+$//s;
$subj =~ s/[\r\n]+/ /gs;
#dbg('got subject "%s"',$subj);
$subj =~ s/\s+/ /g;
$subj =~ s/^\s+//;
$subj =~ s/\s+$//;
$subj =~ s/[^\x20-\x7E]/?/g;
$subj =~ s/^(?:\[\S+\]\s*)?(?:\S{1,5}:\s*)?(?:\[\S+\]\s*)?(\S)/$1/;
$subj = $self->_sql_quote($subj);
dbg('got subject %s',$subj);
$pms->{sentoutdb_subject} = "out_subject=$subj";
}
return $pms->{sentoutdb_subject};
}
sub _init_senders {
my ($self,$pms) = @_;
unless ($pms->{sentoutdb_got_senders}) {
#dbg('get senders');
$pms->{sentoutdb_got_senders} = 0;
$pms->{sentoutdb_senders_dom} = '';
$pms->{sentoutdb_senders_adr} = '';
my %ga = ();
my %gd = ();
foreach my $hn (('EnvelopeFrom','From','Sender','Reply-To')) {
my $aa = lc($pms->get("$hn:addr"));
next unless ($aa);
next if ($ga{$aa});
$ga{$aa} = 1;
if ($aa =~ /^(.+)\@(.+?)$/) {
my $usr = $self->_sql_quote($1);
my $dom = $self->_sql_quote($2);
#dbg('got sender %s adress %s %s',$hn,$usr,$dom);
$pms->{sentoutdb_senders_adr} .= ' OR ' if ($pms->{sentoutdb_senders_adr});
$pms->{sentoutdb_senders_adr} .= "(out_rcpt_dom=$dom AND out_rcpt_usr=$usr)";
$pms->{sentoutdb_got_senders} ++;
next if ($gd{$dom});
$gd{$dom} = 1;
#dbg('got sender %s domain %s',$hn,$dom);
$pms->{sentoutdb_senders_dom} .= ' OR ' if ($pms->{sentoutdb_senders_dom});
$pms->{sentoutdb_senders_dom} .= "out_rcpt_dom=$dom";
}
}
dbg('got senders %u',$pms->{sentoutdb_got_senders});
$pms->{sentoutdb_got_senders} = -1 unless ($pms->{sentoutdb_got_senders});
}
return $pms->{sentoutdb_got_senders} if ($pms->{sentoutdb_got_senders} > 0);
return 0;
}
sub _init_recipients {
my ($self,$pms) = @_;
unless ($pms->{sentoutdb_got_recipients}) {
#dbg('get recipients');
$pms->{sentoutdb_got_recipients} = 0;
$pms->{sentoutdb_recipients_adr} = '';
my %ga = ();
my @al = $pms->get_message->header('Received');
foreach my $rl (@al) {
$rl =~ s/[\r\n]+$//s;
$rl =~ s/[\r\n]+/ /gs;
$rl =~ s/\s+/ /g;
$rl =~ s/;.*?$//;
if ($rl =~ /for <?(\S+?)>?\s*$/) {
my $aa = lc($1);
next unless ($aa);
next if ($ga{$aa});
$ga{$aa} = 1;
$aa = $self->_sql_quote($aa);
#dbg('got recipient %s %s','received',$aa);
$pms->{sentoutdb_recipients_adr} .= ' OR ' if ($pms->{sentoutdb_recipients_adr});
$pms->{sentoutdb_recipients_adr} .= "out_sender=$aa";
$pms->{sentoutdb_got_recipients} ++;
}
}
@al = ();
foreach my $hn (('Envelope-To','Delivered-To','Apparently-To','To','Cc')) {
my $ax = $pms->get($hn);
next unless ($ax);
$ax =~ s/[\r\n]+$//s;
$ax =~ s/[\r\n]+/ /gs;
$ax =~ s/^[^:]+:(.*);\s*$/$1/g;
$ax =~ s/\s+/ /g;
$ax =~ s/^\s+//;
$ax =~ s/\s+$//;
$ax =~ s/\s*\(.*?\)//g;
$ax =~ s/(?<!<)"[^"]*"(?!@)//g;
next unless ($ax);
foreach my $aa (split(/\s*,\s*/,lc($ax))) {
$aa =~ s/^[^<]*?<(.*?)>.*$/$1/;
next unless ($aa);
next if ($ga{$aa});
$ga{$aa} = 1;
$aa = $self->_sql_quote($aa);
#dbg('got recipient %s %s',$hn,$aa);
$pms->{sentoutdb_recipients_adr} .= ' OR ' if ($pms->{sentoutdb_recipients_adr});
$pms->{sentoutdb_recipients_adr} .= "out_sender=$aa";
$pms->{sentoutdb_got_recipients} ++;
}
}
dbg('got recipients %u',$pms->{sentoutdb_got_recipients});
$pms->{sentoutdb_got_recipients} = -1 unless ($pms->{sentoutdb_got_recipients});
}
return $pms->{sentoutdb_got_recipients} if ($pms->{sentoutdb_got_recipients} > 0);
return 0;
}
sub _init_references {
my ($self,$pms) = @_;
unless ($pms->{sentoutdb_got_references}) {
#dbg('get references');
$pms->{sentoutdb_got_references} = 0;
$pms->{sentoutdb_references_mid} = '';
my %gi = ();
foreach my $hn(('References','In-Reply-To')) {
my $ix = $pms->get($hn);
next unless ($ix);
foreach my $hid (split(/\s+/,$ix)) {
if ($hid =~ /^\s*<(.+)>\s*$/) {
$hid = $self->_sql_quote($1);
next if ($gi{$hid});
$gi{$hid} = 1;
#dbg('got reference %s %s',$hn,$hid);
$pms->{sentoutdb_references_mid} .= ' OR ' if ($pms->{sentoutdb_references_mid});
$pms->{sentoutdb_references_mid} .= "out_id=$hid";
$pms->{sentoutdb_got_references} ++;
}
}
}
dbg('got references %u',$pms->{sentoutdb_got_references});
$pms->{sentoutdb_got_references} = -1 unless ($pms->{sentoutdb_got_references});
}
return $pms->{sentoutdb_got_references} if ($pms->{sentoutdb_got_references} > 0);
return 0;
}
sub _sentoutdb_reply {
my ($self,$pms) = @_;
return 0 unless ($self->_init_senders($pms));
return 0 unless ($self->_init_recipients($pms));
return 0 unless ($self->_init_references($pms));
dbg('try reply');
return 1 if ($self->_sql_select_one(0,$pms->{sentoutdb_references_mid},$pms->{sentoutdb_senders_dom},$pms->{sentoutdb_recipients_adr}));
dbg('not reply');
return 0;
}
sub _sentoutdb_probable_reply_cnv {
my ($self,$pms) = @_;
return 0 unless ($self->_init_senders($pms));
return 0 unless ($self->_init_recipients($pms));
#dbg('try probable reply cnv');
return 1 if ($self->_sql_select_one(0,$pms->{sentoutdb_recipients_adr},$pms->{sentoutdb_senders_adr},$self->_subject($pms)));
#dbg('not probable reply cnv');
return 0;
}
sub _sentoutdb_probable_reply_mid {
my ($self,$pms) = @_;
return 0 unless ($self->_init_senders($pms));
return 0 unless ($self->_init_references($pms));
#dbg('try probable reply mid');
return 1 if ($self->_sql_select_one(0,$pms->{sentoutdb_references_mid},$pms->{sentoutdb_senders_adr}));
#dbg('not probable reply mid');
return 0;
}
sub _sentoutdb_probable_reply {
my ($self,$pms) = @_;
dbg('try probable reply');
return 1 if ($self->_sentoutdb_probable_reply_cnv($pms));
return 1 if ($self->_sentoutdb_probable_reply_mid($pms));
dbg('not probable reply');
return 0;
}
sub _sentoutdb_possible_reply_cnv {
my ($self,$pms) = @_;
return 0 unless ($self->_init_senders($pms));
return 0 unless ($self->_init_recipients($pms));
#dbg('try possible reply cnv 1');
return 1 if ($self->_sql_select_one(0,$pms->{sentoutdb_recipients_adr},$pms->{sentoutdb_senders_dom},$self->_subject($pms)));
#dbg('try possible reply cnv 2');
return 1 if ($self->_sql_select_one(0,$pms->{sentoutdb_recipients_adr},$pms->{sentoutdb_senders_adr}));
#dbg('not possible reply cnv');
return 0;
}
sub _sentoutdb_possible_reply_mid {
my ($self,$pms) = @_;
return 0 unless ($self->_init_senders($pms));
return 0 unless ($self->_init_references($pms));
#dbg('try possible reply mid');
return 1 if ($self->_sql_select_one(0,$pms->{sentoutdb_references_mid},$pms->{sentoutdb_senders_dom}));
#dbg('not possible reply mid');
return 0;
}
sub _sentoutdb_possible_reply_dsn {
my ($self,$pms) = @_;
return 0 unless ($self->_init_senders($pms));
return 0 unless ($self->_init_recipients($pms));
return 0 if ($pms->get('EnvelopeFrom:addr'));
#dbg('try possible reply dsn');
return 1 if ($self->_sql_select_one(time()-(8*24*60*60),$pms->{sentoutdb_senders_dom},$pms->{sentoutdb_recipients_adr}));
#dbg('not possible reply dsn');
return 0;
}
sub _sentoutdb_possible_reply {
my ($self,$pms) = @_;
dbg('try possible reply');
return 1 if ($self->_sentoutdb_possible_reply_cnv($pms));
return 1 if ($self->_sentoutdb_possible_reply_mid($pms));
return 1 if ($self->_sentoutdb_possible_reply_dsn($pms));
dbg('not possible reply');
return 0;
}
sub sentoutdb_reply {
my ($self,$pms) = @_;
return $pms->{sentoutdb_reply} if (defined($pms->{sentoutdb_reply}));
return 0 unless ($self->_sql_connect());
$pms->{sentoutdb_reply} = $self->_sentoutdb_reply($pms);
$self->_sql_disconnect();
dbg('eval reply %u',$pms->{sentoutdb_reply});
return $pms->{sentoutdb_reply};
}
sub sentoutdb_probable_reply {
my ($self,$pms,$pars) = @_;
return 0 if ($pars && $pars =~ /[Xx]/ && $self->sentoutdb_reply($pms));
return $pms->{sentoutdb_probable_reply} if (defined($pms->{sentoutdb_probable_reply}));
$pms->{sentoutdb_probable_reply} = 1 if ($pms->{sentoutdb_reply});
unless ($pms->{sentoutdb_probable_reply}) {
return 0 unless ($self->_sql_connect());
$pms->{sentoutdb_probable_reply} = $self->_sentoutdb_probable_reply($pms);
$self->_sql_disconnect();
}
dbg('eval probable reply %u',$pms->{sentoutdb_probable_reply});
return $pms->{sentoutdb_probable_reply};
}
sub sentoutdb_possible_reply {
my ($self,$pms,$pars) = @_;
return 0 if ($pars && $pars =~ /[Xx]/ && ($self->sentoutdb_reply($pms) || $self->sentoutdb_probable_reply($pms)));
return $pms->{sentoutdb_possible_reply} if (defined($pms->{sentoutdb_possible_reply}));
$pms->{sentoutdb_possible_reply} = 1 if ($pms->{sentoutdb_reply} || $pms->{sentoutdb_probable_reply});
unless ($pms->{sentoutdb_possible_reply}) {
return 0 unless ($self->_sql_connect());
$pms->{sentoutdb_possible_reply} = $self->_sentoutdb_possible_reply($pms);
$self->_sql_disconnect();
}
dbg('eval possible reply %u',$pms->{sentoutdb_possible_reply});
return $pms->{sentoutdb_possible_reply};
}
1;
(2008-01-11)