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