#! /usr/bin/perl -T
# $Id: spamscan.in,v 1.10 2005/07/22 21:37:31 don Exp $
#
# Usage: spamscan
#
# Performs SpamAssassin checks on a message before allowing it through to
# the main incoming queue.
#
# Uses up: incoming/S<code><bugnum>.nn
# Temps:   incoming/R.nn
# Creates: incoming/I.nn
# Stop:    spamscan-stop

$config_path = '/etc/debbugs';
$lib_path = '/usr/lib/debbugs';

require "$config_path/config";
require "$lib_path/errorlib";
$ENV{PATH} = $lib_path . ':' . $ENV{PATH};

exit unless $gSpamScan;

chdir $gSpoolDir or die "chdir spool: $!\n";
push @INC, $lib_path;

use Mail::SpamAssassin;

use lib '/usr/lib/debbugs';
use Mail::CrossAssassin;

umask 002;

eval {
    &filelock('incoming-spamscan');
};
exit if $@;

ca_init('\b\d{3,8}(?:-(?:close|done|forwarded|maintonly|submitter|quiet))?\@bugs\.debian\.org', '/org/bugs.debian.org/CrossAssassinDb');

my %spamseen = ();

my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
my $user_prefs_time;
if (-e $user_prefs) {
    $user_prefs_time = (stat $user_prefs)[9];
}

my $spam = Mail::SpamAssassin->new({
    dont_copy_prefs => 1,
    site_rules_filename => $gSpamRulesDir,
    userprefs_filename => $user_prefs,
    local_tests_only => ($gSpamLocalTestsOnly || 0),
#    debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
#    check_mx_delay => 2, # bit of a hack until we have parallelization
});
$spam->compile_now(1); # use all user preferences

$| = 1;

my @ids;
my %fudged;

sub header_or_empty ($$) {
    my ($mail, $hdr) = @_;
    my $value = $mail->get_header($hdr);
    if (defined $value) {
	chomp $value;
	return $value;
    }
    return '';
}

for (;;) {
    if (-f 'spamscan-stop') {
	print "spamscan-stop file created\n";
	last;
    }
    if (-e $user_prefs) {
	if ($user_prefs_time != (stat $user_prefs)[9]) {
	    # stop and wait to be re-invoked from cron
	    last;
	}
    }

    if (!@ids) {
	opendir DIR, 'incoming' or die "opendir incoming: $!";
	while (defined($_ = readdir DIR)) {
	    push @ids, $1 if /^S(.*)/;
	}
	last unless @ids;
	@ids = sort @ids;
    }

    my $nf = @ids;
    my $id = shift @ids;
    unless (rename "incoming/S$id", "incoming/R$id") {
	if ($fudged{$id}) {
	    die "$id already fudged once! $!\n";
	}
	$fudged{$id} = 1;
	next;
    }

    print "[$nf] $id scanning ...\n" or die "print log: $!";

    open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
    my @textarray;
    # Kludge to work around Received: then From_ weirdness in receive;
    # remove when receive is fixed? We may continue to need it for
    # reprocessing old messages.
    $textarray[0] = <MESSAGE>;
    if ($textarray[0] =~ /^Received:/) {
	my $maybefrom = <MESSAGE>;
	if ($maybefrom =~ /^From /) {
	    $textarray[1] = $textarray[0];
	    $textarray[0] = $maybefrom;
	} else {
	    $textarray[1] = $maybefrom;
	}
    }
    push @textarray, <MESSAGE>;
    close MESSAGE;
    my $mail = $spam->parse(\@textarray);

    my $messageid = header_or_empty($mail, 'Message-Id');
    print "  From: ", header_or_empty($mail, 'From'), "\n";
    print "  Subject: ", header_or_empty($mail, 'Subject'), "\n";
    print "  Date: ", header_or_empty($mail, 'Date'), "\n";
    print "  Message-Id: $messageid\n";
    my $ca_score = ca_set(ca_keys($mail->get_body));
    if (exists $spamseen{$messageid}) {
	# XXX THIS DOES NOT DO LOCKING
	open  OUT, ">> $gSpamMailbox" or die "open $gSpamMailbox failed: $!";
	print OUT $mail->get_pristine or die "print $gSpamMailbox failed: $!";
	close OUT or die "close $gSpamMailbox failed: $!";
	unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
	print "  spam $spamseen{$messageid} duplicate\n"
	    or die "printf log: $!";
    } else {
	my $status = $spam->check($mail);
	my $munged_mail = $status->rewrite_mail();

	if ($status->is_spam()) {
	    # XXX THIS DOES NOT DO LOCKING
	    open OUT, ">> $gSpamMailbox" or die "open $gSpamMailbox failed: $!";
	    print OUT $munged_mail or die "print $gSpamMailbox failed: $!";
	    close OUT  or die "close $gSpamMailbox failed: $!";
	    unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
	    my $score = sprintf "%.1f/%.1f %d",
	        $status->get_score(), $status->get_required_score(), $ca_score;
	    print "  spam $score\n" or die "print log: $!";
	    $spamseen{$messageid} = $score;
	} elsif ($status->get_score() > 0 && $ca_score >= 4) {
	    # XXX THIS DOES NOT DO LOCKING
	    open OUT, ">> $gCrossMailbox" or die "open $gCrossMailbox failed: $!";
	    print OUT $munged_mail or die "print $gCrossMailbox failed: $!";
	    close OUT  or die "close $gCrossMailbox failed: $!";
	    unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
	    my $score = sprintf "%.1f/%.1f %d",
	        $status->get_score(), $status->get_required_score(), $ca_score;
	    printf "  spam $score\n" or die "printf log: $!";
	    $spamseen{$messageid} = $score;
	} else {
	    open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
	    my ($received,$from,$rest_of_message) = split /\n/, $munged_mail, 3;
	    my ($headers,$body) = split /\n\n/, $rest_of_message, 2;
	    if ($received =~ /^From /) {
		($received,$from) = ($from,$received);
	    }
	    print OUT map { "$_\n"} ($received,$from,$headers) or die "print incoming/I$id: $!";
	    if ($ca_score > 1) {
		print OUT "X-CrossAssassin-Score: $ca_score\n"
		    or die "print incoming/I$id: $!";
	    }
	    print OUT "\n" or die "print incoming/I$id: $!";
	    print OUT $body or die "print incoming/I$id: $!";
	    close OUT or die "close incoming/I$id: $!";
	    unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
	    printf "  ok %.1f/%.1f %d\n",
	    	$status->get_score(), $status->get_required_score(), $ca_score
	        or die "printf log: $!";
	}

	$status->finish();
    }
    $mail->finish;
}
&unfilelock;

exit 0;