#! /usr/bin/perl
# spamassassin handling split from spamscan
#

# unfortunatly we can't use strict;

use warnings;
use strict;
use Mail::CrossAssassin;
use Mail::SpamAssassin;

use Debbugs::Config qw(:config);
# New versions of debbugs will not allow use in /etc/debbugs/config
use POSIX qw(strftime);
my $spam_mailbox = strftime($config{spam_mailbox},gmtime);
my $cross_mailbox = strftime($config{spam_crossassassin_mailbox},gmtime);

umask 002;
$| = 1;
STDOUT->autoflush(1);

sub header_or_empty ($$) {
    my ($mail, $hdr) = @_;
    my $value = $mail->get_header($hdr);
    if (defined $value) {
	chomp $value;
        # replace newlines with '\n'
	$value =~ s/\n/\\n/g;
	return $value;
    }
    return '';
}

my $spam = Mail::SpamAssassin->new({
        dont_copy_prefs => 1,
        site_rules_filename => $config{spam_rules_dir},
        userprefs_filename => $config{spam_user_prefs},
        	local_tests_only => ($config{spam_local_tests_only} || 0),
        	debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
});
$spam->compile_now(1); # use all user preferences

while (my $id = <STDIN>) {
    chomp $id;
    my $nf = <STDIN>;
    if (not defined $nf) {
	 die "Could not read nf: $!";
    }
    chomp $nf;
    unless (rename "incoming/S$id", "incoming/R$id") {
	die "Could not rename incoming/S$id: $!";
    }
    my $out = "[$nf] $id scanning ...\n";
    open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
    # 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.
    my @textarray = <MESSAGE>;
    if ($textarray[0] !~ /^From /) {
	($textarray[0], $textarray[1]) = ($textarray[1], $textarray[0]);
    }
    close MESSAGE;
    my $mail = $spam->parse(\@textarray);
    
    my $messageid = header_or_empty($mail, 'Message-Id');
    $out .= "  From: " . header_or_empty($mail, 'From') . "\n";
    $out .= "  Subject: ". header_or_empty($mail, 'Subject') . "\n";
    $out .= "  Date: " . header_or_empty($mail, 'Date') . "\n";
    $out .= "  Message-Id: $messageid\n";
    my $keys = ca_keys($mail->get_body);
    print  "$keys\n$messageid\n"
	or die "Could not send keys: $!";
    my $ca_score = <STDIN>;
    die "Could not read ca_score: $!" if not defined $ca_score;
    chomp $ca_score;
    my $todo = 0;
    my ($headers, $body);
    my $seen = <STDIN>;
    die "Child could not read seen: $!" if not defined $seen;
    chomp $seen;
    my $status;
    my $nseen = $seen;
    if ($seen) {
	$todo = 1;
	$headers = join('',$mail->get_all_headers());
	$body = join('', @{$mail->get_body()});
	$out .= "  spam $seen duplicate\n";
    } else {
	$status = $spam->check($mail);
	($headers, $body) = split /\n\n/, $status->rewrite_mail(), 2;
	$headers .= "\n";
	$body .= "\n";
	
	if ($status->is_spam()) {
	    $todo = 1;
	    my $score = sprintf "%.1f/%.1f %d",
	            $status->get_score(), $status->get_required_score(),
	            $ca_score;
	    $out .= "  spam $score\n";
	    $nseen = $score;
	} elsif ($status->get_score() > 0 && $ca_score >= $config{spam_max_cross}) {
	    $todo = 2;
	    my $score = sprintf "%.1f/%.1f %d",
	    $status->get_score(), $status->get_required_score(), $ca_score;
	    $out .= "  spam $score\n";
	    $nseen = $score;
	} else {
	    my ($before, $received, $after) = $headers =~
		/(^.*?)(^Received\: \(at .*?\n)(.*$)/ms;
	    open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
	    print OUT $received . $before . $after
		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: $!";
	    $out .= sprintf "  ok %.1f/%.1f %d\n",
	    $status->get_score(), $status->get_required_score(),
	            $ca_score;
	}
    }
    print "$todo\n";
    <STDIN>;
    if ($todo) {
	open OUT, '>>', ($todo == 1) ? $spam_mailbox : $cross_mailbox
	    or die "Could not open assassinated: $!";
	print OUT $headers or die "print assassinated: $!";
	if ($ca_score > 1) {
	    print OUT "X-CrossAssassin-Score: $ca_score\n"
		or die "print assassinated: $!";
	}
	print OUT "\n" or die "print assassinated: $!";
	$body =~ s/^From />From /gm;
	print OUT $body or die "print assassinated: $!";
	close OUT or die "Close assassinated: $!";
	unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
    }
    $out =~ tr/\n/\r/;
    print "$nseen\n$out\n";
    $status->finish() unless($seen);
    $mail->finish();
}