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 use PublicInbox::MID qw(mid2path);
  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 $failbox = "$home/fail.mbox";
  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 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> };
  55         close $fh;
  56         my $msg = Email::Filter->new(data => $str);
  57         $msg = Email::MIME->new($msg->simple->as_string);
  58
  59         my $from = $msg->header('From');
  60         my @from = Email::Address->parse($from);
  61         my $author = $from[0]->name;
  62         my $email = $from[0]->address;
  63         my $date = $msg ->header('Date');
  64
  65         is('El&#233;anor',
  66                 encode('us-ascii', my $tmp = $author, Encode::HTMLCREF),
  67                 'HTML conversion is correct');
  68         is($email, 'e@example.com', 'email parsed correctly');
  69         is($date, 'Thu, 01 Jan 1970 00:00:00 +0000',
  70                 'message date parsed correctly');
  71         $author;
  72 };
  73 die $@ if $@;
  74
  75 {
  76         my $good_rev;
  77         local $ENV{PI_EMERGENCY} = $failbox;
  78         local $ENV{HOME} = $home;
  79         local $ENV{ORIGINAL_RECIPIENT} = $addr;
  80         my $simple = Email::Simple->new(<<EOF);
  81 From: Me <me\@example.com>
  82 To: You <you\@example.com>
  83 Cc: $addr
  84 Message-Id: <blah\@example.com>
  85 Subject: hihi
  86 Date: Thu, 01 Jan 1970 00:00:00 +0000
  87
  88 EOF
  89         my $in = $simple->as_string;
  90
  91         # ensure successful message delivery
  92         {
  93                 local $ENV{PATH} = $main_path;
  94                 run([$mda], \$in);
  95                 local $ENV{GIT_DIR} = $maindir;
  96                 my $rev = `git rev-list HEAD`;
  97                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
  98                 chomp $rev;
  99                 my $cmt = `git cat-file commit $rev`;
 100                 like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
 101                         "author info set correctly");
 102                 like($cmt, qr/^committer test <test-public\@example\.com>/m,
 103                         "committer info set correctly");
 104                 $good_rev = $rev;
 105         }
 106
 107         # ensure failures work, fail with bad spamc
 108         {
 109                 ok(!-e $failbox, "nothing in PI_EMERGENCY before");
 110                 local $ENV{PATH} = $fail_path;
 111                 run([$mda], \$in);
 112                 local $ENV{GIT_DIR} = $maindir;
 113                 my @revs = `git rev-list HEAD`;
 114                 is(scalar @revs, 1, "bad revision not committed");
 115                 ok(-s $failbox > 0, "PI_EMERGENCY is written to");
 116         }
 117
 118         fail_bad_header($good_rev, "bad recipient", <<"");
 119 From: Me <me\@example.com>
 120 To: You <you\@example.com>
 121 Message-Id: <bad-recipient\@example.com>
 122 Subject: hihi
 123 Date: Thu, 01 Jan 1970 00:00:00 +0000
 124
 125         my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
 126 From: Me <me\@example.com>
 127 To: You <you\@example.com>
 128 Cc: $addr
 129 Message-ID: <blah\@example.com>
 130 Subject: hihi
 131 Date: Thu, 01 Jan 1970 00:00:00 +0000
 132
 133         like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
 134
 135         fail_bad_header($good_rev, "missing From:", <<"");
 136 To: $addr
 137 Message-ID: <missing-from\@example.com>
 138 Subject: hihi
 139 Date: Thu, 01 Jan 1970 00:00:00 +0000
 140
 141         fail_bad_header($good_rev, "short subject:", <<"");
 142 To: $addr
 143 From: cat\@example.com
 144 Message-ID: <short-subject\@example.com>
 145 Subject: a
 146 Date: Thu, 01 Jan 1970 00:00:00 +0000
 147
 148         fail_bad_header($good_rev, "no date", <<"");
 149 To: $addr
 150 From: u\@example.com
 151 Message-ID: <no-date\@example.com>
 152 Subject: hihi
 153
 154         fail_bad_header($good_rev, "bad date", <<"");
 155 To: $addr
 156 From: u\@example.com
 157 Message-ID: <bad-date\@example.com>
 158 Subject: hihi
 159 Date: deadbeef
 160
 161 }
 162
 163 # spam training
 164 {
 165         local $ENV{PI_EMERGENCY} = $failbox;
 166         local $ENV{HOME} = $home;
 167         local $ENV{ORIGINAL_RECIPIENT} = $addr;
 168         local $ENV{PATH} = $main_path;
 169         my $mid = 'spam-train@example.com';
 170         my $simple = Email::Simple->new(<<EOF);
 171 From: Spammer <spammer\@example.com>
 172 To: You <you\@example.com>
 173 Cc: $addr
 174 Message-ID: <$mid>
 175 Subject: this message will be trained as spam
 176 Date: Thu, 01 Jan 1970 00:00:00 +0000
 177
 178 EOF
 179         my $in = $simple->as_string;
 180
 181         {
 182                 # deliver the spam message, first
 183                 run([$mda], \$in);
 184                 my $path = mid2path($mid);
 185                 my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
 186                 like($msg, qr/\Q$mid\E/, "message delivered");
 187
 188                 # now train it
 189                 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
 190                 local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
 191                 run([$learn, "spam"], \$msg);
 192                 is($?, 0, "no failure from learning spam");
 193                 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} = $failbox;
 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         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         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                 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 # faildir - emergency destination is maildir
 271 {
 272         my $faildir= "$home/faildir/";
 273         local $ENV{PI_EMERGENCY} = $faildir;
 274         local $ENV{HOME} = $home;
 275         local $ENV{ORIGINAL_RECIPIENT} = $addr;
 276         local $ENV{PATH} = $fail_path;
 277         my $in = <<EOF;
 278 From: Faildir <faildir\@example.com>
 279 To: You <you\@example.com>
 280 Cc: $addr
 281 Message-ID: <faildir\@example.com>
 282 Subject: faildir subject
 283 Date: Thu, 01 Jan 1970 00:00:00 +0000
 284
 285 EOF
 286         run([$mda], \$in);
 287         ok(-d $faildir, "emergency exists");
 288         my @new = glob("$faildir/new/*");
 289         is(scalar(@new), 1, "message delivered");
 290         is(unlink(@new), 1, "removed emergency message");
 291
 292         local $ENV{PATH} = $main_path;
 293         $in = <<EOF;
 294 From: Faildir <faildir\@example.com>
 295 To: $addr
 296 Content-Type: text/html
 297 Message-ID: <faildir\@example.com>
 298 Subject: faildir subject
 299 Date: Thu, 01 Jan 1970 00:00:00 +0000
 300
 301 <html><body>bad</body></html>
 302 EOF
 303         my $out = '';
 304         my $err = '';
 305         run([$mda], \$in, \$out, \$err);
 306         isnt($?, 0, "mda exited with failure");
 307         is(length $out, 0, 'nothing in stdout');
 308         isnt(length $err, 0, 'error message in stderr');
 309
 310         @new = glob("$faildir/new/*");
 311         is(scalar(@new), 0, "new message did not show up");
 312
 313         # reject multipart again
 314         $in = $mime->as_string;
 315         $err = '';
 316         run([$mda], \$in, \$out, \$err);
 317         isnt($?, 0, "mda exited with failure");
 318         is(length $out, 0, 'nothing in stdout');
 319         isnt(length $err, 0, 'error message in stderr');
 320         @new = glob("$faildir/new/*");
 321         is(scalar(@new), 0, "new message did not show up");
 322 }
 323
 324 done_testing();
 325
 326 sub fail_bad_header {
 327         my ($good_rev, $msg, $in) = @_;
 328         open my $fh, '>', $failbox or die "failed to open $failbox: $!\n";
 329         close $fh or die "failed to close $failbox: $!\n";
 330         my ($out, $err) = ("", "");
 331         local $ENV{PATH} = $main_path;
 332         run([$mda], \$in, \$out, \$err);
 333         local $ENV{GIT_DIR} = $maindir;
 334         my $rev = `git rev-list HEAD`;
 335         chomp $rev;
 336         is($rev, $good_rev, "bad revision not commited ($msg)");
 337         ok(-s $failbox > 0, "PI_EMERGENCY is written to ($msg)");
 338         [ $in, $out, $err ];
 339 }