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 Email::Filter;
   8 use File::Temp qw/tempdir/;
   9 use Cwd;
  10 use IPC::Run qw(run);
  11
  12 my $mda = "blib/script/public-inbox-mda";
  13 my $learn = "blib/script/public-inbox-learn";
  14 my $tmpdir = tempdir(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 $failbox = "$home/fail.mbox";
  26 my $mime;
  27
  28 {
  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)");
  37
  38         my %cfg = (
  39                 "$cfgpfx.address" => $addr,
  40                 "$cfgpfx.mainrepo" => $maindir,
  41         );
  42         while (my ($k,$v) = each %cfg) {
  43                 is(0, system(qw(git config --file), $pi_config, $k, $v),
  44                         "setup $k");
  45         }
  46 }
  47
  48 local $ENV{GIT_COMMITTER_NAME} = eval {
  49         use PublicInbox::MDA;
  50         use Encode qw/encode/;
  51         my $mbox = 't/utf8.mbox';
  52         open(my $fh, '<', $mbox) or die "failed to open mbox: $mbox\n";
  53         my $str = eval { local $/; <$fh> };
  54         close $fh;
  55         my $msg = Email::Filter->new(data => $str);
  56         $msg = Email::MIME->new($msg->simple->as_string);
  57         my ($author, $email, $date) = PublicInbox::MDA->author_info($msg);
  58         is('El&#233;anor',
  59                 encode('us-ascii', my $tmp = $author, Encode::HTMLCREF),
  60                 'HTML conversion is correct');
  61         is($email, 'e@example.com', 'email parsed correctly');
  62         is($date, 'Thu, 01 Jan 1970 00:00:00 +0000',
  63                 'message date parsed correctly');
  64         $author;
  65 };
  66 die $@ if $@;
  67
  68 {
  69         my $good_rev;
  70         local $ENV{PI_EMERGENCY} = $failbox;
  71         local $ENV{HOME} = $home;
  72         local $ENV{ORIGINAL_RECIPIENT} = $addr;
  73         my $simple = Email::Simple->new(<<EOF);
  74 From: Me <me\@example.com>
  75 To: You <you\@example.com>
  76 Cc: $addr
  77 Message-Id: <blah\@example.com>
  78 Subject: hihi
  79 Date: Thu, 01 Jan 1970 00:00:00 +0000
  80
  81 EOF
  82         my $in = $simple->as_string;
  83
  84         # ensure successful message delivery
  85         {
  86                 local $ENV{PATH} = $main_path;
  87                 run([$mda], \$in);
  88                 local $ENV{GIT_DIR} = $maindir;
  89                 my $rev = `git rev-list HEAD`;
  90                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
  91                 chomp $rev;
  92                 my $cmt = `git cat-file commit $rev`;
  93                 like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
  94                         "author info set correctly");
  95                 like($cmt, qr/^committer test <test-public\@example\.com>/m,
  96                         "committer info set correctly");
  97                 $good_rev = $rev;
  98         }
  99
 100         # ensure failures work, fail with bad spamc
 101         {
 102                 ok(!-e $failbox, "nothing in PI_EMERGENCY before");
 103                 local $ENV{PATH} = $fail_path;
 104                 run([$mda], \$in);
 105                 local $ENV{GIT_DIR} = $maindir;
 106                 my @revs = `git rev-list HEAD`;
 107                 is(scalar @revs, 1, "bad revision not committed");
 108                 ok(-s $failbox > 0, "PI_EMERGENCY is written to");
 109         }
 110
 111         fail_bad_header($good_rev, "bad recipient", <<"");
 112 From: Me <me\@example.com>
 113 To: You <you\@example.com>
 114 Message-Id: <bad-recipient\@example.com>
 115 Subject: hihi
 116 Date: Thu, 01 Jan 1970 00:00:00 +0000
 117
 118         my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
 119 From: Me <me\@example.com>
 120 To: You <you\@example.com>
 121 Cc: $addr
 122 Message-ID: <blah\@example.com>
 123 Subject: hihi
 124 Date: Thu, 01 Jan 1970 00:00:00 +0000
 125
 126         like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
 127
 128         fail_bad_header($good_rev, "missing From:", <<"");
 129 To: $addr
 130 Message-ID: <missing-from\@example.com>
 131 Subject: hihi
 132 Date: Thu, 01 Jan 1970 00:00:00 +0000
 133
 134         fail_bad_header($good_rev, "short subject:", <<"");
 135 To: $addr
 136 From: cat\@example.com
 137 Message-ID: <short-subject\@example.com>
 138 Subject: a
 139 Date: Thu, 01 Jan 1970 00:00:00 +0000
 140
 141         fail_bad_header($good_rev, "no date", <<"");
 142 To: $addr
 143 From: u\@example.com
 144 Message-ID: <no-date\@example.com>
 145 Subject: hihi
 146
 147         fail_bad_header($good_rev, "bad date", <<"");
 148 To: $addr
 149 From: u\@example.com
 150 Message-ID: <bad-date\@example.com>
 151 Subject: hihi
 152 Date: deadbeef
 153
 154 }
 155
 156 # spam training
 157 {
 158         local $ENV{PI_EMERGENCY} = $failbox;
 159         local $ENV{HOME} = $home;
 160         local $ENV{ORIGINAL_RECIPIENT} = $addr;
 161         local $ENV{PATH} = $main_path;
 162         my $mid = 'spam-train@example.com';
 163         my $simple = Email::Simple->new(<<EOF);
 164 From: Spammer <spammer\@example.com>
 165 To: You <you\@example.com>
 166 Cc: $addr
 167 Message-ID: <$mid>
 168 Subject: this message will be trained as spam
 169 Date: Thu, 01 Jan 1970 00:00:00 +0000
 170
 171 EOF
 172         my $in = $simple->as_string;
 173
 174         {
 175                 # deliver the spam message, first
 176                 run([$mda], \$in);
 177                 my $msg = `ssoma cat $mid $maindir`;
 178                 like($msg, qr/\Q$mid\E/, "message delivered");
 179
 180                 # now train it
 181                 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
 182                 local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
 183                 run([$learn, "spam"], \$msg);
 184                 is($?, 0, "no failure from learning spam");
 185                 run([$learn, "spam"], \$msg);
 186                 is($?, 0, "no failure from learning spam idempotently");
 187         }
 188 }
 189
 190 # train ham message
 191 {
 192         local $ENV{PI_EMERGENCY} = $failbox;
 193         local $ENV{HOME} = $home;
 194         local $ENV{ORIGINAL_RECIPIENT} = $addr;
 195         local $ENV{PATH} = $main_path;
 196         my $mid = 'ham-train@example.com';
 197         my $simple = Email::Simple->new(<<EOF);
 198 From: False-positive <hammer\@example.com>
 199 To: You <you\@example.com>
 200 Cc: $addr
 201 Message-ID: <$mid>
 202 Subject: this message will be trained as spam
 203 Date: Thu, 01 Jan 1970 00:00:00 +0000
 204
 205 EOF
 206         my $in = $simple->as_string;
 207
 208         # now train it
 209         # these should be overridden
 210         local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
 211         local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
 212
 213         run([$learn, "ham"], \$in);
 214         is($?, 0, "learned ham without failure");
 215         my $msg = `ssoma cat $mid $maindir`;
 216         like($msg, qr/\Q$mid\E/, "ham message delivered");
 217         run([$learn, "ham"], \$in);
 218         is($?, 0, "learned ham idempotently ");
 219
 220         # ensure trained email is filtered, too
 221         my $html_body = "<html><body>hi</body></html>";
 222         my $parts = [
 223                 Email::MIME->create(
 224                         attributes => {
 225                                 content_type => 'text/html; charset=UTF-8',
 226                                 encoding => 'base64',
 227                         },
 228                         body => $html_body,
 229                 ),
 230                 Email::MIME->create(
 231                         attributes => {
 232                                 content_type => 'text/plain',
 233                                 encoding => 'quoted-printable',
 234                         },
 235                         body => 'hi = "bye"',
 236                 )
 237         ];
 238         $mid = 'multipart-html-sucks@11';
 239         $mime = Email::MIME->create(
 240                 header_str => [
 241                   From => 'a@example.com',
 242                   Subject => 'blah',
 243                   Cc => $addr,
 244                   'Message-ID' => "<$mid>",
 245                   'Content-Type' => 'multipart/alternative',
 246                 ],
 247                 parts => $parts,
 248         );
 249
 250         {
 251                 $in = $mime->as_string;
 252                 run([$learn, "ham"], \$in);
 253                 is($?, 0, "learned ham without failure");
 254                 $msg = `ssoma cat $mid $maindir`;
 255                 like($msg, qr/<\Q$mid\E>/, "ham message delivered");
 256                 unlike($msg, qr/<html>/i, '<html> filtered');
 257         }
 258 }
 259
 260 # faildir - emergency destination is maildir
 261 {
 262         my $faildir= "$home/faildir/";
 263         local $ENV{PI_EMERGENCY} = $faildir;
 264         local $ENV{HOME} = $home;
 265         local $ENV{ORIGINAL_RECIPIENT} = $addr;
 266         local $ENV{PATH} = $fail_path;
 267         my $in = <<EOF;
 268 From: Faildir <faildir\@example.com>
 269 To: You <you\@example.com>
 270 Cc: $addr
 271 Message-ID: <faildir\@example.com>
 272 Subject: faildir subject
 273 Date: Thu, 01 Jan 1970 00:00:00 +0000
 274
 275 EOF
 276         run([$mda], \$in);
 277         ok(-d $faildir, "emergency exists");
 278         my @new = glob("$faildir/new/*");
 279         is(scalar(@new), 1, "message delivered");
 280         is(unlink(@new), 1, "removed emergency message");
 281
 282         local $ENV{PATH} = $main_path;
 283         $in = <<EOF;
 284 From: Faildir <faildir\@example.com>
 285 To: $addr
 286 Content-Type: text/html
 287 Message-ID: <faildir\@example.com>
 288 Subject: faildir subject
 289 Date: Thu, 01 Jan 1970 00:00:00 +0000
 290
 291 <html><body>bad</body></html>
 292 EOF
 293         my $out = '';
 294         my $err = '';
 295         run([$mda], \$in, \$out, \$err);
 296         isnt($?, 0, "mda exited with failure");
 297         is(length $out, 0, 'nothing in stdout');
 298         isnt(length $err, 0, 'error message in stderr');
 299
 300         @new = glob("$faildir/new/*");
 301         is(scalar(@new), 0, "new message did not show up");
 302
 303         # reject multipart again
 304         $in = $mime->as_string;
 305         $err = '';
 306         run([$mda], \$in, \$out, \$err);
 307         isnt($?, 0, "mda exited with failure");
 308         is(length $out, 0, 'nothing in stdout');
 309         isnt(length $err, 0, 'error message in stderr');
 310         @new = glob("$faildir/new/*");
 311         is(scalar(@new), 0, "new message did not show up");
 312 }
 313
 314 done_testing();
 315
 316 sub fail_bad_header {
 317         my ($good_rev, $msg, $in) = @_;
 318         open my $fh, '>', $failbox or die "failed to open $failbox: $!\n";
 319         close $fh or die "failed to close $failbox: $!\n";
 320         my ($out, $err) = ("", "");
 321         local $ENV{PATH} = $main_path;
 322         run([$mda], \$in, \$out, \$err);
 323         local $ENV{GIT_DIR} = $maindir;
 324         my $rev = `git rev-list HEAD`;
 325         chomp $rev;
 326         is($rev, $good_rev, "bad revision not commited ($msg)");
 327         ok(-s $failbox > 0, "PI_EMERGENCY is written to ($msg)");
 328         [ $in, $out, $err ];
 329 }