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