scripts/spamscan-sa

   1 #! /usr/bin/perl
   2 # spamassassin handling split from spamscan
   3 #
   4
   5 # unfortunatly we can't use strict;
   6
   7 use lib qw(/usr/lib/debbugs);
   8 use Mail::CrossAssassin;
   9 use Mail::SpamAssassin;
  10
  11 my $config_path = '/etc/debbugs';
  12 require "$config_path/config";
  13 # New versions of debbugs will not allow use in /etc/debbugs/config
  14 use POSIX qw(strftime);
  15 $gSpamMailbox = strftime($gSpamMailbox,gmtime);
  16 $gCrossMailbox = strftime($gCrossMailbox,gmtime);
  17
  18 umask 002;
  19 $| = 1;
  20 STDOUT->autoflush(1);
  21
  22 sub header_or_empty ($$) {
  23     my ($mail, $hdr) = @_;
  24     my $value = $mail->get_header($hdr);
  25     if (defined $value) {
  26         chomp $value;
  27         $value =~ tr/\n/\\n/;
  28         return $value;
  29     }
  30     return '';
  31 }
  32
  33 my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
  34
  35 my $spam = Mail::SpamAssassin->new({
  36         dont_copy_prefs => 1,
  37         site_rules_filename => $gSpamRulesDir,
  38         userprefs_filename => $user_prefs,
  39                 local_tests_only => ($gSpamLocalTestsOnly || 0),
  40                 debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
  41 });
  42 $spam->compile_now(1); # use all user preferences
  43
  44 while (my $id = <STDIN>) {
  45     chomp $id;
  46     my $nf = <STDIN> or die "Could not read nf: $!";
  47     chomp $nf;
  48     unless (rename "incoming/S$id", "incoming/R$id") {
  49         die "Could not rename incoming/S$id: $!";
  50     }
  51     my $out = "[$nf] $id scanning ...\n";
  52     open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
  53     # Kludge to work around Received: then From_ weirdness in receive;
  54     # remove when receive is fixed? We may continue to need it for
  55     # reprocessing old messages.
  56     my @textarray = <MESSAGE>;
  57     if ($textarray[0] !~ /^From /) {
  58         ($textarray[0], $textarray[1]) = ($textarray[1], $textarray[0]);
  59     }
  60     close MESSAGE;
  61     my $mail = $spam->parse(\@textarray);
  62
  63     my $messageid = header_or_empty($mail, 'Message-Id');
  64     $out .= "  From: " . header_or_empty($mail, 'From') . "\n";
  65     $out .= "  Subject: ". header_or_empty($mail, 'Subject') . "\n";
  66     $out .= "  Date: " . header_or_empty($mail, 'Date') . "\n";
  67     $out .= "  Message-Id: $messageid\n";
  68     my $keys = ca_keys($mail->get_body);
  69     print  "$keys\n$messageid\n"
  70         or die "Could not send keys: $!";
  71     my $ca_score = <STDIN> or die "Could not read ca_score: $!";
  72     chomp $ca_score;
  73     my $todo = 0;
  74     my ($headers, $body);
  75     my $seen = <STDIN> or die "Child could not read seen: $!";
  76     chomp $seen;
  77     my $status;
  78     my $nseen = $seen;
  79     if ($seen) {
  80         $todo = 1;
  81         $headers = join('',$mail->get_all_headers());
  82         $body = join('', @{$mail->get_body()});
  83         $out .= "  spam $seen duplicate\n";
  84     } else {
  85         $status = $spam->check($mail);
  86         ($headers, $body) = split /\n\n/, $status->rewrite_mail(), 2;
  87         $headers .= "\n";
  88         $body .= "\n";
  89
  90         if ($status->is_spam()) {
  91             $todo = 1;
  92             my $score = sprintf "%.1f/%.1f %d",
  93                     $status->get_score(), $status->get_required_score(),
  94                     $ca_score;
  95             $out .= "  spam $score\n";
  96             $nseen = $score;
  97         } elsif ($status->get_score() > 0 && $ca_score >= $gMaxCross) {
  98             $todo = 2;
  99             my $score = sprintf "%.1f/%.1f %d",
 100             $status->get_score(), $status->get_required_score(), $ca_score;
 101             $out .= "  spam $score\n";
 102             $nseen = $score;
 103         } else {
 104             my ($before, $received, $after) = $headers =~
 105                 /(^.*?)(^Received\: \(at .*?\n)(.*$)/ms;
 106             open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
 107             print OUT $received . $before . $after
 108                 or die "print incoming/I$id: $!";
 109             if ($ca_score > 1) {
 110                 print OUT "X-CrossAssassin-Score: $ca_score\n"
 111                     or die "print incoming/I$id: $!";
 112             }
 113             print OUT "\n" or die "print incoming/I$id: $!";
 114             print OUT $body or die "print incoming/I$id: $!";
 115             close OUT or die "close incoming/I$id: $!";
 116             unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 117             $out .= sprintf "  ok %.1f/%.1f %d\n",
 118             $status->get_score(), $status->get_required_score(),
 119                     $ca_score;
 120         }
 121     }
 122     print "$todo\n";
 123     <STDIN>;
 124     if ($todo) {
 125         open OUT, '>>', ($todo == 1) ? $gSpamMailbox : $gCrossMailbox
 126             or die "Could not open assassinated: $!";
 127         print OUT $headers or die "print assassinated: $!";
 128         if ($ca_score > 1) {
 129             print OUT "X-CrossAssassin-Score: $ca_score\n"
 130                 or die "print assassinated: $!";
 131         }
 132         print OUT "\n" or die "print assassinated: $!";
 133         $body =~ s/^From />From /gm;
 134         print OUT $body or die "print assassinated: $!";
 135         close OUT or die "Close assassinated: $!";
 136         unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 137     }
 138     $out =~ tr/\n/\r/;
 139     print "$nseen\n$out\n";
 140     $status->finish() unless($seen);
 141     $mail->finish();
 142 }