scripts/spamscan.in

   1 #! /usr/bin/perl -T
   2 # $Id: spamscan.in,v 1.8 2005/02/01 07:54:01 blarson Exp $
   3 #
   4 # Usage: spamscan
   5 #
   6 # Performs SpamAssassin checks on a message before allowing it through to
   7 # the main incoming queue.
   8 #
   9 # Uses up: incoming/S<code><bugnum>.nn
  10 # Temps:   incoming/R.nn
  11 # Creates: incoming/I.nn
  12 # Stop:    spamscan-stop
  13
  14 $config_path = '/etc/debbugs';
  15 $lib_path = '/usr/lib/debbugs';
  16
  17 require "$config_path/config";
  18 require "$lib_path/errorlib";
  19 $ENV{PATH} = $lib_path . ':' . $ENV{PATH};
  20
  21 exit unless $gSpamScan;
  22
  23 chdir $gSpoolDir or die "chdir spool: $!\n";
  24 push @INC, $lib_path;
  25
  26 use Mail::SpamAssassin;
  27 use Mail::SpamAssassin::NoMailAudit;
  28
  29 use lib '/usr/lib/debbugs';
  30 use Mail::CrossAssassin;
  31
  32 umask 002;
  33
  34 eval {
  35     &filelock('incoming-spamscan');
  36 };
  37 exit if $@;
  38
  39 ca_init('\b\d{3,8}(?:-(?:close|done|forwarded|maintonly|submitter|quiet))?\@bugs\.debian\.org', '/org/bugs.debian.org/CrossAssassinDb');
  40
  41 my %spamseen = ();
  42
  43 my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
  44 my $user_prefs_time;
  45 if (-e $user_prefs) {
  46     $user_prefs_time = (stat $user_prefs)[9];
  47 }
  48
  49 my $spam = Mail::SpamAssassin->new({
  50     dont_copy_prefs => 1,
  51     site_rules_filename => $gSpamRulesDir,
  52     userprefs_filename => $user_prefs,
  53     local_tests_only => ($gSpamLocalTestsOnly || 0),
  54     debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
  55     check_mx_delay => 2, # bit of a hack until we have parallelization
  56 });
  57 $spam->compile_now(1); # use all user preferences
  58
  59 $| = 1;
  60
  61 my @ids;
  62 my %fudged;
  63
  64 sub header_or_empty ($$) {
  65     my ($mail, $hdr) = @_;
  66     my $value = $mail->get_header($hdr);
  67     if (defined $value) {
  68         chomp $value;
  69         return $value;
  70     }
  71     return '';
  72 }
  73
  74 for (;;) {
  75     if (-f 'spamscan-stop') {
  76         print "spamscan-stop file created\n";
  77         last;
  78     }
  79     if (-e $user_prefs) {
  80         if ($user_prefs_time != (stat $user_prefs)[9]) {
  81             # stop and wait to be re-invoked from cron
  82             last;
  83         }
  84     }
  85
  86     if (!@ids) {
  87         opendir DIR, 'incoming' or die "opendir incoming: $!";
  88         while (defined($_ = readdir DIR)) {
  89             push @ids, $1 if /^S(.*)/;
  90         }
  91         last unless @ids;
  92         @ids = sort @ids;
  93     }
  94
  95     my $nf = @ids;
  96     my $id = shift @ids;
  97     unless (rename "incoming/S$id", "incoming/R$id") {
  98         if ($fudged{$id}) {
  99             die "$id already fudged once! $!\n";
 100         }
 101         $fudged{$id} = 1;
 102         next;
 103     }
 104
 105     print "[$nf] $id scanning ...\n" or die "print log: $!";
 106
 107     open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
 108     my @textarray;
 109     # Kludge to work around Received: then From_ weirdness in receive;
 110     # remove when receive is fixed? We may continue to need it for
 111     # reprocessing old messages.
 112     $textarray[0] = <MESSAGE>;
 113     if ($textarray[0] =~ /^Received:/) {
 114         my $maybefrom = <MESSAGE>;
 115         if ($maybefrom =~ /^From /) {
 116             $textarray[1] = $textarray[0];
 117             $textarray[0] = $maybefrom;
 118         } else {
 119             $textarray[1] = $maybefrom;
 120         }
 121     }
 122     push @textarray, <MESSAGE>;
 123     close MESSAGE;
 124     my $mail = Mail::SpamAssassin::NoMailAudit->new(data => \@textarray);
 125     $mail->{noexit} = 1;
 126
 127     my $messageid = header_or_empty($mail, 'Message-Id');
 128     print "  From: ", header_or_empty($mail, 'From'), "\n";
 129     print "  Subject: ", header_or_empty($mail, 'Subject'), "\n";
 130     print "  Date: ", header_or_empty($mail, 'Date'), "\n";
 131     print "  Message-Id: $messageid\n";
 132     my $ca_score = ca_set(ca_keys($mail->get_body));
 133     if (exists $spamseen{$messageid}) {
 134         $mail->accept($gSpamMailbox);
 135         unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 136         print "  spam $spamseen{$messageid} duplicate\n"
 137             or die "printf log: $!";
 138     } else {
 139         my $status = $spam->check($mail);
 140         $status->rewrite_mail();
 141
 142         if ($status->is_spam()) {
 143             $mail->accept($gSpamMailbox);
 144             unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 145             my $score = sprintf "%.1f/%.1f %d",
 146                 $status->get_hits(), $status->get_required_hits(), $ca_score;
 147             print "  spam $score\n" or die "print log: $!";
 148             $spamseen{$messageid} = $score;
 149         } elsif ($status->get_hits() > 0 && $ca_score >= 4) {
 150             $mail->accept($gCrossMailbox);
 151             unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 152             my $score = sprintf "%.1f/%.1f %d",
 153                 $status->get_hits(), $status->get_required_hits(), $ca_score;
 154             printf "  spam $score\n" or die "printf log: $!";
 155             $spamseen{$messageid} = $score;
 156         } else {
 157             open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
 158             my @headers = $mail->get_all_headers();
 159             if ($headers[0] =~ /^From /) {
 160                 my $from = $headers[0];
 161                 $headers[0] = $headers[1];
 162                 $headers[1] = $from;
 163             }
 164             print OUT join '', @headers or die "print incoming/I$id: $!";
 165             if ($ca_score > 1) {
 166                 print OUT "X-CrossAssassin-Score: $ca_score\n"
 167                     or die "print incoming/I$id: $!";
 168             }
 169             print OUT "\n" or die "print incoming/I$id: $!";
 170             print OUT @{$mail->get_body()} or die "print incoming/I$id: $!";
 171             close OUT or die "close incoming/I$id: $!";
 172             unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 173             printf "  ok %.1f/%.1f %d\n",
 174                 $status->get_hits(), $status->get_required_hits(), $ca_score
 175                 or die "printf log: $!";
 176         }
 177
 178         $status->finish();
 179     }
 180 }
 181 &unfilelock;
 182
 183 exit 0;