X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fmda.t;h=fb505146f8feb080db191dfaad9e2f334e0d2957;hb=5f113019334c3fcdcc71e8a573c30ec10f7bcbb9;hp=47d061322744be3c8745b4f84f9b80c8f6bab94e;hpb=ad6f26f3b9f0e428020d05667987556f8fcbec2f;p=public-inbox.git diff --git a/t/mda.t b/t/mda.t index 47d06132..fb505146 100644 --- a/t/mda.t +++ b/t/mda.t @@ -1,4 +1,4 @@ -# Copyright (C) 2014-2019 all contributors +# Copyright (C) 2014-2020 all contributors # License: AGPL-3.0+ use strict; use warnings; @@ -7,7 +7,9 @@ use Email::MIME; use Cwd qw(getcwd); use PublicInbox::MID qw(mid2path); use PublicInbox::Git; -require './t/common.perl'; +use PublicInbox::InboxWritable; +use PublicInbox::TestCommon; +use PublicInbox::Import; my ($tmpdir, $for_destroy) = tmpdir(); my $home = "$tmpdir/pi-home"; my $pi_home = "$home/.public-inbox"; @@ -23,6 +25,23 @@ my $faildir = "$home/faildir/"; my $mime; my $git = PublicInbox::Git->new($maindir); +my $fail_bad_header = sub ($$$) { + my ($good_rev, $msg, $in) = @_; + my @f = glob("$faildir/*/*"); + unlink @f if @f; + my ($out, $err) = ("", ""); + my $opt = { 0 => \$in, 1 => \$out, 2 => \$err }; + local $ENV{PATH} = $main_path; + ok(run_script(['-mda'], undef, $opt), + "no error on undeliverable ($msg)"); + my $rev = $git->qx(qw(rev-list HEAD)); + chomp $rev; + is($rev, $good_rev, "bad revision not committed ($msg)"); + @f = glob("$faildir/*/*"); + is(scalar @f, 1, "faildir written to"); + [ $in, $out, $err ]; +}; + { ok(-x "$main_bin/spamc", "spamc ham mock found (run in top of source tree"); @@ -30,28 +49,24 @@ my $git = PublicInbox::Git->new($maindir); "spamc mock found (run in top of source tree"); is(1, mkdir($home, 0755), "setup ~/ for testing"); is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox"); - is(0, system(qw(git init -q --bare), $maindir), "git init (main)"); + PublicInbox::Import::init_bare($maindir); - my %cfg = ( - "$cfgpfx.address" => $addr, - "$cfgpfx.inboxdir" => $maindir, - ); - while (my ($k,$v) = each %cfg) { - is(0, system(qw(git config --file), $pi_config, $k, $v), - "setup $k"); - } + open my $fh, '>>', $pi_config or die; + print $fh < }; - close $fh; - my $msg = Email::MIME->new($str); - + my $eml = 't/utf8.eml'; + my $msg = PublicInbox::InboxWritable::mime_from_path($eml) or + die "failed to open $eml: $!"; my $from = $msg->header('From'); my ($author) = PublicInbox::Address::names($from); my ($email) = PublicInbox::Address::emails($from); @@ -72,7 +87,7 @@ die $@ if $@; local $ENV{PI_EMERGENCY} = $faildir; local $ENV{HOME} = $home; local $ENV{ORIGINAL_RECIPIENT} = $addr; - my $simple = Email::Simple->new(< To: You Cc: $addr @@ -81,8 +96,6 @@ Subject: hihi Date: Thu, 01 Jan 1970 00:00:00 +0000 EOF - my $in = $simple->as_string; - # ensure successful message delivery { local $ENV{PATH} = $main_path; @@ -110,14 +123,14 @@ EOF is(scalar @new, 1, "PI_EMERGENCY is written to"); } - fail_bad_header($good_rev, "bad recipient", <<""); + $fail_bad_header->($good_rev, "bad recipient", <<""); From: Me To: You Message-Id: Subject: hihi Date: Thu, 01 Jan 1970 00:00:00 +0000 - my $fail = fail_bad_header($good_rev, "duplicate Message-ID", <<""); + my $fail = $fail_bad_header->($good_rev, "duplicate Message-ID", <<""); From: Me To: You Cc: $addr @@ -127,26 +140,26 @@ Date: Thu, 01 Jan 1970 00:00:00 +0000 like($fail->[2], qr/CONFLICT/, "duplicate Message-ID message"); - fail_bad_header($good_rev, "missing From:", <<""); + $fail_bad_header->($good_rev, "missing From:", <<""); To: $addr Message-ID: Subject: hihi Date: Thu, 01 Jan 1970 00:00:00 +0000 - fail_bad_header($good_rev, "short subject:", <<""); + $fail_bad_header->($good_rev, "short subject:", <<""); To: $addr From: cat\@example.com Message-ID: Subject: a Date: Thu, 01 Jan 1970 00:00:00 +0000 - fail_bad_header($good_rev, "no date", <<""); + $fail_bad_header->($good_rev, "no date", <<""); To: $addr From: u\@example.com Message-ID: Subject: hihi - fail_bad_header($good_rev, "bad date", <<""); + $fail_bad_header->($good_rev, "bad date", <<""); To: $addr From: u\@example.com Message-ID: @@ -162,7 +175,7 @@ Date: deadbeef local $ENV{ORIGINAL_RECIPIENT} = $addr; local $ENV{PATH} = $main_path; my $mid = 'spam-train@example.com'; - my $simple = Email::Simple->new(< To: You Cc: $addr @@ -171,8 +184,6 @@ Subject: this message will be trained as spam Date: Thu, 01 Jan 1970 00:00:00 +0000 EOF - my $in = $simple->as_string; - { # deliver the spam message, first ok(run_script(['-mda'], undef, { 0 => \$in })); @@ -199,7 +210,7 @@ EOF local $ENV{ORIGINAL_RECIPIENT} = $addr; local $ENV{PATH} = $main_path; my $mid = 'ham-train@example.com'; - my $simple = Email::Simple->new(< To: You Cc: $addr @@ -208,8 +219,6 @@ Subject: this message will be trained as spam Date: Thu, 01 Jan 1970 00:00:00 +0000 EOF - my $in = $simple->as_string; - # now train it # these should be overridden local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com'; @@ -273,7 +282,7 @@ EOF local $ENV{PATH} = $main_path; my $list_id = 'foo.example.com'; my $mid = 'list-id-delivery@example.com'; - my $simple = Email::Simple->new(< To: You Cc: $addr @@ -283,9 +292,8 @@ Subject: this message will be trained as spam Date: Thu, 01 Jan 1970 00:00:00 +0000 EOF - system(qw(git config --file), $pi_config, "$cfgpfx.listid", $list_id); + xsys(qw(git config --file), $pi_config, "$cfgpfx.listid", $list_id); $? == 0 or die "failed to set listid $?"; - my $in = $simple->as_string; ok(run_script(['-mda'], undef, { 0 => \$in }), 'mda OK with List-Id match'); my $path = mid2path($mid); @@ -293,13 +301,12 @@ EOF like($$msg, qr/\Q$list_id\E/, 'delivered message w/ List-ID matches'); # try a message w/o precheck - $simple = Email::Simple->new(< List-Id: <$list_id> this message would not be accepted without --no-precheck EOF - $in = $simple->as_string; my ($out, $err) = ('', ''); my $rdr = { 0 => \$in, 1 => \$out, 2 => \$err }; ok(run_script(['-mda', '--no-precheck'], undef, $rdr), @@ -329,20 +336,3 @@ EOF } done_testing(); - -sub fail_bad_header { - my ($good_rev, $msg, $in) = @_; - my @f = glob("$faildir/*/*"); - unlink @f if @f; - my ($out, $err) = ("", ""); - my $opt = { 0 => \$in, 1 => \$out, 2 => \$err }; - local $ENV{PATH} = $main_path; - ok(run_script(['-mda'], undef, $opt), - "no error on undeliverable ($msg)"); - my $rev = $git->qx(qw(rev-list HEAD)); - chomp $rev; - is($rev, $good_rev, "bad revision not commited ($msg)"); - @f = glob("$faildir/*/*"); - is(scalar @f, 1, "faildir written to"); - [ $in, $out, $err ]; -}