t/mda.t

   1 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   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 IPC::Run qw(run);
  10
  11 my $mda = "blib/script/public-inbox-mda";
  12 my $learn = "blib/script/public-inbox-learn";
  13 my $tmpdir = tempdir(CLEANUP => 1);
  14 my $home = "$tmpdir/pi-home";
  15 my $pi_home = "$home/.public-inbox";
  16 my $pi_config = "$pi_home/config";
  17 my $maindir = "$tmpdir/main.git";
  18 my $main_bin = getcwd()."/t/main-bin";
  19 my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock
  20 my $fail_bin = getcwd()."/t/fail-bin";
  21 my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc spam mock
  22 my $addr = 'test-public@example.com';
  23 my $cfgpfx = "publicinbox.test";
  24 my $failbox = "$home/fail.mbox";
  25
  26 {
  27         ok(-x "$main_bin/spamc",
  28                 "spamc ham mock found (run in top of source tree");
  29         ok(-x "$fail_bin/spamc",
  30                 "spamc mock found (run in top of source tree");
  31         ok(-x $mda, "$mda is executable");
  32         is(1, mkdir($home, 0755), "setup ~/ for testing");
  33         is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox");
  34         is(0, system(qw(git init -q --bare), $maindir), "git init (main)");
  35
  36         my %cfg = (
  37                 "$cfgpfx.address" => $addr,
  38                 "$cfgpfx.mainrepo" => $maindir,
  39         );
  40         while (my ($k,$v) = each %cfg) {
  41                 is(0, system(qw(git config --file), $pi_config, $k, $v),
  42                         "setup $k");
  43         }
  44 }
  45
  46 {
  47         my $good_rev;
  48         local $ENV{PI_FAILBOX} = $failbox;
  49         local $ENV{HOME} = $home;
  50         local $ENV{RECIPIENT} = $addr;
  51         my $simple = Email::Simple->new(<<EOF);
  52 From: Me <me\@example.com>
  53 To: You <you\@example.com>
  54 Cc: $addr
  55 Message-Id: <blah\@example.com>
  56 Subject: hihi
  57 Date: Thu, 01 Jan 1970 00:00:00 +0000
  58
  59 EOF
  60         my $in = $simple->as_string;
  61
  62         # ensure successful message delivery
  63         {
  64                 local $ENV{PATH} = $main_path;
  65                 run([$mda], \$in);
  66                 local $ENV{GIT_DIR} = $maindir;
  67                 my $rev = `git rev-list HEAD`;
  68                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
  69                 chomp $rev;
  70                 my $cmt = `git cat-file commit $rev`;
  71                 like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
  72                         "author info set correctly");
  73                 like($cmt, qr/^committer test <test-public\@example\.com>/m,
  74                         "committer info set correctly");
  75                 $good_rev = $rev;
  76         }
  77
  78         # ensure failures work, fail with bad spamc
  79         {
  80                 ok(!-e $failbox, "nothing in PI_FAILBOX before");
  81                 local $ENV{PATH} = $fail_path;
  82                 run([$mda], \$in);
  83                 local $ENV{GIT_DIR} = $maindir;
  84                 my @revs = `git rev-list HEAD`;
  85                 is(scalar @revs, 1, "bad revision not committed");
  86                 ok(-s $failbox > 0, "PI_FAILBOX is written to");
  87         }
  88
  89         fail_bad_header($good_rev, "bad recipient", <<"");
  90 From: Me <me\@example.com>
  91 To: You <you\@example.com>
  92 Message-Id: <bad-recipient\@example.com>
  93 Subject: hihi
  94 Date: Thu, 01 Jan 1970 00:00:00 +0000
  95
  96         my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
  97 From: Me <me\@example.com>
  98 To: You <you\@example.com>
  99 Cc: $addr
 100 Message-ID: <blah\@example.com>
 101 Subject: hihi
 102 Date: Thu, 01 Jan 1970 00:00:00 +0000
 103
 104         like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
 105
 106         fail_bad_header($good_rev, "missing From:", <<"");
 107 To: $addr
 108 Message-ID: <missing-from\@example.com>
 109 Subject: hihi
 110 Date: Thu, 01 Jan 1970 00:00:00 +0000
 111
 112         fail_bad_header($good_rev, "short subject:", <<"");
 113 To: $addr
 114 From: cat\@example.com
 115 Message-ID: <short-subject\@example.com>
 116 Subject: a
 117 Date: Thu, 01 Jan 1970 00:00:00 +0000
 118
 119         fail_bad_header($good_rev, "no date", <<"");
 120 To: $addr
 121 From: u\@example.com
 122 Message-ID: <no-date\@example.com>
 123 Subject: hihi
 124
 125         fail_bad_header($good_rev, "bad date", <<"");
 126 To: $addr
 127 From: u\@example.com
 128 Message-ID: <bad-date\@example.com>
 129 Subject: hihi
 130 Date: deadbeef
 131
 132 }
 133
 134 # spam training
 135 {
 136         local $ENV{PI_FAILBOX} = $failbox;
 137         local $ENV{HOME} = $home;
 138         local $ENV{RECIPIENT} = $addr;
 139         local $ENV{PATH} = $main_path;
 140         my $mid = 'spam-train@example.com';
 141         my $simple = Email::Simple->new(<<EOF);
 142 From: Spammer <spammer\@example.com>
 143 To: You <you\@example.com>
 144 Cc: $addr
 145 Message-ID: <$mid>
 146 Subject: this message will be trained as spam
 147 Date: Thu, 01 Jan 1970 00:00:00 +0000
 148
 149 EOF
 150         my $in = $simple->as_string;
 151
 152         {
 153                 # deliver the spam message, first
 154                 run([$mda], \$in);
 155                 my $msg = `ssoma cat $mid $maindir`;
 156                 like($msg, qr/\Q$mid\E/, "message delivered");
 157
 158                 # now train it
 159                 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
 160                 local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
 161                 run([$learn, "spam"], \$msg);
 162                 is($?, 0, "no failure from learning spam");
 163                 run([$learn, "spam"], \$msg);
 164                 is($?, 0, "no failure from learning spam idempotently");
 165         }
 166 }
 167
 168 # train ham message
 169 {
 170         local $ENV{PI_FAILBOX} = $failbox;
 171         local $ENV{HOME} = $home;
 172         local $ENV{RECIPIENT} = $addr;
 173         local $ENV{PATH} = $main_path;
 174         my $mid = 'ham-train@example.com';
 175         my $simple = Email::Simple->new(<<EOF);
 176 From: False-positive <hammer\@example.com>
 177 To: You <you\@example.com>
 178 Cc: $addr
 179 Message-ID: <$mid>
 180 Subject: this message will be trained as spam
 181 Date: Thu, 01 Jan 1970 00:00:00 +0000
 182
 183 EOF
 184         my $in = $simple->as_string;
 185
 186         # now train it
 187         local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
 188         local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
 189         run([$learn, "ham"], \$in);
 190         is($?, 0, "learned ham without failure");
 191         my $msg = `ssoma cat $mid $maindir`;
 192         like($msg, qr/\Q$mid\E/, "ham message delivered");
 193         run([$learn, "ham"], \$in);
 194         is($?, 0, "learned ham idempotently ");
 195 }
 196
 197 done_testing();
 198
 199 sub fail_bad_header {
 200         my ($good_rev, $msg, $in) = @_;
 201         open my $fh, '>', $failbox or die "failed to open $failbox: $!\n";
 202         close $fh or die "failed to close $failbox: $!\n";
 203         my ($out, $err) = ("", "");
 204         local $ENV{PATH} = $main_path;
 205         run([$mda], \$in, \$out, \$err);
 206         local $ENV{GIT_DIR} = $maindir;
 207         my $rev = `git rev-list HEAD`;
 208         chomp $rev;
 209         is($rev, $good_rev, "bad revision not commited ($msg)");
 210         ok(-s $failbox > 0, "PI_FAILBOX is written to ($msg)");
 211         [ $in, $out, $err ];
 212 }