scripts/spamscan.in

   1 #! /usr/bin/perl -T
   2 # $Id: spamscan.in,v 1.7 2004/01/14 19:41:18 cjwatson 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 umask 002;
  30
  31 eval {
  32     &filelock('incoming-spamscan');
  33 };
  34 exit if $@;
  35
  36 my $user_prefs = "$ENV{HOME}/.spamassassin/user_prefs";
  37 my $user_prefs_time;
  38 if (-e $user_prefs) {
  39     $user_prefs_time = (stat $user_prefs)[9];
  40 }
  41
  42 my $spam = Mail::SpamAssassin->new({
  43     dont_copy_prefs => 1,
  44     site_rules_filename => $gSpamRulesDir,
  45     userprefs_filename => $user_prefs,
  46     local_tests_only => ($gSpamLocalTestsOnly || 0),
  47     debug => ($ENV{DEBBUGS_SPAM_DEBUG} || 0),
  48 });
  49 $spam->compile_now(1); # use all user preferences
  50
  51 $| = 1;
  52
  53 my @ids;
  54 my %fudged;
  55
  56 sub header_or_empty ($$) {
  57     my ($mail, $hdr) = @_;
  58     my $value = $mail->get_header($hdr);
  59     if (defined $value) {
  60         chomp $value;
  61         return $value;
  62     }
  63     return '';
  64 }
  65
  66 for (;;) {
  67     if (-f 'spamscan-stop') {
  68         print "spamscan-stop file created\n";
  69         last;
  70     }
  71     if (-e $user_prefs) {
  72         if ($user_prefs_time != (stat $user_prefs)[9]) {
  73             # stop and wait to be re-invoked from cron
  74             last;
  75         }
  76     }
  77
  78     if (!@ids) {
  79         opendir DIR, 'incoming' or die "opendir incoming: $!";
  80         while (defined($_ = readdir DIR)) {
  81             push @ids, $1 if /^S(.*)/;
  82         }
  83         last unless @ids;
  84         @ids = sort @ids;
  85     }
  86
  87     my $nf = @ids;
  88     my $id = shift @ids;
  89     unless (rename "incoming/S$id", "incoming/R$id") {
  90         if ($fudged{$id}) {
  91             die "$id already fudged once! $!\n";
  92         }
  93         $fudged{$id} = 1;
  94         next;
  95     }
  96
  97     print "[$nf] $id scanning ...\n" or die "print log: $!";
  98
  99     open MESSAGE, "< incoming/R$id" or die "open incoming/R$id: $!";
 100     my @textarray;
 101     # Kludge to work around Received: then From_ weirdness in receive;
 102     # remove when receive is fixed? We may continue to need it for
 103     # reprocessing old messages.
 104     $textarray[0] = <MESSAGE>;
 105     if ($textarray[0] =~ /^Received:/) {
 106         my $maybefrom = <MESSAGE>;
 107         if ($maybefrom =~ /^From /) {
 108             $textarray[1] = $textarray[0];
 109             $textarray[0] = $maybefrom;
 110         } else {
 111             $textarray[1] = $maybefrom;
 112         }
 113     }
 114     push @textarray, <MESSAGE>;
 115     close MESSAGE;
 116     my $mail = Mail::SpamAssassin::NoMailAudit->new(data => \@textarray);
 117     $mail->{noexit} = 1;
 118
 119     print "  From: ", header_or_empty($mail, 'From'), "\n";
 120     print "  Subject: ", header_or_empty($mail, 'Subject'), "\n";
 121     print "  Date: ", header_or_empty($mail, 'Date'), "\n";
 122     print "  Message-Id: ", header_or_empty($mail, 'Message-Id'), "\n";
 123     my $status = $spam->check($mail);
 124     $status->rewrite_mail();
 125
 126     if ($status->is_spam()) {
 127         $mail->accept($gSpamMailbox);
 128         unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 129         printf "  spam %.1f/%.1f\n",
 130                $status->get_hits(), $status->get_required_hits()
 131             or die "printf log: $!";
 132     } else {
 133         open OUT, "> incoming/I$id" or die "open incoming/I$id: $!";
 134         my @headers = $mail->get_all_headers();
 135         if ($headers[0] =~ /^From /) {
 136             my $from = $headers[0];
 137             $headers[0] = $headers[1];
 138             $headers[1] = $from;
 139         }
 140         print OUT join '', @headers or die "print incoming/I$id: $!";
 141         print OUT "\n" or die "print incoming/I$id: $!";
 142         print OUT @{$mail->get_body()} or die "print incoming/I$id: $!";
 143         close OUT or die "close incoming/I$id: $!";
 144         unlink "incoming/R$id" or warn "unlink incoming/R$id: $!";
 145         printf "  ok %.1f/%.1f\n",
 146                $status->get_hits(), $status->get_required_hits()
 147             or die "printf log: $!";
 148     }
 149
 150     $status->finish();
 151 }
 152 &unfilelock;
 153
 154 exit 0;