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 warnings;
   8 use strict;
   9
  10 use lib qw(/srv/bugs.debian.org/scripts/);
  11
  12 use Mail::CrossAssassin;
  13 use Mail::SpamAssassin;
  14 use Mail::SpamAssassin::Logger;
  15
  16 use Debbugs::Config qw(:config);
  17 # New versions of debbugs will not allow use in /etc/debbugs/config
  18 use POSIX qw(strftime);
  19 my $spam_mailbox = strftime($config{spam_mailbox},gmtime);
  20 my $cross_mailbox = strftime($config{spam_crossassassin_mailbox},gmtime);
  21
  22 umask 002;
  23 $| = 1;
  24 STDOUT->autoflush(1);
  25
  26 sub header_or_empty ($$) {
  27     my ($mail, $hdr) = @_;
  28     my $value = $mail->get_header($hdr);
  29     if (defined $value) {
  30         chomp $value;
  31         # replace newlines with '\n'
  32         $value =~ s/\n/\\n/g;
  33         return $value;
  34     }
  35     return '';
  36 }
  37
  38 my $spam = Mail::SpamAssassin->new({
  39         #dont_copy_prefs => 1,
  40 #       debug => 'all',
  41         #site_rules_filename => $config{spam_rules_dir},
  42         #userprefs_filename => $config{spam_user_prefs},
  43                 local_tests_only => ($config{spam_local_tests_only} || 0),
  44                 debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
  45 });
  46 #Mail::SpamAssassin::Logger::add(method => 'file',filename => "/home/debbugs/.spamassassin/debuglog_".time."_$$");
  47 # wait longer for a lock
  48 $spam->init_learner({wait_for_lock => 1});
  49
  50 $spam->compile_now(1); # use all user preferences
  51
  52 while (my $id = <STDIN>) {
  53     chomp $id;
  54     my $nf = <STDIN>;
  55     if (not defined $nf) {
  56          die "Could not read nf: $!";
  57     }
  58     chomp $nf;
  59     unless (rename "incoming/S$id", "incoming/R$id") {
  60         die "Could not rename incoming/S$id: $!";
  61     }
  62     my $out = "[$nf] $id scanning ...\n";
  63     open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
  64     # Kludge to work around Received: then From_ weirdness in receive;
  65     # remove when receive is fixed? We may continue to need it for
  66     # reprocessing old messages.
  67     my @textarray = <MESSAGE>;
  68     if ($textarray[0] !~ /^From /) {
  69         ($textarray[0], $textarray[1]) = ($textarray[1], $textarray[0]);
  70     }
  71     close MESSAGE;
  72     my $mail = $spam->parse(\@textarray);
  73
  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>;
  83     die "Could not read ca_score: $!" if not defined $ca_score;
  84     chomp $ca_score;
  85     my $todo = 0;
  86     my ($headers, $body);
  87     my $seen = <STDIN>;
  88     die "Child could not read seen: $!" if not defined $seen;
  89     chomp $seen;
  90     my $status;
  91     my $nseen = $seen;
  92     if ($seen) {
  93         $todo = 1;
  94         $headers = join('',$mail->get_all_headers());
  95         $body = join('', @{$mail->get_body()});
  96         $out .= "  spam $seen duplicate\n";
  97     } else {
  98         $status = $spam->check($mail);
  99         ($headers, $body) = split /\n\n/, $status->rewrite_mail(), 2;
 100         $headers .= "\n";
 101         $body .= "\n";
 102
 103         if ($status->is_spam()) {
 104             $todo = 1;
 105             my $score = sprintf "%.1f/%.1f %d",
 106                     $status->get_score(), $status->get_required_score(),
 107                     $ca_score;
 108             $out .= "  spam $score\n";
 109             $nseen = $score;
 110         } elsif ($status->get_score() > 0 && $ca_score >= $config{spam_max_cross}) {
 111             $todo = 2;
 112             my $score = sprintf "%.1f/%.1f %d",
 113             $status->get_score(), $status->get_required_score(), $ca_score;
 114             $out .= "  spam $score\n";
 115             $nseen = $score;
 116         } else {
 117             my ($before, $received, $after) = $headers =~
 118                 /(^.*?)(^Received\: \(at .*?\n)(.*$)/ms;
 119             open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
 120             print OUT $received . $before . $after
 121                 or die "print incoming/I$id: $!";
 122             if ($ca_score > 1) {
 123                 print OUT "X-CrossAssassin-Score: $ca_score\n"
 124                     or die "print incoming/I$id: $!";
 125             }
 126             print OUT "\n" or die "print incoming/I$id: $!";
 127             print OUT $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_score(), $status->get_required_score(),
 132                     $ca_score;
 133         }
 134     }
 135     print "$todo\n";
 136     <STDIN>;
 137     if ($todo) {
 138         open OUT, '>>', ($todo == 1) ? $spam_mailbox : $cross_mailbox
 139             or die "Could not open assassinated: $!";
 140         print OUT $headers or die "print assassinated: $!";
 141         if ($ca_score > 1) {
 142             print OUT "X-CrossAssassin-Score: $ca_score\n"
 143                 or die "print assassinated: $!";
 144         }
 145         print OUT "\n" or die "print assassinated: $!";
 146         $body =~ s/^From />From /gm;
 147         print OUT $body or die "print assassinated: $!";
 148         close OUT or die "Close assassinated: $!";
 149         unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 150     }
 151     $out =~ tr/\n/\r/;
 152     print "$nseen\n$out\n";
 153     $status->finish() unless($seen);
 154     $mail->finish();
 155 }