]> Sergey Matveev's repositories - public-inbox.git/blob - t/mda.t
spamc: retry on EINTR
[public-inbox.git] / t / mda.t
1 # Copyright (C) 2014-2015 all contributors <meta@public-inbox.org>
2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
3 use strict;
4 use warnings;
5 use Test::More;
6 use Email::MIME;
7 use File::Temp qw/tempdir/;
8 use Cwd;
9 use PublicInbox::MID qw(mid2path);
10 eval { require IPC::Run };
11 plan skip_all => "missing IPC::Run for t/mda.t" if $@;
12
13 my $mda = "blib/script/public-inbox-mda";
14 my $learn = "blib/script/public-inbox-learn";
15 my $tmpdir = tempdir('pi-mda-XXXXXX', TMPDIR => 1, CLEANUP => 1);
16 my $home = "$tmpdir/pi-home";
17 my $pi_home = "$home/.public-inbox";
18 my $pi_config = "$pi_home/config";
19 my $maindir = "$tmpdir/main.git";
20 my $main_bin = getcwd()."/t/main-bin";
21 my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock
22 my $fail_bin = getcwd()."/t/fail-bin";
23 my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc spam mock
24 my $addr = 'test-public@example.com';
25 my $cfgpfx = "publicinbox.test";
26 my $faildir = "$home/faildir/";
27 my $mime;
28
29 {
30         ok(-x "$main_bin/spamc",
31                 "spamc ham mock found (run in top of source tree");
32         ok(-x "$fail_bin/spamc",
33                 "spamc mock found (run in top of source tree");
34         ok(-x $mda, "$mda is executable");
35         is(1, mkdir($home, 0755), "setup ~/ for testing");
36         is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox");
37         is(0, system(qw(git init -q --bare), $maindir), "git init (main)");
38
39         my %cfg = (
40                 "$cfgpfx.address" => $addr,
41                 "$cfgpfx.mainrepo" => $maindir,
42         );
43         while (my ($k,$v) = each %cfg) {
44                 is(0, system(qw(git config --file), $pi_config, $k, $v),
45                         "setup $k");
46         }
47 }
48
49 local $ENV{GIT_COMMITTER_NAME} = eval {
50         use PublicInbox::MDA;
51         use PublicInbox::Address;
52         use Encode qw/encode/;
53         my $mbox = 't/utf8.mbox';
54         open(my $fh, '<', $mbox) or die "failed to open mbox: $mbox\n";
55         my $str = eval { local $/; <$fh> };
56         close $fh;
57         my $msg = Email::MIME->new($str);
58
59         my $from = $msg->header('From');
60         my ($author) = PublicInbox::Address::names($from);
61         my ($email) = PublicInbox::Address::emails($from);
62         my $date = $msg->header('Date');
63
64         is('El&#233;anor',
65                 encode('us-ascii', my $tmp = $author, Encode::HTMLCREF),
66                 'HTML conversion is correct');
67         is($email, 'e@example.com', 'email parsed correctly');
68         is($date, 'Thu, 01 Jan 1970 00:00:00 +0000',
69                 'message date parsed correctly');
70         $author;
71 };
72 die $@ if $@;
73
74 {
75         my $good_rev;
76         local $ENV{PI_EMERGENCY} = $faildir;
77         local $ENV{HOME} = $home;
78         local $ENV{ORIGINAL_RECIPIENT} = $addr;
79         my $simple = Email::Simple->new(<<EOF);
80 From: Me <me\@example.com>
81 To: You <you\@example.com>
82 Cc: $addr
83 Message-Id: <blah\@example.com>
84 Subject: hihi
85 Date: Thu, 01 Jan 1970 00:00:00 +0000
86
87 EOF
88         my $in = $simple->as_string;
89
90         # ensure successful message delivery
91         {
92                 local $ENV{PATH} = $main_path;
93                 IPC::Run::run([$mda], \$in);
94                 my $rev = `git --git-dir=$maindir rev-list HEAD`;
95                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
96                 chomp $rev;
97                 my $cmt = `git --git-dir=$maindir cat-file commit $rev`;
98                 like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
99                         "author info set correctly");
100                 like($cmt, qr/^committer test <test-public\@example\.com>/m,
101                         "committer info set correctly");
102                 $good_rev = $rev;
103         }
104
105         # ensure failures work, fail with bad spamc
106         {
107                 my @prev = <$faildir/new/*>;
108                 is(scalar @prev, 0 , "nothing in PI_EMERGENCY before");
109                 local $ENV{PATH} = $fail_path;
110                 IPC::Run::run([$mda], \$in);
111                 my @revs = `git --git-dir=$maindir rev-list HEAD`;
112                 is(scalar @revs, 1, "bad revision not committed");
113                 my @new = <$faildir/new/*>;
114                 is(scalar @new, 1, "PI_EMERGENCY is written to");
115         }
116
117         fail_bad_header($good_rev, "bad recipient", <<"");
118 From: Me <me\@example.com>
119 To: You <you\@example.com>
120 Message-Id: <bad-recipient\@example.com>
121 Subject: hihi
122 Date: Thu, 01 Jan 1970 00:00:00 +0000
123
124         my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
125 From: Me <me\@example.com>
126 To: You <you\@example.com>
127 Cc: $addr
128 Message-ID: <blah\@example.com>
129 Subject: hihi
130 Date: Thu, 01 Jan 1970 00:00:00 +0000
131
132         like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
133
134         fail_bad_header($good_rev, "missing From:", <<"");
135 To: $addr
136 Message-ID: <missing-from\@example.com>
137 Subject: hihi
138 Date: Thu, 01 Jan 1970 00:00:00 +0000
139
140         fail_bad_header($good_rev, "short subject:", <<"");
141 To: $addr
142 From: cat\@example.com
143 Message-ID: <short-subject\@example.com>
144 Subject: a
145 Date: Thu, 01 Jan 1970 00:00:00 +0000
146
147         fail_bad_header($good_rev, "no date", <<"");
148 To: $addr
149 From: u\@example.com
150 Message-ID: <no-date\@example.com>
151 Subject: hihi
152
153         fail_bad_header($good_rev, "bad date", <<"");
154 To: $addr
155 From: u\@example.com
156 Message-ID: <bad-date\@example.com>
157 Subject: hihi
158 Date: deadbeef
159
160 }
161
162 # spam training
163 {
164         local $ENV{PI_EMERGENCY} = $faildir;
165         local $ENV{HOME} = $home;
166         local $ENV{ORIGINAL_RECIPIENT} = $addr;
167         local $ENV{PATH} = $main_path;
168         my $mid = 'spam-train@example.com';
169         my $simple = Email::Simple->new(<<EOF);
170 From: Spammer <spammer\@example.com>
171 To: You <you\@example.com>
172 Cc: $addr
173 Message-ID: <$mid>
174 Subject: this message will be trained as spam
175 Date: Thu, 01 Jan 1970 00:00:00 +0000
176
177 EOF
178         my $in = $simple->as_string;
179
180         {
181                 # deliver the spam message, first
182                 IPC::Run::run([$mda], \$in);
183                 my $path = mid2path($mid);
184                 my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
185                 like($msg, qr/\Q$mid\E/, "message delivered");
186
187                 # now train it
188                 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
189                 local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
190                 local $ENV{GIT_COMMITTER_NAME} = undef;
191                 IPC::Run::run([$learn, "spam"], \$msg);
192                 is($?, 0, "no failure from learning spam");
193                 IPC::Run::run([$learn, "spam"], \$msg);
194                 is($?, 0, "no failure from learning spam idempotently");
195         }
196 }
197
198 # train ham message
199 {
200         local $ENV{PI_EMERGENCY} = $faildir;
201         local $ENV{HOME} = $home;
202         local $ENV{ORIGINAL_RECIPIENT} = $addr;
203         local $ENV{PATH} = $main_path;
204         my $mid = 'ham-train@example.com';
205         my $simple = Email::Simple->new(<<EOF);
206 From: False-positive <hammer\@example.com>
207 To: You <you\@example.com>
208 Cc: $addr
209 Message-ID: <$mid>
210 Subject: this message will be trained as spam
211 Date: Thu, 01 Jan 1970 00:00:00 +0000
212
213 EOF
214         my $in = $simple->as_string;
215
216         # now train it
217         # these should be overridden
218         local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
219         local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
220
221         IPC::Run::run([$learn, "ham"], \$in);
222         is($?, 0, "learned ham without failure");
223         my $path = mid2path($mid);
224         my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
225         like($msg, qr/\Q$mid\E/, "ham message delivered");
226         IPC::Run::run([$learn, "ham"], \$in);
227         is($?, 0, "learned ham idempotently ");
228
229         # ensure trained email is filtered, too
230         my $html_body = "<html><body>hi</body></html>";
231         my $parts = [
232                 Email::MIME->create(
233                         attributes => {
234                                 content_type => 'text/html; charset=UTF-8',
235                                 encoding => 'base64',
236                         },
237                         body => $html_body,
238                 ),
239                 Email::MIME->create(
240                         attributes => {
241                                 content_type => 'text/plain',
242                                 encoding => 'quoted-printable',
243                         },
244                         body => 'hi = "bye"',
245                 )
246         ];
247         $mid = 'multipart-html-sucks@11';
248         $mime = Email::MIME->create(
249                 header_str => [
250                   From => 'a@example.com',
251                   Subject => 'blah',
252                   Cc => $addr,
253                   'Message-ID' => "<$mid>",
254                   'Content-Type' => 'multipart/alternative',
255                 ],
256                 parts => $parts,
257         );
258
259         {
260                 $in = $mime->as_string;
261                 IPC::Run::run([$learn, "ham"], \$in);
262                 is($?, 0, "learned ham without failure");
263                 my $path = mid2path($mid);
264                 $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
265                 like($msg, qr/<\Q$mid\E>/, "ham message delivered");
266                 unlike($msg, qr/<html>/i, '<html> filtered');
267         }
268 }
269
270 done_testing();
271
272 sub fail_bad_header {
273         my ($good_rev, $msg, $in) = @_;
274         my @f = glob("$faildir/*/*");
275         unlink @f if @f;
276         my ($out, $err) = ("", "");
277         local $ENV{PATH} = $main_path;
278         IPC::Run::run([$mda], \$in, \$out, \$err);
279         my $rev = `git --git-dir=$maindir rev-list HEAD`;
280         chomp $rev;
281         is($rev, $good_rev, "bad revision not commited ($msg)");
282         @f = glob("$faildir/*/*");
283         is(scalar @f, 1, "faildir written to");
284         [ $in, $out, $err ];
285 }