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)
7 use File::Temp qw/tempdir/;
10 use PublicInbox::MID qw(mid2path);
12 my $mda = "blib/script/public-inbox-mda";
13 my $learn = "blib/script/public-inbox-learn";
14 my $tmpdir = tempdir('pi-mda-XXXXXX', TMPDIR => 1, CLEANUP => 1);
15 my $home = "$tmpdir/pi-home";
16 my $pi_home = "$home/.public-inbox";
17 my $pi_config = "$pi_home/config";
18 my $maindir = "$tmpdir/main.git";
19 my $main_bin = getcwd()."/t/main-bin";
20 my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock
21 my $fail_bin = getcwd()."/t/fail-bin";
22 my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc spam mock
23 my $addr = 'test-public@example.com';
24 my $cfgpfx = "publicinbox.test";
25 my $faildir = "$home/faildir/";
29 ok(-x "$main_bin/spamc",
30 "spamc ham mock found (run in top of source tree");
31 ok(-x "$fail_bin/spamc",
32 "spamc mock found (run in top of source tree");
33 ok(-x $mda, "$mda is executable");
34 is(1, mkdir($home, 0755), "setup ~/ for testing");
35 is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox");
36 is(0, system(qw(git init -q --bare), $maindir), "git init (main)");
39 "$cfgpfx.address" => $addr,
40 "$cfgpfx.mainrepo" => $maindir,
42 while (my ($k,$v) = each %cfg) {
43 is(0, system(qw(git config --file), $pi_config, $k, $v),
48 local $ENV{GIT_COMMITTER_NAME} = eval {
50 use PublicInbox::Address;
51 use Encode qw/encode/;
52 my $mbox = 't/utf8.mbox';
53 open(my $fh, '<', $mbox) or die "failed to open mbox: $mbox\n";
54 my $str = eval { local $/; <$fh> };
56 my $msg = Email::MIME->new($str);
58 my $from = $msg->header('From');
59 my $author = PublicInbox::Address::from_name($from);
60 my ($email) = PublicInbox::Address::emails($from);
61 my $date = $msg->header('Date');
64 encode('us-ascii', my $tmp = $author, Encode::HTMLCREF),
65 'HTML conversion is correct');
66 is($email, 'e@example.com', 'email parsed correctly');
67 is($date, 'Thu, 01 Jan 1970 00:00:00 +0000',
68 'message date parsed correctly');
75 local $ENV{PI_EMERGENCY} = $faildir;
76 local $ENV{HOME} = $home;
77 local $ENV{ORIGINAL_RECIPIENT} = $addr;
78 my $simple = Email::Simple->new(<<EOF);
79 From: Me <me\@example.com>
80 To: You <you\@example.com>
82 Message-Id: <blah\@example.com>
84 Date: Thu, 01 Jan 1970 00:00:00 +0000
87 my $in = $simple->as_string;
89 # ensure successful message delivery
91 local $ENV{PATH} = $main_path;
93 my $rev = `git --git-dir=$maindir rev-list HEAD`;
94 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
96 my $cmt = `git --git-dir=$maindir cat-file commit $rev`;
97 like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
98 "author info set correctly");
99 like($cmt, qr/^committer test <test-public\@example\.com>/m,
100 "committer info set correctly");
104 # ensure failures work, fail with bad spamc
106 my @prev = <$faildir/new/*>;
107 is(scalar @prev, 0 , "nothing in PI_EMERGENCY before");
108 local $ENV{PATH} = $fail_path;
110 my @revs = `git --git-dir=$maindir rev-list HEAD`;
111 is(scalar @revs, 1, "bad revision not committed");
112 my @new = <$faildir/new/*>;
113 is(scalar @new, 1, "PI_EMERGENCY is written to");
116 fail_bad_header($good_rev, "bad recipient", <<"");
117 From: Me <me\@example.com>
118 To: You <you\@example.com>
119 Message-Id: <bad-recipient\@example.com>
121 Date: Thu, 01 Jan 1970 00:00:00 +0000
123 my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
124 From: Me <me\@example.com>
125 To: You <you\@example.com>
127 Message-ID: <blah\@example.com>
129 Date: Thu, 01 Jan 1970 00:00:00 +0000
131 like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
133 fail_bad_header($good_rev, "missing From:", <<"");
135 Message-ID: <missing-from\@example.com>
137 Date: Thu, 01 Jan 1970 00:00:00 +0000
139 fail_bad_header($good_rev, "short subject:", <<"");
141 From: cat\@example.com
142 Message-ID: <short-subject\@example.com>
144 Date: Thu, 01 Jan 1970 00:00:00 +0000
146 fail_bad_header($good_rev, "no date", <<"");
149 Message-ID: <no-date\@example.com>
152 fail_bad_header($good_rev, "bad date", <<"");
155 Message-ID: <bad-date\@example.com>
163 local $ENV{PI_EMERGENCY} = $faildir;
164 local $ENV{HOME} = $home;
165 local $ENV{ORIGINAL_RECIPIENT} = $addr;
166 local $ENV{PATH} = $main_path;
167 my $mid = 'spam-train@example.com';
168 my $simple = Email::Simple->new(<<EOF);
169 From: Spammer <spammer\@example.com>
170 To: You <you\@example.com>
173 Subject: this message will be trained as spam
174 Date: Thu, 01 Jan 1970 00:00:00 +0000
177 my $in = $simple->as_string;
180 # deliver the spam message, first
182 my $path = mid2path($mid);
183 my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
184 like($msg, qr/\Q$mid\E/, "message delivered");
187 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
188 local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
189 run([$learn, "spam"], \$msg);
190 is($?, 0, "no failure from learning spam");
191 run([$learn, "spam"], \$msg);
192 is($?, 0, "no failure from learning spam idempotently");
198 local $ENV{PI_EMERGENCY} = $faildir;
199 local $ENV{HOME} = $home;
200 local $ENV{ORIGINAL_RECIPIENT} = $addr;
201 local $ENV{PATH} = $main_path;
202 my $mid = 'ham-train@example.com';
203 my $simple = Email::Simple->new(<<EOF);
204 From: False-positive <hammer\@example.com>
205 To: You <you\@example.com>
208 Subject: this message will be trained as spam
209 Date: Thu, 01 Jan 1970 00:00:00 +0000
212 my $in = $simple->as_string;
215 # these should be overridden
216 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
217 local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
219 run([$learn, "ham"], \$in);
220 is($?, 0, "learned ham without failure");
221 my $path = mid2path($mid);
222 my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
223 like($msg, qr/\Q$mid\E/, "ham message delivered");
224 run([$learn, "ham"], \$in);
225 is($?, 0, "learned ham idempotently ");
227 # ensure trained email is filtered, too
228 my $html_body = "<html><body>hi</body></html>";
232 content_type => 'text/html; charset=UTF-8',
233 encoding => 'base64',
239 content_type => 'text/plain',
240 encoding => 'quoted-printable',
242 body => 'hi = "bye"',
245 $mid = 'multipart-html-sucks@11';
246 $mime = Email::MIME->create(
248 From => 'a@example.com',
251 'Message-ID' => "<$mid>",
252 'Content-Type' => 'multipart/alternative',
258 $in = $mime->as_string;
259 run([$learn, "ham"], \$in);
260 is($?, 0, "learned ham without failure");
261 my $path = mid2path($mid);
262 $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
263 like($msg, qr/<\Q$mid\E>/, "ham message delivered");
264 unlike($msg, qr/<html>/i, '<html> filtered');
270 sub fail_bad_header {
271 my ($good_rev, $msg, $in) = @_;
272 my @f = glob("$faildir/*/*");
274 my ($out, $err) = ("", "");
275 local $ENV{PATH} = $main_path;
276 run([$mda], \$in, \$out, \$err);
277 my $rev = `git --git-dir=$maindir rev-list HEAD`;
279 is($rev, $good_rev, "bad revision not commited ($msg)");
280 @f = glob("$faildir/*/*");
281 is(scalar @f, 1, "faildir written to");