scripts/spamscan.in

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