]> Sergey Matveev's repositories - public-inbox.git/blobdiff - t/mda.t
remove Email::Address dependency
[public-inbox.git] / t / mda.t
diff --git a/t/mda.t b/t/mda.t
index 3357718cd08b67c92f734f22fbd117b3decf944f..fdba967204c310b333e406aa3f687776e5963be7 100644 (file)
--- a/t/mda.t
+++ b/t/mda.t
@@ -1,16 +1,18 @@
-# Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
+# Copyright (C) 2014-2015 all contributors <meta@public-inbox.org>
 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
 use strict;
 use warnings;
 use Test::More;
 use Email::MIME;
+use Email::Filter;
 use File::Temp qw/tempdir/;
 use Cwd;
 use IPC::Run qw(run);
+use PublicInbox::MID qw(mid2path);
 
 my $mda = "blib/script/public-inbox-mda";
 my $learn = "blib/script/public-inbox-learn";
-my $tmpdir = tempdir(CLEANUP => 1);
+my $tmpdir = tempdir('pi-mda-XXXXXX', TMPDIR => 1, CLEANUP => 1);
 my $home = "$tmpdir/pi-home";
 my $pi_home = "$home/.public-inbox";
 my $pi_config = "$pi_home/config";
@@ -22,6 +24,7 @@ my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc spam mock
 my $addr = 'test-public@example.com';
 my $cfgpfx = "publicinbox.test";
 my $failbox = "$home/fail.mbox";
+my $mime;
 
 {
        ok(-x "$main_bin/spamc",
@@ -43,6 +46,32 @@ my $failbox = "$home/fail.mbox";
        }
 }
 
+local $ENV{GIT_COMMITTER_NAME} = eval {
+       use PublicInbox::MDA;
+       use PublicInbox::Address;
+       use Encode qw/encode/;
+       my $mbox = 't/utf8.mbox';
+       open(my $fh, '<', $mbox) or die "failed to open mbox: $mbox\n";
+       my $str = eval { local $/; <$fh> };
+       close $fh;
+       my $msg = Email::Filter->new(data => $str);
+       $msg = Email::MIME->new($msg->simple->as_string);
+
+       my $from = $msg->header('From');
+       my $author = PublicInbox::Address::from_name($from);
+       my ($email) = PublicInbox::Address::emails($from);
+       my $date = $msg->header('Date');
+
+       is('El&#233;anor',
+               encode('us-ascii', my $tmp = $author, Encode::HTMLCREF),
+               'HTML conversion is correct');
+       is($email, 'e@example.com', 'email parsed correctly');
+       is($date, 'Thu, 01 Jan 1970 00:00:00 +0000',
+               'message date parsed correctly');
+       $author;
+};
+die $@ if $@;
+
 {
        my $good_rev;
        local $ENV{PI_EMERGENCY} = $failbox;
@@ -63,11 +92,10 @@ EOF
        {
                local $ENV{PATH} = $main_path;
                run([$mda], \$in);
-               local $ENV{GIT_DIR} = $maindir;
-               my $rev = `git rev-list HEAD`;
+               my $rev = `git --git-dir=$maindir rev-list HEAD`;
                like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
                chomp $rev;
-               my $cmt = `git cat-file commit $rev`;
+               my $cmt = `git --git-dir=$maindir cat-file commit $rev`;
                like($cmt, qr/^author Me <me\@example\.com> 0 \+0000\n/m,
                        "author info set correctly");
                like($cmt, qr/^committer test <test-public\@example\.com>/m,
@@ -80,8 +108,7 @@ EOF
                ok(!-e $failbox, "nothing in PI_EMERGENCY before");
                local $ENV{PATH} = $fail_path;
                run([$mda], \$in);
-               local $ENV{GIT_DIR} = $maindir;
-               my @revs = `git rev-list HEAD`;
+               my @revs = `git --git-dir=$maindir rev-list HEAD`;
                is(scalar @revs, 1, "bad revision not committed");
                ok(-s $failbox > 0, "PI_EMERGENCY is written to");
        }
@@ -152,7 +179,8 @@ EOF
        {
                # deliver the spam message, first
                run([$mda], \$in);
-               my $msg = `ssoma cat $mid $maindir`;
+               my $path = mid2path($mid);
+               my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
                like($msg, qr/\Q$mid\E/, "message delivered");
 
                # now train it
@@ -184,14 +212,57 @@ EOF
        my $in = $simple->as_string;
 
        # now train it
+       # these should be overridden
        local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com';
        local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com';
+
        run([$learn, "ham"], \$in);
        is($?, 0, "learned ham without failure");
-       my $msg = `ssoma cat $mid $maindir`;
+       my $path = mid2path($mid);
+       my $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
        like($msg, qr/\Q$mid\E/, "ham message delivered");
        run([$learn, "ham"], \$in);
        is($?, 0, "learned ham idempotently ");
+
+       # ensure trained email is filtered, too
+       my $html_body = "<html><body>hi</body></html>";
+       my $parts = [
+               Email::MIME->create(
+                       attributes => {
+                               content_type => 'text/html; charset=UTF-8',
+                               encoding => 'base64',
+                       },
+                       body => $html_body,
+               ),
+               Email::MIME->create(
+                       attributes => {
+                               content_type => 'text/plain',
+                               encoding => 'quoted-printable',
+                       },
+                       body => 'hi = "bye"',
+               )
+       ];
+       $mid = 'multipart-html-sucks@11';
+       $mime = Email::MIME->create(
+               header_str => [
+                 From => 'a@example.com',
+                 Subject => 'blah',
+                 Cc => $addr,
+                 'Message-ID' => "<$mid>",
+                 'Content-Type' => 'multipart/alternative',
+               ],
+               parts => $parts,
+       );
+
+       {
+               $in = $mime->as_string;
+               run([$learn, "ham"], \$in);
+               is($?, 0, "learned ham without failure");
+               my $path = mid2path($mid);
+               $msg = `git --git-dir=$maindir cat-file blob HEAD:$path`;
+               like($msg, qr/<\Q$mid\E>/, "ham message delivered");
+               unlike($msg, qr/<html>/i, '<html> filtered');
+       }
 }
 
 # faildir - emergency destination is maildir
@@ -214,6 +285,38 @@ EOF
        ok(-d $faildir, "emergency exists");
        my @new = glob("$faildir/new/*");
        is(scalar(@new), 1, "message delivered");
+       is(unlink(@new), 1, "removed emergency message");
+
+       local $ENV{PATH} = $main_path;
+       $in = <<EOF;
+From: Faildir <faildir\@example.com>
+To: $addr
+Content-Type: text/html
+Message-ID: <faildir\@example.com>
+Subject: faildir subject
+Date: Thu, 01 Jan 1970 00:00:00 +0000
+
+<html><body>bad</body></html>
+EOF
+       my $out = '';
+       my $err = '';
+       run([$mda], \$in, \$out, \$err);
+       isnt($?, 0, "mda exited with failure");
+       is(length $out, 0, 'nothing in stdout');
+       isnt(length $err, 0, 'error message in stderr');
+
+       @new = glob("$faildir/new/*");
+       is(scalar(@new), 0, "new message did not show up");
+
+       # reject multipart again
+       $in = $mime->as_string;
+       $err = '';
+       run([$mda], \$in, \$out, \$err);
+       isnt($?, 0, "mda exited with failure");
+       is(length $out, 0, 'nothing in stdout');
+       isnt(length $err, 0, 'error message in stderr');
+       @new = glob("$faildir/new/*");
+       is(scalar(@new), 0, "new message did not show up");
 }
 
 done_testing();
@@ -225,8 +328,7 @@ sub fail_bad_header {
        my ($out, $err) = ("", "");
        local $ENV{PATH} = $main_path;
        run([$mda], \$in, \$out, \$err);
-       local $ENV{GIT_DIR} = $maindir;
-       my $rev = `git rev-list HEAD`;
+       my $rev = `git --git-dir=$maindir rev-list HEAD`;
        chomp $rev;
        is($rev, $good_rev, "bad revision not commited ($msg)");
        ok(-s $failbox > 0, "PI_EMERGENCY is written to ($msg)");