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