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 PublicInbox::Address;
  52         use Encode qw/encode/;
  53         my $mbox = 't/utf8.mbox';
  54         open(my $fh, '<', $mbox) or die "failed to open mbox: $mbox\n";
  55         my $str = eval { local $/; <$fh> };
  56         close $fh;
  57         my $msg = Email::Filter->new(data => $str);
  58         $msg = Email::MIME->new($msg->simple->as_string);
  59
  60         my $from = $msg->header('From');
  61         my $author = PublicInbox::Address::from_name($from);
  62         my ($email) = PublicInbox::Address::emails($from);
  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                 my $rev = `git --git-dir=$maindir rev-list HEAD`;
  96                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
  97                 chomp $rev;
  98                 my $cmt = `git --git-dir=$maindir cat-file commit $rev`;
  99                 like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
 100                         "author info set correctly");
 101                 like($cmt, qr/^committer test <test-public\@example\.com>/m,
 102                         "committer info set correctly");
 103                 $good_rev = $rev;
 104         }
 105
 106         # ensure failures work, fail with bad spamc
 107         {
 108                 ok(!-e $failbox, "nothing in PI_EMERGENCY before");
 109                 local $ENV{PATH} = $fail_path;
 110                 run([$mda], \$in);
 111                 my @revs = `git --git-dir=$maindir rev-list HEAD`;
 112                 is(scalar @revs, 1, "bad revision not committed");
 113                 ok(-s $failbox > 0, "PI_EMERGENCY is written to");
 114         }
 115
 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>
 120 Subject: hihi
 121 Date: Thu, 01 Jan 1970 00:00:00 +0000
 122
 123         my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<"");
 124 From: Me <me\@example.com>
 125 To: You <you\@example.com>
 126 Cc: $addr
 127 Message-ID: <blah\@example.com>
 128 Subject: hihi
 129 Date: Thu, 01 Jan 1970 00:00:00 +0000
 130
 131         like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message");
 132
 133         fail_bad_header($good_rev, "missing From:", <<"");
 134 To: $addr
 135 Message-ID: <missing-from\@example.com>
 136 Subject: hihi
 137 Date: Thu, 01 Jan 1970 00:00:00 +0000
 138
 139         fail_bad_header($good_rev, "short subject:", <<"");
 140 To: $addr
 141 From: cat\@example.com
 142 Message-ID: <short-subject\@example.com>
 143 Subject: a
 144 Date: Thu, 01 Jan 1970 00:00:00 +0000
 145
 146         fail_bad_header($good_rev, "no date", <<"");
 147 To: $addr
 148 From: u\@example.com
 149 Message-ID: <no-date\@example.com>
 150 Subject: hihi
 151
 152         fail_bad_header($good_rev, "bad date", <<"");
 153 To: $addr
 154 From: u\@example.com
 155 Message-ID: <bad-date\@example.com>
 156 Subject: hihi
 157 Date: deadbeef
 158
 159 }
 160
 161 # spam training
 162 {
 163         local $ENV{PI_EMERGENCY} = $failbox;
 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>
 171 Cc: $addr
 172 Message-ID: <$mid>
 173 Subject: this message will be trained as spam
 174 Date: Thu, 01 Jan 1970 00:00:00 +0000
 175
 176 EOF
 177         my $in = $simple->as_string;
 178
 179         {
 180                 # deliver the spam message, first
 181                 run([$mda], \$in);
 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");
 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, "spam"], \$msg);
 190                 is($?, 0, "no failure from learning spam");
 191                 run([$learn, "spam"], \$msg);
 192                 is($?, 0, "no failure from learning spam idempotently");
 193         }
 194 }
 195
 196 # train ham message
 197 {
 198         local $ENV{PI_EMERGENCY} = $failbox;
 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>
 206 Cc: $addr
 207 Message-ID: <$mid>
 208 Subject: this message will be trained as spam
 209 Date: Thu, 01 Jan 1970 00:00:00 +0000
 210
 211 EOF
 212         my $in = $simple->as_string;
 213
 214         # now train it
 215         # these should be overridden
 216         local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
 217         local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
 218
 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 ");
 226
 227         # ensure trained email is filtered, too
 228         my $html_body = "<html><body>hi</body></html>";
 229         my $parts = [
 230                 Email::MIME->create(
 231                         attributes => {
 232                                 content_type => 'text/html; charset=UTF-8',
 233                                 encoding => 'base64',
 234                         },
 235                         body => $html_body,
 236                 ),
 237                 Email::MIME->create(
 238                         attributes => {
 239                                 content_type => 'text/plain',
 240                                 encoding => 'quoted-printable',
 241                         },
 242                         body => 'hi = "bye"',
 243                 )
 244         ];
 245         $mid = 'multipart-html-sucks@11';
 246         $mime = Email::MIME->create(
 247                 header_str => [
 248                   From => 'a@example.com',
 249                   Subject => 'blah',
 250                   Cc => $addr,
 251                   'Message-ID' => "<$mid>",
 252                   'Content-Type' => 'multipart/alternative',
 253                 ],
 254                 parts => $parts,
 255         );
 256
 257         {
 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');
 265         }
 266 }
 267
 268 # faildir - emergency destination is maildir
 269 {
 270         my $faildir= "$home/faildir/";
 271         local $ENV{PI_EMERGENCY} = $faildir;
 272         local $ENV{HOME} = $home;
 273         local $ENV{ORIGINAL_RECIPIENT} = $addr;
 274         local $ENV{PATH} = $fail_path;
 275         my $in = <<EOF;
 276 From: Faildir <faildir\@example.com>
 277 To: You <you\@example.com>
 278 Cc: $addr
 279 Message-ID: <faildir\@example.com>
 280 Subject: faildir subject
 281 Date: Thu, 01 Jan 1970 00:00:00 +0000
 282
 283 EOF
 284         run([$mda], \$in);
 285         ok(-d $faildir, "emergency exists");
 286         my @new = glob("$faildir/new/*");
 287         is(scalar(@new), 1, "message delivered");
 288         is(unlink(@new), 1, "removed emergency message");
 289
 290         local $ENV{PATH} = $main_path;
 291         $in = <<EOF;
 292 From: Faildir <faildir\@example.com>
 293 To: $addr
 294 Content-Type: text/html
 295 Message-ID: <faildir\@example.com>
 296 Subject: faildir subject
 297 Date: Thu, 01 Jan 1970 00:00:00 +0000
 298
 299 <html><body>bad</body></html>
 300 EOF
 301         my $out = '';
 302         my $err = '';
 303         run([$mda], \$in, \$out, \$err);
 304         isnt($?, 0, "mda exited with failure");
 305         is(length $out, 0, 'nothing in stdout');
 306         isnt(length $err, 0, 'error message in stderr');
 307
 308         @new = glob("$faildir/new/*");
 309         is(scalar(@new), 0, "new message did not show up");
 310
 311         # reject multipart again
 312         $in = $mime->as_string;
 313         $err = '';
 314         run([$mda], \$in, \$out, \$err);
 315         isnt($?, 0, "mda exited with failure");
 316         is(length $out, 0, 'nothing in stdout');
 317         isnt(length $err, 0, 'error message in stderr');
 318         @new = glob("$faildir/new/*");
 319         is(scalar(@new), 0, "new message did not show up");
 320 }
 321
 322 done_testing();
 323
 324 sub fail_bad_header {
 325         my ($good_rev, $msg, $in) = @_;
 326         open my $fh, '>', $failbox or die "failed to open $failbox: $!\n";
 327         close $fh or die "failed to close $failbox: $!\n";
 328         my ($out, $err) = ("", "");
 329         local $ENV{PATH} = $main_path;
 330         run([$mda], \$in, \$out, \$err);
 331         my $rev = `git --git-dir=$maindir rev-list HEAD`;
 332         chomp $rev;
 333         is($rev, $good_rev, "bad revision not commited ($msg)");
 334         ok(-s $failbox > 0, "PI_EMERGENCY is written to ($msg)");
 335         [ $in, $out, $err ];
 336 }