2 # spamassassin handling split from spamscan
5 # unfortunatly we can't use strict;
7 use lib qw(/usr/lib/debbugs);
8 use Mail::CrossAssassin;
10 use Mail::SpamAssassin;
11 use Mail::SpamAssassin::NoMailAudit;
13 my $config_path = '/etc/debbugs';
14 require "$config_path/config";
15 # New versions of debbugs will not allow use in /etc/debbugs/config
16 use POSIX qw(strftime);
17 $gSpamMailbox = strftime($gSpamMailbox,gmtime);
18 $gCrossMailbox = strftime($gCrossMailbox,gmtime);
24 sub header_or_empty ($$) {
25 my ($mail, $hdr) = @_;
26 my $value = $mail->get_header($hdr);
35 my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
37 my $spam = Mail::SpamAssassin->new({
39 site_rules_filename => $gSpamRulesDir,
40 userprefs_filename => $user_prefs,
41 local_tests_only => ($gSpamLocalTestsOnly || 0),
42 debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
44 $spam->compile_now(1); # use all user preferences
46 while (my $id = <STDIN>) {
48 my $nf = <STDIN> or die "Could not read nf: $!";
50 unless (rename "incoming/S$id", "incoming/R$id") {
51 die "Could not rename incoming/S$id: $!";
53 my $out = "[$nf] $id scanning ...\n";
54 open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
56 # Kludge to work around Received: then From_ weirdness in receive;
57 # remove when receive is fixed? We may continue to need it for
58 # reprocessing old messages.
59 $textarray[0] = <MESSAGE>;
60 if ($textarray[0] =~ /^Received:/) {
61 my $maybefrom = <MESSAGE>;
62 if ($maybefrom =~ /^From /) {
63 $textarray[1] = $textarray[0];
64 $textarray[0] = $maybefrom;
66 $textarray[1] = $maybefrom;
69 push @textarray, <MESSAGE>;
71 my $mail = Mail::SpamAssassin::NoMailAudit->new(data => \@textarray);
74 my $messageid = header_or_empty($mail, 'Message-Id');
75 $out .= " From: " . header_or_empty($mail, 'From') . "\n";
76 $out .= " Subject: ". header_or_empty($mail, 'Subject') . "\n";
77 $out .= " Date: " . header_or_empty($mail, 'Date') . "\n";
78 $out .= " Message-Id: $messageid\n";
79 my $keys = ca_keys($mail->get_body);
80 print "$keys\n$messageid\n"
81 or die "Could not send keys: $!";
82 my $ca_score = <STDIN> or die "Could not read ca_score: $!";
85 my $seen = <STDIN> or die "Child could not read seen: $!";
91 $out .= " spam $seen duplicate\n";
93 $status = $spam->check($mail);
94 $status->rewrite_mail();
96 if ($status->is_spam()) {
97 # $mail->accept($gSpamMailbox);
98 # unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
100 my $score = sprintf "%.1f/%.1f %d",
101 $status->get_hits(), $status->get_required_hits(),
103 $out .= " spam $score\n";
105 } elsif ($status->get_hits() > 0 && $ca_score >= $gMaxCross) {
106 # $mail->accept($gCrossMailbox);
107 # unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
109 my $score = sprintf "%.1f/%.1f %d",
110 $status->get_hits(), $status->get_required_hits(), $ca_score;
111 $out .= " spam $score\n";
114 open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
115 my @headers = $mail->get_all_headers();
116 if ($headers[0] =~ /^From /) {
117 my $from = $headers[0];
118 $headers[0] = $headers[1];
121 print OUT join '', @headers or die "print incoming/I$id: $!";
123 print OUT "X-CrossAssassin-Score: $ca_score\n"
124 or die "print incoming/I$id: $!";
126 print OUT "\n" or die "print incoming/I$id: $!";
127 print OUT @{$mail->get_body()} or die "print incoming/I$id: $!";
128 close OUT or die "close incoming/I$id: $!";
129 unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
130 $out .= sprintf " ok %.1f/%.1f %d\n",
131 $status->get_hits(), $status->get_required_hits(),
138 open OUT, '>>', ($todo == 1) ? $gSpamMailbox : $gCrossMailbox
139 or die "Could not open assassinated: $!";
140 my @headers = $mail->get_all_headers();
142 or die "print assassinated: $!";
144 or die "print assassinated: $!";
145 foreach (@{$mail->get_body()}) {
148 or die "print assassinated: $!";
150 close OUT or die "Close assassinated: $!";
151 unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
154 print "$nseen\n$out\n";
155 $status->finish() unless($seen);