=head1 NAME

MAwhitelist - an eval test using Mail Archive info about this sender.

=head1 SYNOPSIS

  loadplugin MAwhitelist MAwhitelist.pm
  
  describe  MA_WHITELIST  Mail Archive holds mail sent to this sender 
  header    MA_WHITELIST  eval:MAwhitelist_reply()
  score     MA_WHITELIST  -6.0

  *** You must configure the Database dsn, username and password by
  *** editing the following lines in the MAwhitelist.cf
  ***
  *** MAwhitelist_sql_dsn      DBI:Pg:dbname=databasename;host=hostname
  *** MAwhitelist_sql_username databaseuser
  *** MAwhitelist_sql_password databasepassword
  ***
  *** to suit your database installation.

=head1 DESCRIPTION

This module provides an eval test that checks the Mail Archive database
to see if the sender of incoming mail is recorded. 
If mail has previously been sent to them the test will return TRUE.
If they are unknown or have not been sent mail the test returns FALSE.
This result is used by the rule that evoked it to whitelist the sender.

=head1 REQUIREMENT

The module uses the whitelist view in the Mail Archive database.
If the view returns any rows it returns TRUE. Otherwise it returns FALSE.

=head1 CONFIGURATION

=head2 Eval tests

=item MAwhitelist_reply

TRUE if the message is from anybody we've sent mail to.

=cut

package MAwhitelist;

# $Id: MAwhitelist.pm,v 1.2 2009/06/20 18:23:55 cvs Exp $

use strict;
use base 'Mail::SpamAssassin::Plugin';
use DBI;

sub dbg { 
#	return;
	my $msg = shift;
	Mail::SpamAssassin::Plugin::dbg(sprintf("MAwhitelist: $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('MAwhitelist_reply');
	$self->{main}->{conf}->{MAwhitelist_sql_dsn} = 'DBI:mysql:dbname=sawhitelist;host=127.0.0.1';
	$self->{main}->{conf}->{MAwhitelist_sql_username} = 'sawhitelist';
	$self->{main}->{conf}->{MAwhitelist_sql_password} = '%sawhitelist%';
	dbg('registered');
	return $self;
}

sub parse_config {
	my ($self,$pars) = @_;
	return 0 unless ($pars->{key} =~ /^mawhitelist_(sql_dsn|sql_username|sql_password)$/);
	dbg('config %s = %s',$pars->{key},$pars->{value});
	$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}->{mawhitelist_sql_dsn},
				$self->{main}->{conf}->{mawhitelist_sql_username},
				$self->{main}->{conf}->{mawhitelist_sql_password},
				{RaiseError=>0,AutoCommit=>0}
	);
	return 1 if ($self->{sqldb});
	dbg('sql connect failed');
	return 0;
}

sub _sql_disconnect {
	my ($self) = @_;
	dbg('sql disconnect');
	if ($self->{sqldb}) {
		dbg('...disconnected');
		$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 (@_);
	my $where = '';
	$where .= sprintf('%s',shift @_);
	my $cmd = "SELECT count(*) FROM whitelist WHERE $where";
	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 _init_senders {
	my ($self,$pms) = @_;
	unless ($pms->{MAwhitelist_got_senders}) {
		dbg('get senders');
		$pms->{MAwhitelist_got_senders} = 0;
		$pms->{MAwhitelist_senders} = '';
		foreach my $hn (('EnvelopeFrom','From','Sender','Reply-To')) {
			my $aa = lc($pms->get("$hn:addr"));
			next unless ($aa);
			if ($aa =~ /^(.+)\@(.+?)$/) {
				$pms->{MAwhitelist_senders} .= ' OR ' if ($pms->{MAwhitelist_senders});
				$pms->{MAwhitelist_senders} .= "email = '$aa'";
				dbg('got sender %s: %s',$hn,$aa);
				$pms->{MAwhitelist_got_senders} ++;
			}
		}
		dbg('got senders %u',$pms->{MAwhitelist_got_senders});
		$pms->{MAwhitelist_got_senders} = -1 unless ($pms->{MAwhitelist_got_senders});
	}
	return $pms->{MAwhitelist_got_senders} if ($pms->{MAwhitelist_got_senders} > 0);
	return 0;
}

sub _MAwhitelist_reply {
	my ($self,$pms) = @_;
	return 0 unless ($self->_init_senders($pms));
	dbg('try reply');
	return 1 if ($self->_sql_select_one(0,$pms->{MAwhitelist_senders}));
	dbg('not reply');
	return 0;
}

sub MAwhitelist_reply {
	my ($self,$pms) = @_;
	return $pms->{MAwhitelist_reply} if (defined($pms->{MAwhitelist_reply}));
	return 0 unless ($self->_sql_connect());
	$pms->{MAwhitelist_reply} = $self->_MAwhitelist_reply($pms);
	$self->_sql_disconnect();
	dbg('eval reply %u',$pms->{MAwhitelist_reply});
	return $pms->{MAwhitelist_reply};
}

1;