diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/address.t | 36 | ||||
| -rw-r--r-- | t/altid.t | 61 | ||||
| -rw-r--r-- | t/cgi.t | 90 | ||||
| -rw-r--r-- | t/check-www-inbox.perl | 157 | ||||
| -rw-r--r-- | t/common.perl | 21 | ||||
| -rw-r--r-- | t/config.t | 29 | ||||
| -rw-r--r-- | t/config_limiter.t | 49 | ||||
| -rw-r--r-- | t/emergency.t | 53 | ||||
| -rw-r--r-- | t/feed.t | 112 | ||||
| -rw-r--r-- | t/filter.t | 355 | ||||
| -rw-r--r-- | t/filter_base.t | 81 | ||||
| -rw-r--r-- | t/filter_mirror.t | 40 | ||||
| -rw-r--r-- | t/filter_vger.t | 46 | ||||
| -rw-r--r-- | t/git-http-backend.psgi | 25 | ||||
| -rw-r--r-- | t/git-http-backend.t | 134 | ||||
| -rw-r--r-- | t/html_index.t | 36 | ||||
| -rw-r--r-- | t/httpd-corner.psgi | 16 | ||||
| -rw-r--r-- | t/httpd-corner.t | 51 | ||||
| -rw-r--r-- | t/httpd-unix.t | 4 | ||||
| -rw-r--r-- | t/httpd.t | 33 | ||||
| -rw-r--r-- | t/import.t | 69 | ||||
| -rw-r--r-- | t/inbox.t | 15 | ||||
| -rw-r--r-- | t/init.t | 10 | ||||
| -rw-r--r-- | t/linkify.t | 56 | ||||
| -rw-r--r-- | t/mda.t | 130 | ||||
| -rw-r--r-- | t/mid.t | 11 | ||||
| -rw-r--r-- | t/msg_iter.t | 44 | ||||
| -rw-r--r-- | t/nntp.t | 39 | ||||
| -rw-r--r-- | t/nntpd.t | 136 | ||||
| -rw-r--r-- | t/plack.t | 127 | ||||
| -rw-r--r-- | t/precheck.t | 31 | ||||
| -rw-r--r-- | t/psgi_attach.t | 117 | ||||
| -rw-r--r-- | t/psgi_mount.t | 78 | ||||
| -rw-r--r-- | t/psgi_text.t | 39 | ||||
| -rw-r--r-- | t/qspawn.t | 62 | ||||
| -rw-r--r-- | t/search.t | 160 | ||||
| -rw-r--r-- | t/spamcheck_spamc.t | 49 | ||||
| -rw-r--r-- | t/spawn.t | 12 | ||||
| -rw-r--r-- | t/thread-cycle.t | 89 | ||||
| -rw-r--r-- | t/view.t | 72 | ||||
| -rw-r--r-- | t/watch_maildir.t | 126 |
41 files changed, 2148 insertions, 753 deletions
diff --git a/t/address.t b/t/address.t new file mode 100644 index 00000000..be0fc5b7 --- /dev/null +++ b/t/address.t @@ -0,0 +1,36 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use_ok 'PublicInbox::Address'; + +is_deeply([qw(e@example.com e@example.org)], + [PublicInbox::Address::emails('User <e@example.com>, e@example.org')], + 'address extraction works as expected'); + +is_deeply([PublicInbox::Address::emails('"ex@example.com" <ex@example.com>')], + [qw(ex@example.com)]); + +my @names = PublicInbox::Address::names( + 'User <e@e>, e@e, "John A. Doe" <j@d>, <x@x>'); +is_deeply(['User', 'e', 'John A. Doe', 'x'], \@names, + 'name extraction works as expected'); + +@names = PublicInbox::Address::names('"user@example.com" <user@example.com>'); +is_deeply(['user'], \@names, 'address-as-name extraction works as expected'); + + +{ + my $backwards = 'u@example.com (John Q. Public)'; + @names = PublicInbox::Address::names($backwards); + is_deeply(\@names, ['u'], 'backwards name OK'); + my @emails = PublicInbox::Address::emails($backwards); + is_deeply(\@emails, ['u@example.com'], 'backwards emails OK'); +} + + +@names = PublicInbox::Address::names('"Quote Unneeded" <user@example.com>'); +is_deeply(['Quote Unneeded'], \@names, 'extra quotes dropped'); + +done_testing; diff --git a/t/altid.t b/t/altid.t new file mode 100644 index 00000000..887d548f --- /dev/null +++ b/t/altid.t @@ -0,0 +1,61 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use File::Temp qw/tempdir/; +foreach my $mod (qw(DBD::SQLite Search::Xapian)) { + eval "require $mod"; + plan skip_all => "$mod missing for altid.t" if $@; +} + +use_ok 'PublicInbox::Msgmap'; +use_ok 'PublicInbox::SearchIdx'; +use_ok 'PublicInbox::Import'; +use_ok 'PublicInbox::Inbox'; +my $tmpdir = tempdir('pi-altid-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $git_dir = "$tmpdir/a.git"; +my $alt_file = "$tmpdir/another-nntp.sqlite3"; +my $altid = [ "serial:gmane:file=$alt_file" ]; + +{ + my $mm = PublicInbox::Msgmap->new_file($alt_file, 1); + $mm->mid_set(1234, 'a@example.com'); +} + +{ + is(system(qw(git init -q --bare), $git_dir), 0, 'git init ok'); + my $git = PublicInbox::Git->new($git_dir); + my $im = PublicInbox::Import->new($git, 'testbox', 'test@example'); + $im->add(Email::MIME->create( + header => [ + From => 'a@example.com', + To => 'b@example.com', + 'Content-Type' => 'text/plain', + Subject => 'boo!', + 'Message-ID' => '<a@example.com>', + ], + body => "hello world gmane:666\n", + )); + $im->done; +} +{ + my $inbox = PublicInbox::Inbox->new({mainrepo=>$git_dir}); + $inbox->{altid} = $altid; + my $rw = PublicInbox::SearchIdx->new($inbox, 1); + $rw->index_sync; +} + +{ + my $ro = PublicInbox::Search->new($git_dir, $altid); + my $res = $ro->query("gmane:1234"); + is($res->{total}, 1, 'got one match'); + is($res->{msgs}->[0]->mid, 'a@example.com'); + + $res = $ro->query("gmane:666"); + is($res->{total}, 0, 'body did NOT match'); +}; + +done_testing(); + +1; @@ -1,30 +1,27 @@ # Copyright (C) 2014-2015 all contributors <meta@public-inbox.org> # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) +# FIXME: this test is too slow and most non-CGI-requirements +# should be moved over to things which use test_psgi use strict; use warnings; use Test::More; use Email::MIME; use File::Temp qw/tempdir/; use Cwd; -use IPC::Run qw/run/; +eval { require IPC::Run }; +plan skip_all => "missing IPC::Run for t/cgi.t" if $@; use constant CGI => "blib/script/public-inbox.cgi"; -my $mda = "blib/script/public-inbox-mda"; my $index = "blib/script/public-inbox-index"; my $tmpdir = tempdir('pi-cgi-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $home = "$tmpdir/pi-home"; my $pi_home = "$home/.public-inbox"; my $pi_config = "$pi_home/config"; my $maindir = "$tmpdir/main.git"; -my $main_bin = getcwd()."/t/main-bin"; -my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock my $addr = 'test-public@example.com'; my $cfgpfx = "publicinbox.test"; { - ok(-x "$main_bin/spamc", - "spamc ham mock found (run in top of source tree"); - ok(-x $mda, "$mda is executable"); 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)"); @@ -42,15 +39,18 @@ my $cfgpfx = "publicinbox.test"; } } -my $failbox = "$home/fail.mbox"; -local $ENV{PI_EMERGENCY} = $failbox; +use_ok 'PublicInbox::Git'; +use_ok 'PublicInbox::Import'; +use_ok 'Email::MIME'; +my $git = PublicInbox::Git->new($maindir); +my $im = PublicInbox::Import->new($git, 'test', $addr); + { local $ENV{HOME} = $home; - local $ENV{ORIGINAL_RECIPIENT} = $addr; # ensure successful message delivery { - my $simple = Email::Simple->new(<<EOF); + my $mime = Email::MIME->new(<<EOF); From: Me <me\@example.com> To: You <you\@example.com> Cc: $addr @@ -60,16 +60,15 @@ Date: Thu, 01 Jan 1970 00:00:00 +0000 zzzzzz EOF - my $in = $simple->as_string; - run_with_env({PATH => $main_path}, [$mda], \$in); - local $ENV{GIT_DIR} = $maindir; - my $rev = `git rev-list HEAD`; + $im->add($mime); + $im->done; + my $rev = `git --git-dir=$maindir rev-list HEAD`; like($rev, qr/\A[a-f0-9]{40}/, "good revision committed"); } # deliver a reply, too { - my $reply = Email::Simple->new(<<EOF); + my $reply = Email::MIME->new(<<EOF); From: You <you\@example.com> To: Me <me\@example.com> Cc: $addr @@ -83,10 +82,9 @@ Me wrote: what? EOF - my $in = $reply->as_string; - run_with_env({PATH => $main_path}, [$mda], \$in); - local $ENV{GIT_DIR} = $maindir; - my $rev = `git rev-list HEAD`; + $im->add($reply); + $im->done; + my $rev = `git --git-dir=$maindir rev-list HEAD`; like($rev, qr/\A[a-f0-9]{40}/, "good revision committed"); } @@ -120,7 +118,7 @@ EOF like($res->{head}, qr/Status:\s*206/i, "info/refs partial past end OK"); is($res->{body}, substr($orig, 5), 'partial body OK past end'); } - +use Data::Dumper; # atom feeds { local $ENV{HOME} = $home; @@ -128,31 +126,16 @@ EOF like($res->{body}, qr/<title>test for public-inbox/, "set title in XML feed"); like($res->{body}, - qr!http://test\.example\.com/test/blah%40example\.com/!, + qr!http://test\.example\.com/test/blah\@example\.com/!, "link id set"); like($res->{body}, qr/what\?/, "reply included"); } -# indices -{ - local $ENV{HOME} = $home; - my $res = cgi_run("/test/"); - like($res->{head}, qr/Status: 200 OK/, "index returns 200"); - - my $idx = cgi_run("/test/index.html"); - $idx->{body} =~ s!/index.html(\?r=)!/$1!g; # dirty... - $idx->{body} = [ split(/\n/, $idx->{body}) ]; - $res->{body} = [ split(/\n/, $res->{body}) ]; - is_deeply($res, $idx, - '/$LISTNAME/ and /$LISTNAME/index.html are nearly identical'); - # more checks in t/feed.t -} - # message-id pages { local $ENV{HOME} = $home; my $slashy_mid = 'slashy/asdf@example.com'; - my $reply = Email::Simple->new(<<EOF); + my $reply = Email::MIME->new(<<EOF); From: You <you\@example.com> To: Me <me\@example.com> Cc: $addr @@ -162,16 +145,10 @@ Date: Thu, 01 Jan 1970 00:00:01 +0000 slashy EOF - my $in = $reply->as_string; - - { - local $ENV{HOME} = $home; - local $ENV{ORIGINAL_RECIPIENT} = $addr; - run_with_env({PATH => $main_path}, [$mda], \$in); - } - local $ENV{GIT_DIR} = $maindir; + $im->add($reply); + $im->done; - my $res = cgi_run("/test/slashy%2fasdf%40example.com/raw"); + my $res = cgi_run("/test/slashy%2fasdf\@example.com/raw"); like($res->{body}, qr/Message-Id: <\Q$slashy_mid\E>/, "slashy mid raw hit"); @@ -188,21 +165,22 @@ EOF like($res->{head}, qr/Status: 300 Multiple Choices/, "mid html miss"); $res = cgi_run("/test/blahblah\@example.com/f/"); - like($res->{body}, qr/\A<html>/, "mid html"); - like($res->{head}, qr/Status: 200 OK/, "200 response"); - $res = cgi_run("/test/blahblah\@example.con/f/"); + like($res->{head}, qr/Status: 301 Moved/, "301 response"); + like($res->{head}, + qr!^Location: http://[^/]+/test/blahblah\@example\.com/\r\n!ms, + '301 redirect location'); + $res = cgi_run("/test/blahblah\@example.con/"); like($res->{head}, qr/Status: 300 Multiple Choices/, "mid html miss"); - $res = cgi_run("/test/"); - like($res->{body}, qr/slashy%2Fasdf%40example\.com/, + $res = cgi_run("/test/new.html"); + like($res->{body}, qr/slashy%2Fasdf\@example\.com/, "slashy URL generated correctly"); } # retrieve thread as an mbox { local $ENV{HOME} = $home; - local $ENV{PATH} = $main_path; - my $path = "/test/blahblah%40example.com/t.mbox.gz"; + my $path = "/test/blahblah\@example.com/t.mbox.gz"; my $res = cgi_run($path); like($res->{head}, qr/^Status: 501 /, "search not-yet-enabled"); my $indexed = system($index, $maindir) == 0; @@ -222,7 +200,7 @@ EOF my $have_xml_feed = eval { require XML::Feed; 1 } if $indexed; if ($have_xml_feed) { - $path = "/test/blahblah%40example.com/t.atom"; + $path = "/test/blahblah\@example.com/t.atom"; $res = cgi_run($path); like($res->{head}, qr/^Status: 200 /, "atom returned 200"); like($res->{head}, qr!^Content-Type: application/atom\+xml!m, @@ -246,7 +224,7 @@ done_testing(); sub run_with_env { my ($env, @args) = @_; my $init = sub { foreach my $k (keys %$env) { $ENV{$k} = $env->{$k} } }; - run(@args, init => $init); + IPC::Run::run(@args, init => $init); } sub cgi_run { diff --git a/t/check-www-inbox.perl b/t/check-www-inbox.perl new file mode 100644 index 00000000..4319049c --- /dev/null +++ b/t/check-www-inbox.perl @@ -0,0 +1,157 @@ +#!/usr/bin/perl -w +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# Parallel WWW checker +my $usage = "$0 [-j JOBS] [-s SLOW_THRESHOLD] URL_OF_INBOX\n"; +use strict; +use warnings; +use File::Temp qw(tempfile); +use GDBM_File; +use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev); +use IO::Socket; +use LWP::ConnCache; +use POSIX qw(:sys_wait_h); +use Time::HiRes qw(gettimeofday tv_interval); +use WWW::Mechanize; +use Data::Dumper; +my $nproc = 4; +my $slow = 0.5; +my %opts = ( + '-j|jobs=i' => \$nproc, + '-s|slow-threshold=f' => \$slow, +); +GetOptions(%opts) or die "bad command-line args\n$usage"; +my $root_url = shift or die $usage; + +my %workers; +$SIG{TERM} = sub { exit 0 }; +$SIG{CHLD} = sub { + while (1) { + my $pid = waitpid(-1, WNOHANG); + return if !defined $pid || $pid <= 0; + my $p = delete $workers{$pid} || '(unknown)'; + warn("$pid [$p] exited with $?\n") if $?; + } +}; + +my @todo = IO::Socket->socketpair(AF_UNIX, SOCK_SEQPACKET, 0); +die "socketpair failed: $!" unless $todo[1]; +my @done = IO::Socket->socketpair(AF_UNIX, SOCK_SEQPACKET, 0); +die "socketpair failed: $!" unless $done[1]; +$| = 1; + +foreach my $p (1..$nproc) { + my $pid = fork; + die "fork failed: $!\n" unless defined $pid; + if ($pid) { + $workers{$pid} = $p; + } else { + $todo[1]->close; + $done[0]->close; + worker_loop($todo[0], $done[1]); + } +} + +my ($fh, $tmp) = tempfile('www-check-XXXXXXXX', + SUFFIX => '.gdbm', UNLINK => 1, TMPDIR => 1); +my $gdbm = tie my %seen, 'GDBM_File', $tmp, &GDBM_WRCREAT, 0600; +defined $gdbm or die "gdbm open failed: $!\n"; +$todo[0]->close; +$done[1]->close; + +my ($rvec, $wvec); +$todo[1]->blocking(0); +$done[0]->blocking(0); +$seen{$root_url} = 1; +my $ndone = 0; +my $nsent = 1; +my @queue = ($root_url); +my $timeout = $slow * 4; +while (keys %workers) { # reacts to SIGCHLD + $wvec = $rvec = ''; + my $u; + vec($rvec, fileno($done[0]), 1) = 1; + if (@queue) { + vec($wvec, fileno($todo[1]), 1) = 1; + } elsif ($ndone == $nsent) { + kill 'TERM', keys %workers; + exit; + } + if (!select($rvec, $wvec, undef, $timeout)) { + while (my ($k, $v) = each %seen) { + next if $v == 2; + print "WAIT ($ndone/$nsent) <$k>\n"; + } + } + while ($u = shift @queue) { + my $s = $todo[1]->send($u, MSG_EOR); + if ($!{EAGAIN}) { + unshift @queue, $u; + last; + } + } + my $r; + do { + $r = $done[0]->recv($u, 65535, 0); + } while (!defined $r && $!{EINTR}); + next unless $u; + if ($u =~ s/\ADONE\t//) { + $ndone++; + $seen{$u} = 2; + } else { + next if $seen{$u}; + $seen{$u} = 1; + $nsent++; + push @queue, $u; + } +} + +sub worker_loop { + my ($todo_rd, $done_wr) = @_; + my $m = WWW::Mechanize->new(autocheck => 0); + my $cc = LWP::ConnCache->new; + $m->conn_cache($cc); + while (1) { + $todo_rd->recv(my $u, 65535, 0); + next unless $u; + + my $t = [ gettimeofday ]; + my $r = $m->get($u); + $t = tv_interval($t); + printf "SLOW %0.06f % 5d %s\n", $t, $$, $u if $t > $slow; + my @links; + if ($r->is_success) { + my %links = map { + (split('#', $_->URI->abs->as_string))[0] => 1; + } grep { + $_->tag && $_->url !~ /:/ + } $m->links; + @links = keys %links; + } elsif ($r->code != 300) { + warn "W: ".$r->code . " $u\n" + } + + my $s; + # blocking + foreach my $l (@links, "DONE\t$u") { + next if $l eq ''; + do { + $s = $done_wr->send($l, MSG_EOR); + } while (!defined $s && $!{EINTR}); + die "$$ send $!\n" unless defined $s; + my $n = length($l); + die "$$ send truncated $s < $n\n" if $s != $n; + } + + # make sure the HTML source doesn't screw up terminals + # when people curl the source (not remotely an expert + # on languages or encodings, here). + next if $r->header('Content-Type') !~ m!\btext/html\b!; + my $dc = $r->decoded_content; + if ($dc =~ /([\x00-\x08\x0d-\x1f\x7f-\x{99999999}]+)/s) { + my $o = $1; + my $c = Dumper($o); + warn "bad: $u $c\n"; + } + } +} diff --git a/t/common.perl b/t/common.perl index bec57699..1251333d 100644 --- a/t/common.perl +++ b/t/common.perl @@ -1,18 +1,15 @@ # Copyright (C) 2015 all contributors <meta@public-inbox.org> # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt) -require IO::File; -use POSIX qw/dup/; sub stream_to_string { - my ($cb) = @_; - my $headers; - my $io = IO::File->new_tmpfile; - my $dup = dup($io->fileno); - my $response = sub { $headers = \@_, $io }; - $cb->($response); - $io = IO::File->new; - $io->fdopen($dup, 'r+'); - $io->seek(0, 0); - $io->read(my $str, ($io->stat)[7]); + my ($res) = @_; + my $body = $res->[2]; + my $str = ''; + while (defined(my $chunk = $body->getline)) { + $str .= $chunk; + } + $body->close; $str; } + +1; @@ -9,10 +9,8 @@ my $tmpdir = tempdir('pi-config-XXXXXX', TMPDIR => 1, CLEANUP => 1); { is(system(qw(git init -q --bare), $tmpdir), 0, "git init successful"); - { - local $ENV{GIT_DIR} = $tmpdir; - is(system(qw(git config foo.bar hihi)), 0, "set config"); - } + my @cmd = ('git', "--git-dir=$tmpdir", qw(config foo.bar hihi)); + is(system(@cmd), 0, "set config"); my $tmp = PublicInbox::Config->new("$tmpdir/config"); @@ -28,8 +26,11 @@ my $tmpdir = tempdir('pi-config-XXXXXX', TMPDIR => 1, CLEANUP => 1); is_deeply($cfg->lookup('meta@public-inbox.org'), { 'mainrepo' => '/home/pi/meta-main.git', 'address' => 'meta@public-inbox.org', + 'domain' => 'public-inbox.org', + 'url' => 'http://example.com/meta', -primary_address => 'meta@public-inbox.org', - 'listname' => 'meta', + 'name' => 'meta', + -pi_config => $cfg, }, "lookup matches expected output"); is($cfg->lookup('blah@example.com'), undef, @@ -42,8 +43,24 @@ my $tmpdir = tempdir('pi-config-XXXXXX', TMPDIR => 1, CLEANUP => 1); 'test@public-inbox.org'], -primary_address => 'try@public-inbox.org', 'mainrepo' => '/home/pi/test-main.git', - 'listname' => 'test', + 'domain' => 'public-inbox.org', + 'name' => 'test', + 'url' => 'http://example.com/test', + -pi_config => $cfg, }, "lookup matches expected output for test"); } + +{ + my $cfgpfx = "publicinbox.test"; + my @altid = qw(serial:gmane:file=a serial:enamg:file=b); + my $config = PublicInbox::Config->new({ + "$cfgpfx.address" => 'test@example.com', + "$cfgpfx.mainrepo" => '/path/to/non/existent', + "$cfgpfx.altid" => [ @altid ], + }); + my $ibx = $config->lookup_name('test'); + is_deeply($ibx->{altid}, [ @altid ]); +} + done_testing(); diff --git a/t/config_limiter.t b/t/config_limiter.t new file mode 100644 index 00000000..3c7ec557 --- /dev/null +++ b/t/config_limiter.t @@ -0,0 +1,49 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use PublicInbox::Config; +my $cfgpfx = "publicinbox.test"; +{ + my $config = PublicInbox::Config->new({ + "$cfgpfx.address" => 'test@example.com', + "$cfgpfx.mainrepo" => '/path/to/non/existent', + "$cfgpfx.httpbackendmax" => 12, + }); + my $ibx = $config->lookup_name('test'); + my $git = $ibx->git; + my $old = "$git"; + my $lim = $git->{-httpbackend_limiter}; + ok($lim, 'Limiter exists'); + is($lim->{max}, 12, 'limiter has expected slots'); + $ibx->{git} = undef; + $git = $ibx->git; + isnt($old, "$git", 'got new Git object'); + is("$git->{-httpbackend_limiter}", "$lim", 'same limiter'); +} + +{ + my $config = PublicInbox::Config->new({ + 'limiter.named.max' => 3, + "$cfgpfx.address" => 'test@example.com', + "$cfgpfx.mainrepo" => '/path/to/non/existent', + "$cfgpfx.httpbackendmax" => 'named', + }); + my $ibx = $config->lookup_name('test'); + my $git = $ibx->git; + ok($git, 'got git object'); + my $old = "$git"; + my $lim = $git->{-httpbackend_limiter}; + ok($lim, 'Limiter exists'); + is($lim->{max}, 3, 'limiter has expected slots'); + $git = undef; + $ibx->{git} = undef; + PublicInbox::Inbox::weaken_task; + $git = $ibx->git; + isnt($old, "$git", 'got new Git object'); + is("$git->{-httpbackend_limiter}", "$lim", 'same limiter'); + is($lim->{max}, 3, 'limiter has expected slots'); +} + +done_testing; diff --git a/t/emergency.t b/t/emergency.t new file mode 100644 index 00000000..e480338d --- /dev/null +++ b/t/emergency.t @@ -0,0 +1,53 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use File::Temp qw/tempdir/; +my $tmpdir = tempdir('emergency-XXXXXX', TMPDIR => 1, CLEANUP => 1); +use_ok 'PublicInbox::Emergency'; + +{ + my $md = "$tmpdir/a"; + my $em = PublicInbox::Emergency->new($md); + ok(-d $md, 'Maildir a auto-created'); + my @tmp = <$md/tmp/*>; + is(scalar @tmp, 0, 'no temporary files exist, yet'); + $em->prepare(\"BLAH"); + @tmp = <$md/tmp/*>; + is(scalar @tmp, 1, 'globbed one temporary file'); + open my $fh, '<', $tmp[0] or die "failed to open: $!"; + is("BLAH", <$fh>, 'wrote contents to temporary location'); + my @new = <$md/new/*>; + is(scalar @new, 0, 'no new files exist, yet'); + $em = undef; + @tmp = <$md/tmp/*>; + is(scalar @tmp, 0, 'temporary file no longer exists'); + @new = <$md/new/*>; + is(scalar @new, 1, 'globbed one new file'); + open $fh, '<', $new[0] or die "failed to open: $!"; + is("BLAH", <$fh>, 'wrote contents to new location'); +} +{ + my $md = "$tmpdir/b"; + my $em = PublicInbox::Emergency->new($md); + ok(-d $md, 'Maildir b auto-created'); + my @tmp = <$md/tmp/*>; + is(scalar @tmp, 0, 'no temporary files exist, yet'); + $em->prepare(\"BLAH"); + @tmp = <$md/tmp/*>; + is(scalar @tmp, 1, 'globbed one temporary file'); + open my $fh, '<', $tmp[0] or die "failed to open: $!"; + is("BLAH", <$fh>, 'wrote contents to temporary location'); + my @new = <$md/new/*>; + is(scalar @new, 0, 'no new files exist, yet'); + is(sysread($em->fh, my $buf, 9), 4, 'read file handle exposed'); + is($buf, 'BLAH', 'got expected data'); + $em->abort; + @tmp = <$md/tmp/*>; + is(scalar @tmp, 0, 'temporary file no longer exists'); + @new = <$md/new/*>; + is(scalar @new , 0, 'new file no longer exists'); +} + +done_testing(); @@ -3,10 +3,12 @@ use strict; use warnings; use Test::More; -use Email::Simple; +use Email::MIME; use PublicInbox::Feed; +use PublicInbox::Git; +use PublicInbox::Import; use PublicInbox::Config; -use IPC::Run qw/run/; +use PublicInbox::Inbox; use File::Temp qw/tempdir/; my $have_xml_feed = eval { require XML::Feed; 1 }; require 't/common.perl'; @@ -15,15 +17,45 @@ sub string_feed { stream_to_string(PublicInbox::Feed::generate($_[0])); } +# ensure we are compatible with existing ssoma installations which +# do not use fast-import. We can probably remove this in 2018 +my %SSOMA; +sub rand_use ($) { + return 0 if $ENV{FAST}; + eval { require IPC::Run }; + return 0 if $@; + my $cmd = $_[0]; + my $x = $SSOMA{$cmd}; + unless ($x) { + $x = -1; + foreach my $p (split(':', $ENV{PATH})) { + -x "$p/$cmd" or next; + $x = 1; + last; + } + $SSOMA{$cmd} = $x; + } + return if $x < 0; + ($x > 0 && (int(rand(10)) % 2) == 1); +} + my $tmpdir = tempdir('pi-feed-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $git_dir = "$tmpdir/gittest"; +my $ibx = PublicInbox::Inbox->new({ + address => 'test@example', + name => 'testbox', + mainrepo => $git_dir, + url => 'http://example.com/test', +}); +my $git = $ibx->git; +my $im = PublicInbox::Import->new($git, $ibx->{name}, 'test@example'); { is(0, system(qw(git init -q --bare), $git_dir), "git init"); local $ENV{GIT_DIR} = $git_dir; foreach my $i (1..6) { - my $simple = Email::Simple->new(<<EOF); + my $mime = Email::MIME->new(<<EOF); From: ME <me\@example.com> To: U <u\@example.com> Message-Id: <$i\@example.com> @@ -53,10 +85,16 @@ msg $i keep me EOF - my $str = $simple->as_string; - run(['ssoma-mda', $git_dir], \$str) or - die "mda failed: $?\n"; + if (rand_use('ssoma-mda')) { + $im->done; + my $str = $mime->as_string; + IPC::Run::run(['ssoma-mda', $git_dir], \$str) or + die "mda failed: $?\n"; + } else { + like($im->add($mime), qr/\A:\d+/, 'added'); + } } + $im->done; } # spam check @@ -64,7 +102,7 @@ EOF # check initial feed { my $feed = string_feed({ - git_dir => $git_dir, + -inbox => $ibx, max => 3 }); SKIP: { @@ -72,13 +110,11 @@ EOF my $p = XML::Feed->parse(\$feed); is($p->format, "Atom", "parsed atom feed"); is(scalar $p->entries, 3, "parsed three entries"); - is($p->id, 'mailto:public-inbox@example.com', + is($p->id, 'mailto:test@example', "id is set to default"); } - unlike($feed, qr/drop me/, "long quoted text dropped"); - like($feed, qr!/\d%40example\.com/f/#q!, - "/f/ url generated for long quoted text"); + like($feed, qr/drop me/, "long quoted text kept"); like($feed, qr/inline me here/, "short quoted text kept"); like($feed, qr/keep me/, "unquoted text saved"); } @@ -86,13 +122,7 @@ EOF # add a new spam message my $spam; { - my $pid = open(my $pipe, "|-"); - defined $pid or die "fork/pipe failed: $!\n"; - if ($pid == 0) { - exec("ssoma-mda", $git_dir); - } - - $spam = Email::Simple->new(<<EOF); + $spam = Email::MIME->new(<<EOF); From: SPAMMER <spammer\@example.com> To: U <u\@example.com> Message-Id: <this-is-spam\@example.com> @@ -100,14 +130,20 @@ Subject: SPAM!!!!!!!! Date: Thu, 01 Jan 1970 00:00:00 +0000 EOF - print $pipe $spam->as_string or die "print failed: $!\n"; - close $pipe or die "close pipe failed: $!\n"; + if (rand_use('ssoma-mda')) { + my $str = $spam->as_string; + IPC::Run::run(['ssoma-mda', $git_dir], \$str) or + die "mda failed: $?\n"; + } else { + $im->add($spam); + $im->done; + } } # check spam shows up { my $spammy_feed = string_feed({ - git_dir => $git_dir, + -inbox => $ibx, max => 3 }); SKIP: { @@ -120,18 +156,18 @@ EOF } # nuke spam - { + if (rand_use('ssoma-rm')) { my $spam_str = $spam->as_string; - run(["ssoma-rm", $git_dir], \$spam_str) or + IPC::Run::run(["ssoma-rm", $git_dir], \$spam_str) or die "ssoma-rm failed: $?\n"; + } else { + $im->remove($spam); + $im->done; } # spam no longer shows up { - my $feed = string_feed({ - git_dir => $git_dir, - max => 3 - }); + my $feed = string_feed({ -inbox => $ibx, max => 3 }); SKIP: { skip 'XML::Feed missing', 2 unless $have_xml_feed; my $p = XML::Feed->parse(\$feed); @@ -142,26 +178,4 @@ EOF } } -# check pi_config -{ - foreach my $addr (('a@example.com'), ['a@example.com','b@localhost']) { - my $feed = string_feed({ - git_dir => $git_dir, - max => 3, - listname => 'asdf', - pi_config => bless({ - 'publicinbox.asdf.address' => $addr, - }, 'PublicInbox::Config'), - }); - SKIP: { - skip 'XML::Feed missing', 3 unless $have_xml_feed; - my $p = XML::Feed->parse(\$feed); - is($p->id, 'mailto:a@example.com', - "ID is set correctly"); - is($p->format, "Atom", "parsed atom feed"); - is(scalar $p->entries, 3, "parsed three entries"); - } - } -} - done_testing(); diff --git a/t/filter.t b/t/filter.t deleted file mode 100644 index 80a7c123..00000000 --- a/t/filter.t +++ /dev/null @@ -1,355 +0,0 @@ -# Copyright (C) 2013-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 PublicInbox::Filter; - -sub count_body_parts { - my ($bodies, $part) = @_; - my $body = $part->body_raw; - $body =~ s/\A\s*//; - $body =~ s/\s*\z//; - $bodies->{$body} ||= 0; - $bodies->{$body}++; -} - -# multipart/alternative: HTML and quoted-printable, keep the plain-text -{ - 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"', - ) - ]; - my $email = Email::MIME->create( - header_str => [ - From => 'a@example.com', - Subject => 'blah', - 'Content-Type' => 'multipart/alternative' - ], - parts => $parts, - ); - is(1, PublicInbox::Filter->run($email), "run was a success"); - my $parsed = Email::MIME->new($email->as_string); - is("text/plain", $parsed->header("Content-Type")); - is(scalar $parsed->parts, 1, "HTML part removed"); - my %bodies; - $parsed->walk_parts(sub { - my ($part) = @_; - return if $part->subparts; # walk_parts already recurses - count_body_parts(\%bodies, $part); - }); - is(scalar keys %bodies, 1, "one bodies"); - is($bodies{"hi =3D \"bye\"="}, 1, "QP text part unchanged"); - $parsed->walk_parts(sub { - my ($part) = @_; - my $b = $part->body; - $b =~ s/\s*\z//; - is($b, "hi = \"bye\"", "decoded body matches"); - }); -} - -# plain-text email is passed through unchanged -{ - my $s = Email::MIME->create( - header => [ - From => 'a@example.com', - To => 'b@example.com', - 'Content-Type' => 'text/plain', - Subject => 'this is a subject', - ], - body => "hello world\n", - ); - is(1, PublicInbox::Filter->run($s), "run was a success"); -} - -# convert single-part HTML to plain-text -{ - my $s = Email::MIME->create( - header => [ - From => 'a@example.com', - To => 'b@example.com', - 'Content-Type' => 'text/html', - Subject => 'HTML only badness', - ], - body => "<html><body>bad body\r\n</body></html>\n", - ); - is(1, PublicInbox::Filter->run($s), "run was a success"); - unlike($s->as_string, qr/<html>/, "HTML removed"); - is("text/plain", $s->header("Content-Type"), - "content-type changed"); - like($s->body, qr/\A\s*bad body\s*\z/, "body"); - unlike($s->body, qr/\r/, "body has no cr"); - like($s->header("X-Content-Filtered-By"), - qr/PublicInbox::Filter/, "XCFB header added"); -} - -# multipart/alternative: HTML and plain-text, keep the plain-text -{ - 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', - }, - body=> 'hi', - ) - ]; - my $email = Email::MIME->create( - header_str => [ - From => 'a@example.com', - Subject => 'blah', - 'Content-Type' => 'multipart/alternative' - ], - parts => $parts, - ); - is(1, PublicInbox::Filter->run($email), "run was a success"); - my $parsed = Email::MIME->new($email->as_string); - is("text/plain", $parsed->header("Content-Type")); - is(scalar $parsed->parts, 1, "HTML part removed"); - my %bodies; - $parsed->walk_parts(sub { - my ($part) = @_; - return if $part->subparts; # walk_parts already recurses - count_body_parts(\%bodies, $part); - }); - is(scalar keys %bodies, 1, "one bodies"); - is($bodies{"hi"}, 1, "plain text part unchanged"); -} - -# multi-part plain-text-only -{ - my $parts = [ - Email::MIME->create( - attributes => { content_type => 'text/plain', }, - body => 'hi', - ), - Email::MIME->create( - attributes => { content_type => 'text/plain', }, - body => 'bye', - ) - ]; - my $email = Email::MIME->create( - header_str => [ From => 'a@example.com', Subject => 'blah' ], - parts => $parts, - ); - is(1, PublicInbox::Filter->run($email), "run was a success"); - my $parsed = Email::MIME->new($email->as_string); - is(scalar $parsed->parts, 2, "still 2 parts"); - my %bodies; - $parsed->walk_parts(sub { - my ($part) = @_; - return if $part->subparts; # walk_parts already recurses - count_body_parts(\%bodies, $part); - }); - is(scalar keys %bodies, 2, "two bodies"); - is($bodies{"bye"}, 1, "bye part exists"); - is($bodies{"hi"}, 1, "hi part exists"); - is($parsed->header("X-Content-Filtered-By"), undef, - "XCFB header unset"); -} - -# multi-part HTML, several HTML parts -{ - my $parts = [ - Email::MIME->create( - attributes => { - content_type => 'text/html', - encoding => 'base64', - }, - body => '<html><body>b64 body</body></html>', - ), - Email::MIME->create( - attributes => { - content_type => 'text/html', - encoding => 'quoted-printable', - }, - body => '<html><body>qp body</body></html>', - ) - ]; - my $email = Email::MIME->create( - header_str => [ From => 'a@example.com', Subject => 'blah' ], - parts => $parts, - ); - is(1, PublicInbox::Filter->run($email), "run was a success"); - my $parsed = Email::MIME->new($email->as_string); - is(scalar $parsed->parts, 2, "still 2 parts"); - my %bodies; - $parsed->walk_parts(sub { - my ($part) = @_; - return if $part->subparts; # walk_parts already recurses - count_body_parts(\%bodies, $part); - }); - is(scalar keys %bodies, 2, "two body parts"); - is($bodies{"b64 body"}, 1, "base64 part converted"); - is($bodies{"qp body"}, 1, "qp part converted"); - like($parsed->header("X-Content-Filtered-By"), qr/PublicInbox::Filter/, - "XCFB header added"); -} - -# plain-text with image attachments, kill images -{ - my $parts = [ - Email::MIME->create( - attributes => { content_type => 'text/plain' }, - body => 'see image', - ), - Email::MIME->create( - attributes => { - content_type => 'image/jpeg', - filename => 'scary.jpg', - encoding => 'base64', - }, - body => 'bad', - ) - ]; - my $email = Email::MIME->create( - header_str => [ From => 'a@example.com', Subject => 'blah' ], - parts => $parts, - ); - is(1, PublicInbox::Filter->run($email), "run was a success"); - my $parsed = Email::MIME->new($email->as_string); - is(scalar $parsed->parts, 1, "image part removed"); - my %bodies; - $parsed->walk_parts(sub { - my ($part) = @_; - return if $part->subparts; # walk_parts already recurses - count_body_parts(\%bodies, $part); - }); - is(scalar keys %bodies, 1, "one body"); - is($bodies{'see image'}, 1, 'original body exists'); - like($parsed->header("X-Content-Filtered-By"), qr/PublicInbox::Filter/, - "XCFB header added"); -} - -# all bad -{ - my $parts = [ - Email::MIME->create( - attributes => { - content_type => 'image/jpeg', - filename => 'scary.jpg', - encoding => 'base64', - }, - body => 'bad', - ), - Email::MIME->create( - attributes => { - content_type => 'text/plain', - filename => 'scary.exe', - encoding => 'base64', - }, - body => 'bad', - ), - ]; - my $email = Email::MIME->create( - header_str => [ From => 'a@example.com', Subject => 'blah' ], - parts => $parts, - ); - is(0, PublicInbox::Filter->run($email), - "run signaled to stop delivery"); - my $parsed = Email::MIME->new($email->as_string); - is(scalar $parsed->parts, 1, "bad parts removed"); - my %bodies; - $parsed->walk_parts(sub { - my ($part) = @_; - return if $part->subparts; # walk_parts already recurses - count_body_parts(\%bodies, $part); - }); - is(scalar keys %bodies, 1, "one body"); - is($bodies{"all attachments scrubbed by PublicInbox::Filter"}, 1, - "attachment scrubber left its mark"); - like($parsed->header("X-Content-Filtered-By"), qr/PublicInbox::Filter/, - "XCFB header added"); -} - -{ - my $s = Email::MIME->create( - header => [ - From => 'a@example.com', - To => 'b@example.com', - 'Content-Type' => 'test/pain', - Subject => 'this is a subject', - ], - body => "hello world\n", - ); - is(0, PublicInbox::Filter->run($s), "run was a failure"); - like($s->as_string, qr/scrubbed/, "scrubbed message"); -} - -{ - my $s = Email::MIME->create( - header => [ - From => 'a@example.com', - To => 'b@example.com', - 'Content-Type' => 'text/plain', - 'Mail-Followup-To' => 'c@example.com', - Subject => 'mfttest', - ], - body => "mft\n", - ); - - is('c@example.com', $s->header("Mail-Followup-To"), - "mft set correctly"); - is(1, PublicInbox::Filter->run($s), "run succeeded for mft"); - is(undef, $s->header("Mail-Followup-To"), "mft stripped"); -} - -# multi-part with application/octet-stream -{ - my $os = 'application/octet-stream'; - my $parts = [ - Email::MIME->create( - attributes => { content_type => $os }, - body => <<EOF -#include <stdio.h> -int main(void) -{ - printf("Hello world\\n"); - return 0; -} - -/* some folks like ^L */ -EOF - ), - Email::MIME->create( - attributes => { - filename => 'zero.data', - encoding => 'base64', - content_type => $os, - }, - body => ("\0" x 4096), - ) - ]; - my $email = Email::MIME->create( - header_str => [ From => 'a@example.com', Subject => 'blah' ], - parts => $parts, - ); - is(1, PublicInbox::Filter->run($email), "run was a success"); - my $parsed = Email::MIME->new($email->as_string); - is(scalar $parsed->parts, 1, "only one remaining part"); - like($parsed->header("X-Content-Filtered-By"), - qr/PublicInbox::Filter/, "XCFB header added"); -} - -done_testing(); diff --git a/t/filter_base.t b/t/filter_base.t new file mode 100644 index 00000000..ee5c7307 --- /dev/null +++ b/t/filter_base.t @@ -0,0 +1,81 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use_ok 'PublicInbox::Filter::Base'; + +{ + my $f = PublicInbox::Filter::Base->new; + ok($f, 'created stock object'); + ok(defined $f->{reject_suffix}, 'rejected suffix redefined'); + is(ref($f->{reject_suffix}), 'Regexp', 'reject_suffix should be a RE'); +} + +{ + my $f = PublicInbox::Filter::Base->new(reject_suffix => undef); + ok($f, 'created base object q/o reject_suffix'); + ok(!defined $f->{reject_suffix}, 'reject_suffix not defined'); +} + +{ + my $f = PublicInbox::Filter::Base->new; + my $html_body = "<html><body>hi</body></html>"; + my $parts = [ + Email::MIME->create( + attributes => { + content_type => 'text/xhtml; charset=UTF-8', + encoding => 'base64', + }, + body => $html_body, + ), + Email::MIME->create( + attributes => { + content_type => 'text/plain', + encoding => 'quoted-printable', + }, + body => 'hi = "bye"', + ) + ]; + my $email = Email::MIME->create( + header_str => [ + From => 'a@example.com', + Subject => 'blah', + 'Content-Type' => 'multipart/alternative' + ], + parts => $parts, + ); + is($f->delivery($email), 100, "xhtml rejected"); +} + +{ + my $f = PublicInbox::Filter::Base->new; + my $parts = [ + Email::MIME->create( + attributes => { + content_type => 'application/vnd.ms-excel', + encoding => 'base64', + }, + body => 'junk', + ), + Email::MIME->create( + attributes => { + content_type => 'text/plain', + encoding => 'quoted-printable', + }, + body => 'junk', + ) + ]; + my $email = Email::MIME->create( + header_str => [ + From => 'a@example.com', + Subject => 'blah', + 'Content-Type' => 'multipart/mixed' + ], + parts => $parts, + ); + is($f->delivery($email), 100, 'proprietary format rejected on glob'); +} + +done_testing(); diff --git a/t/filter_mirror.t b/t/filter_mirror.t new file mode 100644 index 00000000..01be282e --- /dev/null +++ b/t/filter_mirror.t @@ -0,0 +1,40 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use_ok 'PublicInbox::Filter::Mirror'; + +my $f = PublicInbox::Filter::Mirror->new; +ok($f, 'created PublicInbox::Filter::Mirror object'); +{ + 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"', + ) + ]; + my $email = Email::MIME->create( + header_str => [ + From => 'a@example.com', + Subject => 'blah', + 'Content-Type' => 'multipart/alternative' + ], + parts => $parts, + ); + is($f->ACCEPT, $f->delivery($email), 'accept any trash that comes'); +} + +done_testing(); diff --git a/t/filter_vger.t b/t/filter_vger.t new file mode 100644 index 00000000..83a4c9ee --- /dev/null +++ b/t/filter_vger.t @@ -0,0 +1,46 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use_ok 'PublicInbox::Filter::Vger'; + +my $f = PublicInbox::Filter::Vger->new; +ok($f, 'created PublicInbox::Filter::Vger object'); +{ + my $lkml = <<'EOF'; +From: foo@example.com +Subject: test + +keep this +-- +To unsubscribe from this list: send the line "unsubscribe linux-kernel" in +the body of a message to majordomo@vger.kernel.org +More majordomo info at http://vger.kernel.org/majordomo-info.html +Please read the FAQ at http://www.tux.org/lkml/ +EOF + + my $mime = Email::MIME->new($lkml); + $mime = $f->delivery($mime); + is("keep this\n", $mime->body, 'normal message filtered OK'); +} + +{ + my $no_nl = <<'EOF'; +From: foo@example.com +Subject: test + +OSX users :P-- +To unsubscribe from this list: send the line "unsubscribe git" in +the body of a message to majordomo@vger.kernel.org +More majordomo info at http://vger.kernel.org/majordomo-info.html +EOF + + my $mime = Email::MIME->new($no_nl); + $mime = $f->delivery($mime); + is('OSX users :P', $mime->body, 'missing trailing LF in original OK'); +} + + +done_testing(); diff --git a/t/git-http-backend.psgi b/t/git-http-backend.psgi new file mode 100644 index 00000000..66f41505 --- /dev/null +++ b/t/git-http-backend.psgi @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use PublicInbox::GitHTTPBackend; +use PublicInbox::Git; +use Plack::Builder; +use BSD::Resource qw(getrusage); +my $git_dir = $ENV{GIANT_GIT_DIR} or die 'GIANT_GIT_DIR not defined in env'; +my $git = PublicInbox::Git->new($git_dir); +builder { + enable 'Head'; + sub { + my ($env) = @_; + if ($env->{PATH_INFO} =~ m!\A/(.+)\z!s) { + PublicInbox::GitHTTPBackend::serve($env, $git, $1); + } else { + my $ru = getrusage(); + my $b = $ru->maxrss . "\n"; + [ 200, [ qw(Content-Type text/plain Content-Length), + length($b) ], [ $b ] ] + } + } +} diff --git a/t/git-http-backend.t b/t/git-http-backend.t new file mode 100644 index 00000000..e506e772 --- /dev/null +++ b/t/git-http-backend.t @@ -0,0 +1,134 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use File::Temp qw/tempdir/; +use IO::Socket; +use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD); +use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY); +use POSIX qw(dup2 setsid); +use Cwd qw(getcwd); + +my $git_dir = $ENV{GIANT_GIT_DIR}; +plan 'skip_all' => 'GIANT_GIT_DIR not defined' unless $git_dir; +foreach my $mod (qw(Danga::Socket BSD::Resource + Plack::Util Plack::Builder + HTTP::Date HTTP::Status Net::HTTP)) { + eval "require $mod"; + plan skip_all => "$mod missing for git-http-backend.t" if $@; +} +my $psgi = getcwd()."/t/git-http-backend.psgi"; +my $tmpdir = tempdir('pi-git-http-backend-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $httpd = 'blib/script/public-inbox-httpd'; +my %opts = ( + LocalAddr => '127.0.0.1', + ReuseAddr => 1, + Proto => 'tcp', + Type => SOCK_STREAM, + Listen => 1024, +); +my $sock = IO::Socket::INET->new(%opts); +my $host = $sock->sockhost; +my $port = $sock->sockport; +my $pid; +END { kill 'TERM', $pid if defined $pid }; + +my $get_maxrss = sub { + my $http = Net::HTTP->new(Host => "$host:$port"); + ok($http, 'Net::HTTP object created for maxrss'); + $http->write_request(GET => '/'); + my ($code, $mess, %h) = $http->read_response_headers; + is($code, 200, 'success reading maxrss'); + my $n = $http->read_entity_body(my $buf, 256); + ok(defined $n, 'read response body'); + like($buf, qr/\A\d+\n\z/, 'got memory response'); + ok(int($buf) > 0, 'got non-zero memory response'); + int($buf); +}; + +{ + ok($sock, 'sock created'); + $pid = fork; + if ($pid == 0) { # pretend to be systemd + fcntl($sock, F_SETFD, 0); + dup2(fileno($sock), 3) or die "dup2 failed: $!\n"; + $ENV{LISTEN_PID} = $$; + $ENV{LISTEN_FDS} = 1; + $ENV{TEST_CHUNK} = '1'; + exec $httpd, "--stdout=$out", "--stderr=$err", $psgi; + die "FAIL: $!\n"; + } + ok(defined $pid, 'forked httpd process successfully'); +} +my $mem_a = $get_maxrss->(); + +SKIP: { + my $max = 0; + my $pack; + my $glob = "$git_dir/objects/pack/pack-*.pack"; + foreach my $f (glob($glob)) { + my $n = -s $f; + if ($n > $max) { + $max = $n; + $pack = $f; + } + } + skip "no packs found in $git_dir" unless defined $pack; + if ($pack !~ m!(/objects/pack/pack-[a-f0-9]{40}.pack)\z!) { + skip "bad pack name: $pack"; + } + my $url = $1; + my $http = Net::HTTP->new(Host => "$host:$port"); + ok($http, 'Net::HTTP object created'); + $http->write_request(GET => $url); + my ($code, $mess, %h) = $http->read_response_headers; + is(200, $code, 'got 200 success for pack'); + is($max, $h{'Content-Length'}, 'got expected Content-Length for pack'); + foreach my $i (1..3) { + sleep 1; + my $diff = $get_maxrss->() - $mem_a; + note "${diff}K memory increase after $i seconds"; + ok($diff < 1024, 'no bloating caused by slow dumb client'); + } +} + +{ + my $c = fork; + if ($c == 0) { + setsid(); + exec qw(git clone -q --mirror), "http://$host:$port/", + "$tmpdir/mirror.git"; + die "Failed start git clone: $!\n"; + } + select(undef, undef, undef, 0.1); + foreach my $i (1..10) { + is(1, kill('STOP', -$c), 'signaled clone STOP'); + sleep 1; + ok(kill('CONT', -$c), 'continued clone'); + my $diff = $get_maxrss->() - $mem_a; + note "${diff}K memory increase after $i seconds"; + ok($diff < 2048, 'no bloating caused by slow smart client'); + } + ok(kill('CONT', -$c), 'continued clone'); + is($c, waitpid($c, 0), 'reaped wayward slow clone'); + is($?, 0, 'clone did not error out'); + note 'clone done, fsck-ing clone result...'; + is(0, system("git", "--git-dir=$tmpdir/mirror.git", + qw(fsck --no-progress)), + 'fsck did not report corruption'); + + my $diff = $get_maxrss->() - $mem_a; + note "${diff}K memory increase after smart clone"; + ok($diff < 2048, 'no bloating caused by slow smart client'); +} + +{ + ok(kill('TERM', $pid), 'killed httpd'); + $pid = undef; + waitpid(-1, 0); +} + +done_testing(); diff --git a/t/html_index.t b/t/html_index.t index adbadaf4..f29b442d 100644 --- a/t/html_index.t +++ b/t/html_index.t @@ -3,11 +3,22 @@ use strict; use warnings; use Test::More; -use Email::Simple; +use Email::MIME; use PublicInbox::Feed; +use PublicInbox::Git; +use PublicInbox::Import; +use PublicInbox::Inbox; use File::Temp qw/tempdir/; my $tmpdir = tempdir('pi-http-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $git_dir = "$tmpdir/gittest"; +my $ibx = PublicInbox::Inbox->new({ + address => 'test@example', + name => 'tester', + mainrepo => $git_dir, + url => 'http://example.com/test', +}); +my $git = $ibx->git; +my $im = PublicInbox::Import->new($git, 'tester', 'test@example'); # setup { @@ -15,19 +26,13 @@ my $git_dir = "$tmpdir/gittest"; my $prev = ""; foreach my $i (1..6) { - local $ENV{GIT_DIR} = $git_dir; - my $pid = open(my $pipe, "|-"); - defined $pid or die "fork/pipe failed: $!\n"; - if ($pid == 0) { - exec("ssoma-mda", $git_dir); - } my $mid = "<$i\@example.com>"; my $mid_line = "Message-ID: $mid"; if ($prev) { $mid_line .= "In-Reply-To: $prev"; } $prev = $mid; - my $simple = Email::Simple->new(<<EOF); + my $mime = Email::MIME->new(<<EOF); From: ME <me\@example.com> To: U <u\@example.com> $mid_line @@ -43,20 +48,9 @@ msg $i keep me EOF - print $pipe $simple->as_string or die "print failed: $!\n"; - close $pipe or die "close pipe failed: $!\n"; + like($im->add($mime), qr/\A:\d+\z/, 'inserted message'); } -} - -# check HTML index -{ - use IO::File; - my $cb = PublicInbox::Feed::generate_html_index({ - git_dir => $git_dir, - max => 3 - }); - require 't/common.perl'; - like(stream_to_string($cb), qr/html/, "feed is valid HTML :)"); + $im->done; } done_testing(); diff --git a/t/httpd-corner.psgi b/t/httpd-corner.psgi index da8a2ee8..ed1f92c0 100644 --- a/t/httpd-corner.psgi +++ b/t/httpd-corner.psgi @@ -30,6 +30,7 @@ my $app = sub { return sub { open my $f, '<', $fifo or die "open $fifo: $!\n"; + local $/ = "\n"; my @r = <$f>; $_[0]->([200, $h, \@r ]); }; @@ -38,6 +39,7 @@ my $app = sub { my $fh = $_[0]->([200, $h]); open my $f, '<', $fifo or die "open $fifo: $!\n"; + local $/ = "\n"; while (defined(my $l = <$f>)) { $fh->write($l); } @@ -56,6 +58,20 @@ my $app = sub { $fh->write($buf); $fh->close; } + } elsif ($path eq '/empty') { + $code = 200; + } elsif ($path eq '/getline-die') { + $code = 200; + $body = Plack::Util::inline_object( + getline => sub { die 'GETLINE FAIL' }, + close => sub { die 'CLOSE FAIL' }, + ); + } elsif ($path eq '/close-die') { + $code = 200; + $body = Plack::Util::inline_object( + getline => sub { undef }, + close => sub { die 'CLOSE FAIL' }, + ); } [ $code, $h, $body ] diff --git a/t/httpd-corner.t b/t/httpd-corner.t index b64f334a..8a0337c2 100644 --- a/t/httpd-corner.t +++ b/t/httpd-corner.t @@ -5,8 +5,9 @@ use strict; use warnings; use Test::More; +use Time::HiRes qw(gettimeofday tv_interval); -foreach my $mod (qw(Plack::Util Plack::Request Plack::Builder Danga::Socket +foreach my $mod (qw(Plack::Util Plack::Builder Danga::Socket HTTP::Date HTTP::Status)) { eval "require $mod"; plan skip_all => "$mod missing for httpd-corner.t" if $@; @@ -85,6 +86,30 @@ my $spawn_httpd = sub { } { + my $conn = conn_for($sock, 'getline-die'); + $conn->write("GET /getline-die HTTP/1.1\r\nHost: example.com\r\n\r\n"); + ok($conn->read(my $buf, 8192), 'read some response'); + like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header'); + is($conn->read(my $nil, 8192), 0, 'read EOF'); + $conn = undef; + my $after = capture($err); + is(scalar(grep(/GETLINE FAIL/, @$after)), 1, 'failure logged'); + is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called'); +} + +{ + my $conn = conn_for($sock, 'close-die'); + $conn->write("GET /close-die HTTP/1.1\r\nHost: example.com\r\n\r\n"); + ok($conn->read(my $buf, 8192), 'read some response'); + like($buf, qr!HTTP/1\.1 200\b[^\r]*\r\n!, 'got some sort of header'); + is($conn->read(my $nil, 8192), 0, 'read EOF'); + $conn = undef; + my $after = capture($err); + is(scalar(grep(/GETLINE FAIL/, @$after)), 0, 'getline not failed'); + is(scalar(grep(/CLOSE FAIL/, @$after)), 1, 'body->close not called'); +} + +{ my $conn = conn_for($sock, 'excessive header'); $SIG{PIPE} = 'IGNORE'; $conn->write("GET /callback HTTP/1.0\r\n"); @@ -218,7 +243,6 @@ my $check_self = sub { SKIP: { use POSIX qw(dup2); - use IO::File; my $have_curl = 0; foreach my $p (split(':', $ENV{PATH})) { -x "$p/curl" or next; @@ -230,7 +254,7 @@ SKIP: { my $url = 'http://' . $sock->sockhost . ':' . $sock->sockport . '/sha1'; my ($r, $w); pipe($r, $w) or die "pipe: $!"; - my $tout = IO::File->new_tmpfile or die "new_tmpfile: $!"; + open(my $tout, '+>', undef) or die "open temporary file: $!"; my $pid = fork; defined $pid or die "fork: $!"; my @cmd = (qw(curl --tcp-nodelay --no-buffer -T- -HExpect: -sS), $url); @@ -275,6 +299,18 @@ SKIP: { } { + my $conn = conn_for($sock, 'no TCP_CORK on empty body'); + $conn->write("GET /empty HTTP/1.1\r\nHost:example.com\r\n\r\n"); + my $buf = ''; + my $t0 = [ gettimeofday ]; + until ($buf =~ /\r\n\r\n/s) { + $conn->sysread($buf, 4096, length($buf)); + } + my $elapsed = tv_interval($t0, [ gettimeofday ]); + ok($elapsed < 0.190, 'no 200ms TCP cork delay on empty body'); +} + +{ my $conn = conn_for($sock, 'graceful termination during slow request'); $conn->write("PUT /sha1 HTTP/1.0\r\n"); delay(); @@ -476,4 +512,13 @@ SKIP: { done_testing(); +sub capture { + my ($f) = @_; + open my $fh, '+<', $f or die "failed to open $f: $!\n"; + local $/ = "\n"; + my @r = <$fh>; + truncate($fh, 0) or die "truncate failed on $f: $!\n"; + \@r +} + 1; diff --git a/t/httpd-unix.t b/t/httpd-unix.t index 00adf13c..4b0f116e 100644 --- a/t/httpd-unix.t +++ b/t/httpd-unix.t @@ -5,7 +5,7 @@ use strict; use warnings; use Test::More; -foreach my $mod (qw(Plack::Util Plack::Request Plack::Builder Danga::Socket +foreach my $mod (qw(Plack::Util Plack::Builder Danga::Socket HTTP::Date HTTP::Status)) { eval "require $mod"; plan skip_all => "$mod missing for httpd-unix.t" if $@; @@ -54,6 +54,7 @@ ok(-S $unix, 'UNIX socket was bound by -httpd'); sub check_sock ($) { my ($unix) = @_; my $sock = IO::Socket::UNIX->new(Peer => $unix, Type => SOCK_STREAM); + warn "E: $! connecting to $unix\n" unless defined $sock; ok($sock, 'client UNIX socket connected'); ok($sock->write("GET /host-port HTTP/1.0\r\n\r\n"), 'wrote req to server'); @@ -103,6 +104,7 @@ SKIP: { ok(-f "$tmpdir/pid", 'pid file written'); open my $fh, '<', "$tmpdir/pid" or die "open failed: $!"; + local $/ = "\n"; my $rpid = <$fh>; chomp $rpid; like($rpid, qr/\A\d+\z/s, 'pid file looks like a pid'); @@ -4,7 +4,7 @@ use strict; use warnings; use Test::More; -foreach my $mod (qw(Plack::Util Plack::Request Plack::Builder Danga::Socket +foreach my $mod (qw(Plack::Util Plack::Builder Danga::Socket HTTP::Date HTTP::Status)) { eval "require $mod"; plan skip_all => "$mod missing for httpd.t" if $@; @@ -14,24 +14,16 @@ use Cwd qw/getcwd/; use IO::Socket; use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD); use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY); -use IPC::Run; # FIXME: too much setup my $tmpdir = tempdir('pi-httpd-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $home = "$tmpdir/pi-home"; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $pi_home = "$home/.public-inbox"; -my $pi_config = "$pi_home/config"; my $maindir = "$tmpdir/main.git"; -my $main_bin = getcwd()."/t/main-bin"; -my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock my $group = 'test-httpd'; my $addr = $group . '@example.com'; my $cfgpfx = "publicinbox.$group"; -my $failbox = "$home/fail.mbox"; -local $ENV{PI_EMERGENCY} = $failbox; -my $mda = 'blib/script/public-inbox-mda'; my $httpd = 'blib/script/public-inbox-httpd'; my $init = 'blib/script/public-inbox-init'; @@ -44,6 +36,9 @@ my %opts = ( ); my $sock = IO::Socket::INET->new(%opts); my $pid; +use_ok 'PublicInbox::Git'; +use_ok 'PublicInbox::Import'; +use_ok 'Email::MIME'; END { kill 'TERM', $pid if defined $pid }; { local $ENV{HOME} = $home; @@ -52,8 +47,7 @@ END { kill 'TERM', $pid if defined $pid }; # ensure successful message delivery { - local $ENV{ORIGINAL_RECIPIENT} = $addr; - my $in = <<EOF; + my $mime = Email::MIME->new(<<EOF); From: Me <me\@example.com> To: You <you\@example.com> Cc: $addr @@ -63,9 +57,11 @@ Date: Thu, 01 Jan 1970 06:06:06 +0000 nntp EOF - local $ENV{PATH} = $main_path; - IPC::Run::run([$mda], \$in); - is(0, $?, 'ran MDA correctly'); + $mime->header_set('List-Id', "<$addr>"); + my $git = PublicInbox::Git->new($maindir); + my $im = PublicInbox::Import->new($git, 'test', $addr); + $im->add($mime); + $im->done($mime); } ok($sock, 'sock created'); $! = 0; @@ -104,7 +100,16 @@ EOF is(system(qw(git clone -q --mirror), "http://$host:$port/$group", "$tmpdir/clone.git"), + 0, 'smart clone successful'); + + # ensure dumb cloning works, too: + is(system('git', "--git-dir=$maindir", + qw(config http.uploadpack false)), + 0, 'disable http.uploadpack'); + is(system(qw(git clone -q --mirror), + "http://$host:$port/$group", "$tmpdir/dumb.git"), 0, 'clone successful'); + ok(kill('TERM', $pid), 'killed httpd'); $pid = undef; waitpid(-1, 0); diff --git a/t/import.t b/t/import.t new file mode 100644 index 00000000..73f92adb --- /dev/null +++ b/t/import.t @@ -0,0 +1,69 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use PublicInbox::Git; +use PublicInbox::Import; +use File::Temp qw/tempdir/; +my $dir = tempdir('pi-import-XXXXXX', TMPDIR => 1, CLEANUP => 1); + +is(system(qw(git init -q --bare), $dir), 0, 'git init successful'); +my $git = PublicInbox::Git->new($dir); + +my $im = PublicInbox::Import->new($git, 'testbox', 'test@example'); +my $mime = Email::MIME->create( + header => [ + From => 'a@example.com', + To => 'b@example.com', + 'Content-Type' => 'text/plain', + Subject => 'this is a subject', + 'Message-ID' => '<a@example.com>', + ], + body => "hello world\n", +); +like($im->add($mime), qr/\A:\d+\z/, 'added one message'); +$im->done; +my @revs = $git->qx(qw(rev-list HEAD)); +is(scalar @revs, 1, 'one revision created'); + +$mime->header_set('Message-ID', '<b@example.com>'); +$mime->header_set('Subject', 'msg2'); +like($im->add($mime, sub { $mime }), qr/\A:\d+\z/, 'added 2nd message'); +$im->done; +@revs = $git->qx(qw(rev-list HEAD)); +is(scalar @revs, 2, '2 revisions exist'); + +is($im->add($mime), undef, 'message only inserted once'); +$im->done; +@revs = $git->qx(qw(rev-list HEAD)); +is(scalar @revs, 2, '2 revisions exist'); + +foreach my $c ('c'..'z') { + $mime->header_set('Message-ID', "<$c\@example.com>"); + $mime->header_set('Subject', "msg - $c"); + like($im->add($mime), qr/\A:\d+\z/, "added $c message"); +} +$im->done; +@revs = $git->qx(qw(rev-list HEAD)); +is(scalar @revs, 26, '26 revisions exist after mass import'); +my ($mark, $msg) = $im->remove($mime); +like($mark, qr/\A:\d+\z/, 'got mark'); +is(ref($msg), 'Email::MIME', 'got old message deleted'); + +is(undef, $im->remove($mime), 'remove is idempotent'); + +# mismatch on identical Message-ID +$mime->header_set('Message-ID', '<a@example.com>'); +($mark, $msg) = $im->remove($mime); +is($mark, 'MISMATCH', 'mark == MISMATCH on mismatch'); +is($msg->header('Message-ID'), '<a@example.com>', 'Message-ID matches'); +isnt($msg->header('Subject'), $mime->header('Subject'), 'subject mismatch'); + +$mime->header_set('Message-Id', '<failcheck@example.com>'); +is($im->add($mime, sub { undef }), undef, 'check callback fails'); +is($im->remove($mime), undef, 'message not added, so not removed'); + +$im->done; +done_testing(); diff --git a/t/inbox.t b/t/inbox.t new file mode 100644 index 00000000..9909dc53 --- /dev/null +++ b/t/inbox.t @@ -0,0 +1,15 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use_ok 'PublicInbox::Inbox'; +my $x = PublicInbox::Inbox->new({url => '//example.com/test/'}); +is($x->base_url, 'https://example.com/test/', 'expanded protocol-relative'); +$x = PublicInbox::Inbox->new({url => 'http://example.com/test'}); +is($x->base_url, 'http://example.com/test/', 'added trailing slash'); + +$x = PublicInbox::Inbox->new({}); +is($x->base_url, undef, 'undef base_url allowed'); + +done_testing(); @@ -13,10 +13,16 @@ use constant pi_init => 'blib/script/public-inbox-init'; my $cfgfile = "$ENV{PI_DIR}/config"; my @cmd = (pi_init, 'blist', "$tmpdir/blist", qw(http://example.com/blist blist@example.com)); - is(system(@cmd), 0, 'public-inbox-init failed'); + is(system(@cmd), 0, 'public-inbox-init OK'); ok(-e $cfgfile, "config exists, now"); - is(system(@cmd), 0, 'public-inbox-init failed (idempotent)'); + is(system(@cmd), 0, 'public-inbox-init OK (idempotent)'); + + chmod 0666, $cfgfile or die "chmod failed: $!"; + @cmd = (pi_init, 'clist', "$tmpdir/clist", + qw(http://example.com/clist clist@example.com)); + is(system(@cmd), 0, 'public-inbox-init clist OK'); + is((stat($cfgfile))[2] & 07777, 0666, "permissions preserved"); } done_testing(); diff --git a/t/linkify.t b/t/linkify.t index 586691ae..99acf17d 100644 --- a/t/linkify.t +++ b/t/linkify.t @@ -23,4 +23,60 @@ use PublicInbox::Linkify; is($s, qq(<a\nhref="$u">$u</a>;), 'trailing semicolon not in URL'); } +{ + my $l = PublicInbox::Linkify->new; + my $u = 'http://example.com/url-with-(parens)'; + my $s = "hello $u world"; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq(hello <a\nhref="$u">$u</a> world), 'URL preserved'); + + $u .= "?query=a"; + $s = "hello $u world"; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq(hello <a\nhref="$u">$u</a> world), 'query preserved'); + + $u .= "#fragment"; + $s = "hello $u world"; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq(hello <a\nhref="$u">$u</a> world), + 'query + fragment preserved'); + + $u = "http://example.com/"; + $s = "hello $u world"; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq(hello <a\nhref="$u">$u</a> world), "root URL preserved"); + + $u = "http://example.com/#fragment"; + $s = "hello $u world"; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq(hello <a\nhref="$u">$u</a> world), "root + fragment"); +} + +# Markdown compatibility +{ + my $l = PublicInbox::Linkify->new; + my $u = 'http://example.com/'; + my $s = "[markdown]($u)"; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq![markdown](<a\nhref="$u">$u</a>)!, 'Markdown-compatible'); + + $s = qq!; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq![markdown](<a\nhref="$u">$u</a> "title")!, + 'Markdown title compatible'); + + $s = qq.!; + $s = $l->linkify_1($s); + $s = $l->linkify_2($s); + is($s, qq![markdown](<a\nhref="$u">$u</a>).!, + 'Markdown-compatible end of sentence'); +} + done_testing(); @@ -4,10 +4,11 @@ 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); +eval { require IPC::Run }; +plan skip_all => "missing IPC::Run for t/mda.t" if $@; my $mda = "blib/script/public-inbox-mda"; my $learn = "blib/script/public-inbox-learn"; @@ -22,7 +23,7 @@ my $fail_bin = getcwd()."/t/fail-bin"; 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 $faildir = "$home/faildir/"; my $mime; { @@ -47,14 +48,19 @@ my $mime; 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 ($author, $email, $date) = PublicInbox::MDA->author_info($msg); + my $msg = Email::MIME->new($str); + + my $from = $msg->header('From'); + my ($author) = PublicInbox::Address::names($from); + my ($email) = PublicInbox::Address::emails($from); + my $date = $msg->header('Date'); + is('Eléanor', encode('us-ascii', my $tmp = $author, Encode::HTMLCREF), 'HTML conversion is correct'); @@ -67,7 +73,7 @@ die $@ if $@; { my $good_rev; - local $ENV{PI_EMERGENCY} = $failbox; + local $ENV{PI_EMERGENCY} = $faildir; local $ENV{HOME} = $home; local $ENV{ORIGINAL_RECIPIENT} = $addr; my $simple = Email::Simple->new(<<EOF); @@ -84,12 +90,11 @@ EOF # ensure successful message delivery { local $ENV{PATH} = $main_path; - run([$mda], \$in); - local $ENV{GIT_DIR} = $maindir; - my $rev = `git rev-list HEAD`; + IPC::Run::run([$mda], \$in); + 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, @@ -99,13 +104,14 @@ EOF # ensure failures work, fail with bad spamc { - ok(!-e $failbox, "nothing in PI_EMERGENCY before"); + my @prev = <$faildir/new/*>; + is(scalar @prev, 0 , "nothing in PI_EMERGENCY before"); local $ENV{PATH} = $fail_path; - run([$mda], \$in); - local $ENV{GIT_DIR} = $maindir; - my @revs = `git rev-list HEAD`; + IPC::Run::run([$mda], \$in); + 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"); + my @new = <$faildir/new/*>; + is(scalar @new, 1, "PI_EMERGENCY is written to"); } fail_bad_header($good_rev, "bad recipient", <<""); @@ -155,7 +161,7 @@ Date: deadbeef # spam training { - local $ENV{PI_EMERGENCY} = $failbox; + local $ENV{PI_EMERGENCY} = $faildir; local $ENV{HOME} = $home; local $ENV{ORIGINAL_RECIPIENT} = $addr; local $ENV{PATH} = $main_path; @@ -173,23 +179,25 @@ EOF { # deliver the spam message, first - run([$mda], \$in); - my $msg = `ssoma cat $mid $maindir`; + IPC::Run::run([$mda], \$in); + 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 local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com'; local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com'; - run([$learn, "spam"], \$msg); + local $ENV{GIT_COMMITTER_NAME} = undef; + IPC::Run::run([$learn, "spam"], \$msg); is($?, 0, "no failure from learning spam"); - run([$learn, "spam"], \$msg); + IPC::Run::run([$learn, "spam"], \$msg); is($?, 0, "no failure from learning spam idempotently"); } } # train ham message { - local $ENV{PI_EMERGENCY} = $failbox; + local $ENV{PI_EMERGENCY} = $faildir; local $ENV{HOME} = $home; local $ENV{ORIGINAL_RECIPIENT} = $addr; local $ENV{PATH} = $main_path; @@ -210,11 +218,12 @@ EOF local $ENV{GIT_AUTHOR_EMAIL} = 'trainer@example.com'; local $ENV{GIT_COMMITTER_EMAIL} = 'trainer@example.com'; - run([$learn, "ham"], \$in); + IPC::Run::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); + IPC::Run::run([$learn, "ham"], \$in); is($?, 0, "learned ham idempotently "); # ensure trained email is filtered, too @@ -249,81 +258,28 @@ EOF { $in = $mime->as_string; - run([$learn, "ham"], \$in); + IPC::Run::run([$learn, "ham"], \$in); is($?, 0, "learned ham without failure"); - $msg = `ssoma cat $mid $maindir`; + 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 -{ - my $faildir= "$home/faildir/"; - local $ENV{PI_EMERGENCY} = $faildir; - local $ENV{HOME} = $home; - local $ENV{ORIGINAL_RECIPIENT} = $addr; - local $ENV{PATH} = $fail_path; - my $in = <<EOF; -From: Faildir <faildir\@example.com> -To: You <you\@example.com> -Cc: $addr -Message-ID: <faildir\@example.com> -Subject: faildir subject -Date: Thu, 01 Jan 1970 00:00:00 +0000 - -EOF - run([$mda], \$in); - 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(); sub fail_bad_header { my ($good_rev, $msg, $in) = @_; - open my $fh, '>', $failbox or die "failed to open $failbox: $!\n"; - close $fh or die "failed to close $failbox: $!\n"; + my @f = glob("$faildir/*/*"); + unlink @f if @f; my ($out, $err) = ("", ""); local $ENV{PATH} = $main_path; - run([$mda], \$in, \$out, \$err); - local $ENV{GIT_DIR} = $maindir; - my $rev = `git rev-list HEAD`; + IPC::Run::run([$mda], \$in, \$out, \$err); + 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)"); + @f = glob("$faildir/*/*"); + is(scalar @f, 1, "faildir written to"); [ $in, $out, $err ]; } diff --git a/t/mid.t b/t/mid.t new file mode 100644 index 00000000..b0af8386 --- /dev/null +++ b/t/mid.t @@ -0,0 +1,11 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use Test::More; +use PublicInbox::MID qw(mid_escape); + +is(mid_escape('foo!@(bar)'), 'foo!@(bar)'); +is(mid_escape('foo%!@(bar)'), 'foo%25!@(bar)'); +is(mid_escape('foo%!@(bar)'), 'foo%25!@(bar)'); + +done_testing(); +1; diff --git a/t/msg_iter.t b/t/msg_iter.t new file mode 100644 index 00000000..7ade6e41 --- /dev/null +++ b/t/msg_iter.t @@ -0,0 +1,44 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use_ok('PublicInbox::MsgIter'); + +{ + my $parts = [ Email::MIME->create(body => "a\n"), + Email::MIME->create(body => "b\n") ]; + my $mime = Email::MIME->create(parts => $parts, + header_str => [ From => 'root@localhost' ]); + my @parts; + msg_iter($mime, sub { + my ($part, $level, @ex) = @{$_[0]}; + my $s = $part->body_str; + $s =~ s/\s+//s; + push @parts, [ $s, $level, @ex ]; + }); + is_deeply(\@parts, [ [ qw(a 1 1) ], [ qw(b 1 2) ] ], 'order is fine'); +} + +{ + my $parts = [ Email::MIME->create(body => 'a'), + Email::MIME->create(body => 'b') ]; + $parts = [ Email::MIME->create(parts => $parts, + header_str => [ From => 'sub@localhost' ]), + Email::MIME->create(body => 'sig') ]; + my $mime = Email::MIME->create(parts => $parts, + header_str => [ From => 'root@localhost' ]); + my @parts; + msg_iter($mime, sub { + my ($part, $level, @ex) = @{$_[0]}; + my $s = $part->body_str; + $s =~ s/\s+//s; + push @parts, [ $s, $level, @ex ]; + }); + is_deeply(\@parts, [ [qw(a 2 1 1)], [qw(b 2 1 2)], [qw(sig 1 2)] ], + 'nested part shows up properly'); +} + +done_testing(); +1; @@ -11,6 +11,7 @@ foreach my $mod (qw(DBD::SQLite Search::Xapian Danga::Socket)) { } use_ok 'PublicInbox::NNTP'; +use_ok 'PublicInbox::Inbox'; { sub quote_str { @@ -95,4 +96,42 @@ use_ok 'PublicInbox::NNTP'; } } +{ # test setting NNTP headers in HEAD and ARTICLE requests + require Email::MIME; + my $u = 'https://example.com/a/'; + my $ng = PublicInbox::Inbox->new({ name => 'test', + mainrepo => 'test.git', + address => 'a@example.com', + -primary_address => 'a@example.com', + newsgroup => 'test', + domain => 'example.com', + url => '//example.com/a'}); + is($ng->base_url, $u, 'URL expanded'); + my $mid = 'a@b'; + my $mime = Email::MIME->new("Message-ID: <$mid>\r\n\r\n"); + PublicInbox::NNTP::set_nntp_headers($mime->header_obj, $ng, 1, $mid); + is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ], + 'Message-ID unchanged'); + is_deeply([ $mime->header('Archived-At') ], [ "<${u}a\@b/>" ], + 'Archived-At: set'); + is_deeply([ $mime->header('List-Archive') ], [ "<$u>" ], + 'List-Archive: set'); + is_deeply([ $mime->header('List-Post') ], [ '<mailto:a@example.com>' ], + 'List-Post: set'); + is_deeply([ $mime->header('Newsgroups') ], [ 'test' ], + 'Newsgroups: set'); + is_deeply([ $mime->header('Xref') ], [ 'example.com test:1' ], + 'Xref: set'); + + $ng->{-base_url} = 'http://mirror.example.com/m/'; + PublicInbox::NNTP::set_nntp_headers($mime->header_obj, $ng, 2, $mid); + is_deeply([ $mime->header('Message-ID') ], [ "<$mid>" ], + 'Message-ID unchanged'); + is_deeply([ $mime->header('Archived-At') ], + [ "<${u}a\@b/>", '<http://mirror.example.com/m/a@b/>' ], + 'Archived-At: appended'); + is_deeply([ $mime->header('Xref') ], [ 'example.com test:2' ], + 'Old Xref: clobbered'); +} + done_testing(); @@ -16,26 +16,18 @@ use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD); use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY); use File::Temp qw/tempdir/; use Net::NNTP; -use IPC::Run qw(run); my $tmpdir = tempdir('pi-nntpd-XXXXXX', TMPDIR => 1, CLEANUP => 1); my $home = "$tmpdir/pi-home"; my $err = "$tmpdir/stderr.log"; my $out = "$tmpdir/stdout.log"; -my $pi_home = "$home/.public-inbox"; -my $pi_config = "$pi_home/config"; my $maindir = "$tmpdir/main.git"; -my $main_bin = getcwd()."/t/main-bin"; -my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock my $group = 'test-nntpd'; my $addr = $group . '@example.com'; -my $cfgpfx = "publicinbox.$group"; -my $failbox = "$home/fail.mbox"; -local $ENV{PI_EMERGENCY} = $failbox; -my $mda = 'blib/script/public-inbox-mda'; my $nntpd = 'blib/script/public-inbox-nntpd'; my $init = 'blib/script/public-inbox-init'; -my $index = 'blib/script/public-inbox-index'; +use_ok 'PublicInbox::Import'; +use_ok 'PublicInbox::Git'; my %opts = ( LocalAddr => '127.0.0.1', @@ -46,29 +38,38 @@ my %opts = ( ); my $sock = IO::Socket::INET->new(%opts); my $pid; +my $len; END { kill 'TERM', $pid if defined $pid }; { local $ENV{HOME} = $home; system($init, $group, $maindir, 'http://example.com/', $addr); + is(system(qw(git config), "--file=$home/.public-inbox/config", + "publicinbox.$group.newsgroup", $group), + 0, 'enabled newsgroup'); + my $len; # ensure successful message delivery { - local $ENV{ORIGINAL_RECIPIENT} = $addr; - my $simple = Email::Simple->new(<<EOF); -From: Me <me\@example.com> -To: You <you\@example.com> + my $mime = Email::MIME->new(<<EOF); +To: =?utf-8?Q?El=C3=A9anor?= <you\@example.com> +From: =?utf-8?Q?El=C3=A9anor?= <me\@example.com> Cc: $addr Message-Id: <nntp\@example.com> -Subject: hihi +Content-Type: text/plain; charset=utf-8 +Subject: Testing for =?utf-8?Q?El=C3=A9anor?= Date: Thu, 01 Jan 1970 06:06:06 +0000 +Content-Transfer-Encoding: 8bit -nntp +This is a test message for El\xc3\xa9anor EOF - my $in = $simple->as_string; - local $ENV{PATH} = $main_path; - IPC::Run::run([$mda], \$in); - is(0, $?, 'ran MDA correctly'); - is(0, system($index, $maindir), 'indexed git dir'); + $mime->header_set('List-Id', "<$addr>"); + $len = length($mime->as_string); + my $git = PublicInbox::Git->new($maindir); + my $im = PublicInbox::Import->new($git, 'test', $addr); + $im->add($mime); + $im->done; + my $s = PublicInbox::SearchIdx->new($maindir, 1); + $s->index_sync; } ok($sock, 'sock created'); @@ -106,10 +107,10 @@ EOF my $mid = '<nntp@example.com>'; my %xhdr = ( 'message-id' => $mid, - 'subject' => 'hihi', + subject => "Testing for El\xc3\xa9anor", 'date' => 'Thu, 01 Jan 1970 06:06:06 +0000', - 'from' => 'Me <me@example.com>', - 'to' => 'You <you@example.com>', + 'from' => "El\xc3\xa9anor <me\@example.com>", + 'to' => "El\xc3\xa9anor <you\@example.com>", 'cc' => $addr, 'xref' => "example.com $group:1" ); @@ -119,6 +120,18 @@ EOF is($buf, "201 server ready - post via email\r\n", 'got greeting'); $s->autoflush(1); + syswrite($s, "NEWGROUPS\t19990424 000000 \033GMT\007\r\n"); + is(0, sysread($s, $buf, 4096), 'GOT EOF on cntrl'); + + $s = IO::Socket::INET->new(%opts); + sysread($s, $buf, 4096); + is($buf, "201 server ready - post via email\r\n", 'got greeting'); + $s->autoflush(1); + + syswrite($s, "NEWGROUPS 19990424 000000 GMT\r\n"); + $buf = read_til_dot($s); + like($buf, qr/\A231 list of /, 'newgroups OK'); + while (my ($k, $v) = each %xhdr) { is_deeply($n->xhdr("$k $mid"), { $mid => $v }, "XHDR $k by message-id works"); @@ -126,14 +139,11 @@ EOF "$k by article number works"); is_deeply($n->xhdr("$k 1-"), { 1 => $v }, "$k by article range works"); - next; $buf = ''; syswrite($s, "HDR $k $mid\r\n"); - do { - sysread($s, $buf, 4096, length($buf)); - } until ($buf =~ /\r\n\.\r\n\z/); + $buf = read_til_dot($s); my @r = split("\r\n", $buf); - like($r[0], qr/\A224 /, '224 response for HDR'); + like($r[0], qr/\A225 /, '225 response for HDR'); is($r[1], "0 $v", 'got expected response for HDR'); } @@ -146,34 +156,42 @@ EOF } is_deeply($n->xover('1-'), { - '1' => ['hihi', - 'Me <me@example.com>', + '1' => ["Testing for El\xc3\xa9anor", + "El\xc3\xa9anor <me\@example.com>", 'Thu, 01 Jan 1970 06:06:06 +0000', '<nntp@example.com>', '', - '202', + $len, '1' ] }, "XOVER range works"); is_deeply($n->xover('1'), { - '1' => ['hihi', - 'Me <me@example.com>', + '1' => ["Testing for El\xc3\xa9anor", + "El\xc3\xa9anor <me\@example.com>", 'Thu, 01 Jan 1970 06:06:06 +0000', '<nntp@example.com>', '', - '202', + $len, '1' ] }, "XOVER by article works"); + is_deeply($n->head(1), $n->head('<nntp@example.com>'), 'HEAD OK'); + is_deeply($n->body(1), $n->body('<nntp@example.com>'), 'BODY OK'); + is($n->body(1)->[0], "This is a test message for El\xc3\xa9anor\n", + 'body really matches'); + my $art = $n->article(1); + is(ref($art), 'ARRAY', 'got array for ARTICLE'); + is_deeply($art, $n->article('<nntp@example.com>'), 'ARTICLE OK'); + is($n->article(999), undef, 'non-existent num'); + is($n->article('<non-existent@example>'), undef, 'non-existent mid'); + { syswrite($s, "OVER $mid\r\n"); - $buf = ''; - do { - sysread($s, $buf, 4096, length($buf)); - } until ($buf =~ /\r\n\.\r\n\z/); + $buf = read_til_dot($s); my @r = split("\r\n", $buf); like($r[0], qr/^224 /, 'got 224 response for OVER'); - is($r[1], "0\thihi\tMe <me\@example.com>\t" . + is($r[1], "0\tTesting for El\xc3\xa9anor\t" . + "El\xc3\xa9anor <me\@example.com>\t" . "Thu, 01 Jan 1970 06:06:06 +0000\t" . - "$mid\t\t202\t1", 'OVER by Message-ID works'); + "$mid\t\t$len\t1", 'OVER by Message-ID works'); is($r[2], '.', 'correctly terminated response'); } @@ -185,7 +203,20 @@ EOF 'XHDR on invalid header returns empty'); { - syswrite($s, "HDR List-id 1-\r\n"); + my $t0 = time; + my $date = $n->date; + my $t1 = time; + ok($date >= $t0, 'valid date after start'); + ok($date <= $t1, 'valid date before stop'); + } + + { + setsockopt($s, IPPROTO_TCP, TCP_NODELAY, 1); + syswrite($s, 'HDR List-id 1-'); + select(undef, undef, undef, 0.15); + ok(kill('TERM', $pid), 'killed nntpd'); + select(undef, undef, undef, 0.15); + syswrite($s, "\r\n"); $buf = ''; do { sysread($s, $buf, 4096, length($buf)); @@ -196,11 +227,26 @@ EOF is(scalar @r, 1, 'only one response line'); } - ok(kill('TERM', $pid), 'killed nntpd'); - $pid = undef; - waitpid(-1, 0); + $n = $s = undef; + is($pid, waitpid($pid, 0), 'nntpd exited successfully'); + my $eout = eval { + local $/; + open my $fh, '<', $err or die "open $err failed: $!"; + <$fh>; + }; + is($?, 0, 'no error in exited process'); + unlike($eout, qr/wide/i, 'no Wide character warnings'); } done_testing(); +sub read_til_dot { + my ($s) = @_; + my $buf = ''; + do { + sysread($s, $buf, 4096, length($buf)); + } until ($buf =~ /\r\n\.\r\n\z/); + $buf; +} + 1; @@ -5,36 +5,23 @@ use warnings; use Test::More; use Email::MIME; use File::Temp qw/tempdir/; -use Cwd; -use IPC::Run qw/run/; my $psgi = "examples/public-inbox.psgi"; -my $mda = "blib/script/public-inbox-mda"; my $tmpdir = tempdir('pi-plack-XXXXXX', TMPDIR => 1, CLEANUP => 1); -my $home = "$tmpdir/pi-home"; -my $pi_home = "$home/.public-inbox"; -my $pi_config = "$pi_home/config"; +my $pi_config = "$tmpdir/config"; my $maindir = "$tmpdir/main.git"; -my $main_bin = getcwd()."/t/main-bin"; -my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock my $addr = 'test-public@example.com'; my $cfgpfx = "publicinbox.test"; -my $failbox = "$home/fail.mbox"; -local $ENV{PI_EMERGENCY} = $failbox; -my @mods = qw(HTTP::Request::Common Plack::Request Plack::Test - Mail::Thread URI::Escape); +my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); foreach my $mod (@mods) { eval "require $mod"; plan skip_all => "$mod missing for plack.t" if $@; } +use_ok 'PublicInbox::Import'; +use_ok 'PublicInbox::Git'; foreach my $mod (@mods) { use_ok $mod; } { ok(-f $psgi, "psgi example file found"); - ok(-x "$main_bin/spamc", - "spamc ham mock found (run in top of source tree"); - ok(-x $mda, "$mda is executable"); - 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)"); open my $fh, '>', "$maindir/description" or die "open: $!\n"; print $fh "test for public-inbox\n"; @@ -42,18 +29,17 @@ foreach my $mod (@mods) { use_ok $mod; } my %cfg = ( "$cfgpfx.address" => $addr, "$cfgpfx.mainrepo" => $maindir, + "$cfgpfx.url" => 'http://example.com/test/', + "$cfgpfx.newsgroup" => 'inbox.test', ); while (my ($k,$v) = each %cfg) { is(0, system(qw(git config --file), $pi_config, $k, $v), "setup $k"); } - local $ENV{HOME} = $home; - local $ENV{ORIGINAL_RECIPIENT} = $addr; - # ensure successful message delivery { - my $simple = Email::Simple->new(<<EOF); + my $mime = Email::MIME->new(<<EOF); From: Me <me\@example.com> To: You <you\@example.com> Cc: $addr @@ -63,13 +49,38 @@ Date: Thu, 01 Jan 1970 00:00:00 +0000 zzzzzz EOF - my $in = $simple->as_string; - run_with_env({PATH => $main_path}, [$mda], \$in); - local $ENV{GIT_DIR} = $maindir; - my $rev = `git rev-list HEAD`; + my $git = PublicInbox::Git->new($maindir); + my $im = PublicInbox::Import->new($git, 'test', $addr); + $im->add($mime); + $im->done; + my $rev = `git --git-dir="$maindir" rev-list HEAD`; like($rev, qr/\A[a-f0-9]{40}/, "good revision committed"); } - my $app = require $psgi; + my $app = eval { + local $ENV{PI_CONFIG} = $pi_config; + require $psgi; + }; + + test_psgi($app, sub { + my ($cb) = @_; + foreach my $u (qw(robots.txt favicon.ico .well-known/foo)) { + my $res = $cb->(GET("http://example.com/$u")); + is($res->code, 404, "$u is missing"); + } + }); + + # redirect with newsgroup + test_psgi($app, sub { + my ($cb) = @_; + my $from = 'http://example.com/inbox.test'; + my $to = 'http://example.com/test/'; + my $res = $cb->(GET($from)); + is($res->code, 301, 'newsgroup name is permanent redirect'); + is($to, $res->header('Location'), 'redirect location matches'); + $from .= '/'; + is($res->code, 301, 'newsgroup name/ is permanent redirect'); + is($to, $res->header('Location'), 'redirect location matches'); + }); # redirect with trailing / test_psgi($app, sub { @@ -85,7 +96,7 @@ EOF foreach my $t (qw(t T)) { test_psgi($app, sub { my ($cb) = @_; - my $u = $pfx . "/blah%40example.com/$t"; + my $u = $pfx . "/blah\@example.com/$t"; my $res = $cb->(GET($u)); is(301, $res->code, "redirect for missing /"); my $location = $res->header('Location'); @@ -96,11 +107,11 @@ EOF foreach my $t (qw(f)) { test_psgi($app, sub { my ($cb) = @_; - my $u = $pfx . "/blah%40example.com/$t"; + my $u = $pfx . "/blah\@example.com/$t"; my $res = $cb->(GET($u)); - is(301, $res->code, "redirect for missing /"); + is(301, $res->code, "redirect for legacy /f"); my $location = $res->header('Location'); - like($location, qr!/\Q$t\E/\z!, + like($location, qr!/blah\@example\.com/\z!, 'redirected with missing /'); }); } @@ -108,11 +119,11 @@ EOF test_psgi($app, sub { my ($cb) = @_; my $atomurl = 'http://example.com/test/new.atom'; - my $res = $cb->(GET('http://example.com/test/')); + my $res = $cb->(GET('http://example.com/test/new.html')); is(200, $res->code, 'success response received'); - like($res->content, qr!href="\Q$atomurl\E"!, + like($res->content, qr!href="new\.atom"!, 'atom URL generated'); - like($res->content, qr!href="blah%40example\.com/"!, + like($res->content, qr!href="blah\@example\.com/"!, 'index generated'); }); @@ -121,23 +132,29 @@ EOF my $res = $cb->(GET($pfx . '/atom.xml')); is(200, $res->code, 'success response received for atom'); like($res->content, - qr!link\s+href="\Q$pfx\E/blah%40example\.com/"!s, + qr!link\s+href="\Q$pfx\E/blah\@example\.com/"!s, 'atom feed generated correct URL'); }); - foreach my $t (('', 'f/')) { - test_psgi($app, sub { - my ($cb) = @_; - my $path = "/blah%40example.com/$t"; - my $res = $cb->(GET($pfx . $path)); - is(200, $res->code, "success for $path"); - like($res->content, qr!<title>hihi - Me</title>!, - "HTML returned"); - }); - } test_psgi($app, sub { my ($cb) = @_; - my $res = $cb->(GET($pfx . '/blah%40example.com/raw')); + my $path = '/blah@example.com/'; + my $res = $cb->(GET($pfx . $path)); + is(200, $res->code, "success for $path"); + like($res->content, qr!<title>hihi - Me</title>!, + "HTML returned"); + + $path .= 'f/'; + $res = $cb->(GET($pfx . $path)); + is(301, $res->code, "redirect for $path"); + my $location = $res->header('Location'); + like($location, qr!/blah\@example\.com/\z!, + '/$MESSAGE_ID/f/ redirected to /$MESSAGE_ID/'); + }); + + test_psgi($app, sub { + my ($cb) = @_; + my $res = $cb->(GET($pfx . '/blah@example.com/raw')); is(200, $res->code, 'success response received for /*/raw'); like($res->content, qr!^From !sm, "mbox returned"); }); @@ -146,47 +163,41 @@ EOF foreach my $t (qw(m f)) { test_psgi($app, sub { my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah%40example.com.txt")); + my $res = $cb->(GET($pfx . "/$t/blah\@example.com.txt")); is(301, $res->code, "redirect for old $t .txt link"); my $location = $res->header('Location'); - like($location, qr!/blah%40example\.com/raw\z!, + like($location, qr!/blah\@example\.com/raw\z!, ".txt redirected to /raw"); }); } my %umap = ( 'm' => '', - 'f' => 'f/', + 'f' => '', 't' => 't/', ); while (my ($t, $e) = each %umap) { test_psgi($app, sub { my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah%40example.com.html")); + my $res = $cb->(GET($pfx . "/$t/blah\@example.com.html")); is(301, $res->code, "redirect for old $t .html link"); my $location = $res->header('Location'); like($location, - qr!/blah%40example\.com/$e(?:#u)?\z!, + qr!/blah\@example\.com/$e(?:#u)?\z!, ".html redirected to new location"); }); } foreach my $sfx (qw(mbox mbox.gz)) { test_psgi($app, sub { my ($cb) = @_; - my $res = $cb->(GET($pfx . "/t/blah%40example.com.$sfx")); + my $res = $cb->(GET($pfx . "/t/blah\@example.com.$sfx")); is(301, $res->code, 'redirect for old thread link'); my $location = $res->header('Location'); like($location, - qr!/blah%40example\.com/t\.mbox(?:\.gz)?\z!, + qr!/blah\@example\.com/t\.mbox(?:\.gz)?\z!, "$sfx redirected to /mbox.gz"); }); } } done_testing(); - -sub run_with_env { - my ($env, @args) = @_; - my $init = sub { foreach my $k (keys %$env) { $ENV{$k} = $env->{$k} } }; - run(@args, init => $init); -} diff --git a/t/precheck.t b/t/precheck.t index 3f2c5d5b..0c3ce1c4 100644 --- a/t/precheck.t +++ b/t/precheck.t @@ -4,32 +4,46 @@ use strict; use warnings; use Test::More; use Email::Simple; -use Email::Filter; use PublicInbox::MDA; sub do_checks { my ($s) = @_; - my $f = Email::Filter->new(data => $s->as_string); - my $recipient = 'foo@example.com'; - ok(!PublicInbox::MDA->precheck($f, $recipient), + ok(!PublicInbox::MDA->precheck($s, $recipient), "wrong ORIGINAL_RECIPIENT rejected"); $recipient = 'b@example.com'; - ok(PublicInbox::MDA->precheck($f, $recipient), + ok(PublicInbox::MDA->precheck($s, $recipient), "ORIGINAL_RECIPIENT in To: is OK"); $recipient = 'c@example.com'; - ok(PublicInbox::MDA->precheck($f, $recipient), + ok(PublicInbox::MDA->precheck($s, $recipient), "ORIGINAL_RECIPIENT in Cc: is OK"); $recipient = [ 'c@example.com', 'd@example.com' ]; - ok(PublicInbox::MDA->precheck($f, $recipient), + ok(PublicInbox::MDA->precheck($s, $recipient), "alias list is OK"); } { + my $s = Email::Simple->create( + header => [ + From => 'abc@example.com', + To => 'abc@example.com', + Cc => 'c@example.com, another-list@example.com', + 'Content-Type' => 'text/plain', + Subject => 'list is fine', + 'Message-ID' => '<MID@host>', + Date => 'Wed, 09 Apr 2014 01:28:34 +0000', + ], + body => "hello world\n", + ); + my $addr = [ 'c@example.com', 'd@example.com' ]; + ok(PublicInbox::MDA->precheck($s, $addr), 'Cc list is OK'); +} + +{ do_checks(Email::Simple->create( header => [ From => 'a@example.com', @@ -72,8 +86,7 @@ sub do_checks { ], body => "hello world\n", ); - my $f = Email::Filter->new(data => $s->as_string); - ok(!PublicInbox::MDA->precheck($f, $recipient), + ok(!PublicInbox::MDA->precheck($s, $recipient), "missing From: is rejected"); } diff --git a/t/psgi_attach.t b/t/psgi_attach.t new file mode 100644 index 00000000..0d20b7f7 --- /dev/null +++ b/t/psgi_attach.t @@ -0,0 +1,117 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use File::Temp qw/tempdir/; +my $tmpdir = tempdir('psgi-attach-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $maindir = "$tmpdir/main.git"; +my $addr = 'test-public@example.com'; +my $cfgpfx = "publicinbox.test"; +my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); +foreach my $mod (@mods) { + eval "require $mod"; + plan skip_all => "$mod missing for plack.t" if $@; +} +use_ok $_ foreach @mods; +use PublicInbox::Import; +use PublicInbox::Git; +use PublicInbox::Config; +use PublicInbox::WWW; +use_ok 'PublicInbox::WwwAttach'; +use Plack::Builder; +my $config = PublicInbox::Config->new({ + "$cfgpfx.address" => $addr, + "$cfgpfx.mainrepo" => $maindir, +}); +is(0, system(qw(git init -q --bare), $maindir), "git init (main)"); +my $git = PublicInbox::Git->new($maindir); +my $im = PublicInbox::Import->new($git, 'test', $addr); + +{ + open my $fh, '<', '/dev/urandom' or die "unable to open urandom: $!\n"; + sysread($fh, my $buf, 8); + is(8, length($buf), 'read some random data'); + my $qp = "abcdef=g\n==blah\n"; + my $b64 = 'b64'.$buf."\n"; + my $txt = "plain\ntext\npass\nthrough\n"; + my $dot = "dotfile\n"; + my $parts = [ + Email::MIME->create( + attributes => { + filename => 'queue-pee', + content_type => 'text/plain', + encoding => 'quoted-printable' + }, + body => $qp), + Email::MIME->create( + attributes => { + filename => 'bayce-sixty-four', + content_type => 'appication/octet-stream', + encoding => 'base64', + }, + body => $b64), + Email::MIME->create( + attributes => { + filename => 'noop.txt', + content_type => 'text/plain', + }, + body => $txt), + Email::MIME->create( + attributes => { + filename => '.dotfile', + content_type => 'text/plain', + }, + body => $dot), + ]; + my $mime = Email::MIME->create( + parts => $parts, + header_str => [ From => 'root@z', 'Message-Id' => '<Z@B>', + Subject => 'hi'] + ); + $mime = $mime->as_string; + $mime =~ s/\r\n/\n/g; # normalize to LF only + $mime = Email::MIME->new($mime); + $im->add($mime); + $im->done; + + my $www = PublicInbox::WWW->new($config); + test_psgi(sub { $www->call(@_) }, sub { + my ($cb) = @_; + my $res; + $res = $cb->(GET('/test/Z%40B/')); + my @href = ($res->content =~ /^href="([^"]+)"/gms); + @href = grep(/\A[\d\.]+-/, @href); + is_deeply([qw(1-queue-pee 2-bayce-sixty-four 3-noop.txt + 4-a.txt)], + \@href, 'attachment links generated'); + + $res = $cb->(GET('/test/Z%40B/1-queue-pee')); + my $qp_res = $res->content; + ok(length($qp_res) >= length($qp), 'QP length is close'); + like($qp_res, qr/\n\z/s, 'trailing newline exists'); + # is(index($qp_res, $qp), 0, 'QP trailing newline is there'); + $qp_res =~ s/\r\n/\n/g; + is(index($qp_res, $qp), 0, 'QP trailing newline is there'); + + $res = $cb->(GET('/test/Z%40B/2-base-sixty-four')); + is(quotemeta($res->content), quotemeta($b64), + 'Base64 matches exactly'); + + $res = $cb->(GET('/test/Z%40B/3-noop.txt')); + my $txt_res = $res->content; + ok(length($txt_res) >= length($txt), + 'plain text almost matches'); + like($txt_res, qr/\n\z/s, 'trailing newline exists in text'); + is(index($txt_res, $txt), 0, 'plain text not truncated'); + + $res = $cb->(GET('/test/Z%40B/4-a.txt')); + my $dot_res = $res->content; + ok(length($dot_res) >= length($dot), 'dot almost matches'); + $res = $cb->(GET('/test/Z%40B/4-any-filename.txt')); + is($res->content, $dot_res, 'user-specified filename is OK'); + + }); +} +done_testing(); diff --git a/t/psgi_mount.t b/t/psgi_mount.t new file mode 100644 index 00000000..4a515c6a --- /dev/null +++ b/t/psgi_mount.t @@ -0,0 +1,78 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use File::Temp qw/tempdir/; +my $tmpdir = tempdir('psgi-path-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $maindir = "$tmpdir/main.git"; +my $addr = 'test-public@example.com'; +my $cfgpfx = "publicinbox.test"; +my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); +foreach my $mod (@mods) { + eval "require $mod"; + plan skip_all => "$mod missing for plack.t" if $@; +} +use_ok $_ foreach @mods; +use PublicInbox::Import; +use PublicInbox::Git; +use PublicInbox::Config; +use PublicInbox::WWW; +use Plack::Builder; +use Plack::App::URLMap; +my $config = PublicInbox::Config->new({ + "$cfgpfx.address" => $addr, + "$cfgpfx.mainrepo" => $maindir, +}); +is(0, system(qw(git init -q --bare), $maindir), "git init (main)"); +my $git = PublicInbox::Git->new($maindir); +my $im = PublicInbox::Import->new($git, 'test', $addr); +{ + my $mime = Email::MIME->new(<<EOF); +From: Me <me\@example.com> +To: You <you\@example.com> +Cc: $addr +Message-Id: <blah\@example.com> +Subject: hihi +Date: Thu, 01 Jan 1970 00:00:00 +0000 + +zzzzzz +EOF + $im->add($mime); + $im->done; +} + +my $www = PublicInbox::WWW->new($config); +my $app = builder { + enable 'Head'; + mount '/a' => builder { sub { $www->call(@_) } }; + mount '/b' => builder { sub { $www->call(@_) } }; +}; + +test_psgi($app, sub { + my ($cb) = @_; + my $res; + # Atom feed: + $res = $cb->(GET('/a/test/new.atom')); + like($res->content, qr!\bhttp://[^/]+/a/test/!, + 'URLs which exist in Atom feed are mount-aware'); + unlike($res->content, qr!\b\Qhttp://[^/]+/test/\E!, + 'No URLs which are not mount-aware'); + + # redirects + $res = $cb->(GET('/a/test/blah%40example.com/')); + is($res->code, 200, 'OK with URLMap mount'); + $res = $cb->(GET('/a/test/blah%40example.com/raw')); + is($res->code, 200, 'OK with URLMap mount'); + $res = $cb->(GET('/a/test/m/blah%40example.com.html')); + is($res->header('Location'), + 'http://localhost/a/test/blah@example.com/', + 'redirect functions properly under mount'); + + $res = $cb->(GET('/test/blah%40example.com/')); + is($res->code, 404, 'intentional 404 with URLMap mount'); + +}); + +done_testing(); diff --git a/t/psgi_text.t b/t/psgi_text.t new file mode 100644 index 00000000..bf565f83 --- /dev/null +++ b/t/psgi_text.t @@ -0,0 +1,39 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Email::MIME; +use File::Temp qw/tempdir/; +my $tmpdir = tempdir('psgi-text-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $maindir = "$tmpdir/main.git"; +my $addr = 'test-public@example.com'; +my $cfgpfx = "publicinbox.test"; +my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); +foreach my $mod (@mods) { + eval "require $mod"; + plan skip_all => "$mod missing for psgi_text.t" if $@; +} +use_ok $_ foreach @mods; +use PublicInbox::Import; +use PublicInbox::Git; +use PublicInbox::Config; +use PublicInbox::WWW; +use_ok 'PublicInbox::WwwText'; +use Plack::Builder; +my $config = PublicInbox::Config->new({ + "$cfgpfx.address" => $addr, + "$cfgpfx.mainrepo" => $maindir, +}); +is(0, system(qw(git init -q --bare), $maindir), "git init (main)"); +my $www = PublicInbox::WWW->new($config); + +test_psgi(sub { $www->call(@_) }, sub { + my ($cb) = @_; + my $res; + $res = $cb->(GET('/test/_/text/help/')); + like($res->content, qr!<title>public-inbox help.*</title>!, + 'default help'); +}); + +done_testing(); diff --git a/t/qspawn.t b/t/qspawn.t new file mode 100644 index 00000000..9c42e100 --- /dev/null +++ b/t/qspawn.t @@ -0,0 +1,62 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use Test::More; +use_ok 'PublicInbox::Qspawn'; + +my $limiter = PublicInbox::Qspawn::Limiter->new(1); +{ + my $x = PublicInbox::Qspawn->new([qw(true)]); + my $run = 0; + $x->start($limiter, sub { + my ($rpipe) = @_; + is(0, sysread($rpipe, my $buf, 1), 'read zero bytes'); + ok(!$x->finish, 'no error on finish'); + $run = 1; + }); + is($run, 1, 'callback ran alright'); +} + +{ + my $x = PublicInbox::Qspawn->new([qw(false)]); + my $run = 0; + $x->start($limiter, sub { + my ($rpipe) = @_; + is(0, sysread($rpipe, my $buf, 1), 'read zero bytes from false'); + my $err = $x->finish; + is($err, 256, 'error on finish'); + $run = 1; + }); + is($run, 1, 'callback ran alright'); +} + +foreach my $cmd ([qw(sleep 1)], [qw(sh -c), 'sleep 1; false']) { + my $s = PublicInbox::Qspawn->new($cmd); + my @run; + $s->start($limiter, sub { + my ($rpipe) = @_; + push @run, 'sleep'; + is(0, sysread($rpipe, my $buf, 1), 'read zero bytes'); + }); + my $n = 0; + my @t = map { + my $i = $n++; + my $x = PublicInbox::Qspawn->new([qw(true)]); + $x->start($limiter, sub { + my ($rpipe) = @_; + push @run, $i; + }); + [$x, $i] + } (0..2); + + if ($cmd->[-1] =~ /false\z/) { + ok($s->finish, 'got error on false after sleep'); + } else { + ok(!$s->finish, 'no error on sleep'); + } + ok(!$_->[0]->finish, "true $_->[1] succeeded") foreach @t; + is_deeply([qw(sleep 0 1 2)], \@run, 'ran in order'); +} + +done_testing(); + +1; @@ -33,13 +33,14 @@ ok($@, "exception raised on non-existent DB"); } my $rw = PublicInbox::SearchIdx->new($git_dir, 1); -my $ro = PublicInbox::Search->new($git_dir); +$rw->_xdb_acquire; +$rw->_xdb_release; $rw = undef; +my $ro = PublicInbox::Search->new($git_dir); my $rw_commit = sub { - $rw->{xdb}->commit_transaction if $rw; - $rw = undef; + $rw->{xdb}->commit_transaction if $rw && $rw->{xdb}; $rw = PublicInbox::SearchIdx->new($git_dir, 1); - $rw->{xdb}->begin_transaction; + $rw->_xdb_acquire->begin_transaction; }; { @@ -85,6 +86,7 @@ my $rw_commit = sub { 'Message-ID' => '<last@s>', From => 'John Smith <js@example.com>', To => 'list@example.com', + Cc => 'foo@example.com', ], body => "goodbye forever :<\n"); @@ -121,19 +123,19 @@ sub filter_mids { is($res->{total}, 0, "path variant `$p' does not match"); } - $res = $ro->query('subject:(Hello world)'); + $res = $ro->query('s:(Hello world)'); @res = filter_mids($res); - is_deeply(\@res, \@exp, 'got expected results for subject:() match'); + is_deeply(\@res, \@exp, 'got expected results for s:() match'); - $res = $ro->query('subject:"Hello world"'); + $res = $ro->query('s:"Hello world"'); @res = filter_mids($res); - is_deeply(\@res, \@exp, 'got expected results for subject:"" match'); + is_deeply(\@res, \@exp, 'got expected results for s:"" match'); - $res = $ro->query('subject:"Hello world"', {limit => 1}); + $res = $ro->query('s:"Hello world"', {limit => 1}); is(scalar @{$res->{msgs}}, 1, "limit works"); my $first = $res->{msgs}->[0]; - $res = $ro->query('subject:"Hello world"', {offset => 1}); + $res = $ro->query('s:"Hello world"', {offset => 1}); is(scalar @{$res->{msgs}}, 1, "offset works"); my $second = $res->{msgs}->[0]; @@ -179,7 +181,7 @@ sub filter_mids { $rw_commit->(); $ro->reopen; - # Subject: + # subject my $res = $ro->query('ghost'); my @exp = sort qw(ghost-message@s ghost-reply@s); my @res = filter_mids($res); @@ -274,10 +276,11 @@ sub filter_mids { # circular references { + my $s = 'foo://'. ('Circle' x 15).'/foo'; my $doc_id = $rw->add_message(Email::MIME->create( + header => [ Subject => $s ], header_str => [ Date => 'Sat, 02 Oct 2010 00:00:01 +0000', - Subject => 'Circle', 'Message-ID' => '<circle@a>', 'References' => '<circle@a>', 'In-Reply-To' => '<circle@a>', @@ -289,6 +292,139 @@ sub filter_mids { my $smsg = $rw->lookup_message('circle@a'); $smsg->ensure_metadata; is($smsg->references, '', "no references created"); + my $msg = PublicInbox::SearchMsg->load_doc($smsg->{doc}); + is($s, $msg->subject, 'long subject not rewritten'); +} + +{ + my $str = eval { + my $mbox = 't/utf8.mbox'; + open(my $fh, '<', $mbox) or die "failed to open mbox: $mbox\n"; + local $/; + <$fh> + }; + $str =~ s/\AFrom [^\n]+\n//s; + my $mime = Email::MIME->new($str); + my $doc_id = $rw->add_message($mime); + ok($doc_id > 0, 'message indexed doc_id with UTF-8'); + my $smsg = $rw->lookup_message('testmessage@example.com'); + my $msg = PublicInbox::SearchMsg->load_doc($smsg->{doc}); + + is($mime->header('Subject'), $msg->subject, 'UTF-8 subject preserved'); +} + +{ + my $res = $ro->query('d:19931002..20101002'); + ok(scalar @{$res->{msgs}} > 0, 'got results within range'); + $res = $ro->query('d:20101003..'); + is(scalar @{$res->{msgs}}, 0, 'nothing after 20101003'); + $res = $ro->query('d:..19931001'); + is(scalar @{$res->{msgs}}, 0, 'nothing before 19931001'); +} + +# names and addresses +{ + my $res = $ro->query('t:list@example.com'); + is(scalar @{$res->{msgs}}, 6, 'searched To: successfully'); + foreach my $smsg (@{$res->{msgs}}) { + like($smsg->to, qr/\blist\@example\.com\b/, 'to appears'); + } + + $res = $ro->query('tc:list@example.com'); + is(scalar @{$res->{msgs}}, 6, 'searched To+Cc: successfully'); + foreach my $smsg (@{$res->{msgs}}) { + my $tocc = join("\n", $smsg->to, $smsg->cc); + like($tocc, qr/\blist\@example\.com\b/, 'tocc appears'); + } + + foreach my $pfx ('tcf:', 'c:') { + $res = $ro->query($pfx . 'foo@example.com'); + is(scalar @{$res->{msgs}}, 1, + "searched $pfx successfully for Cc:"); + foreach my $smsg (@{$res->{msgs}}) { + like($smsg->cc, qr/\bfoo\@example\.com\b/, + 'cc appears'); + } + } + + foreach my $pfx ('', 'tcf:', 'f:') { + $res = $ro->query($pfx . 'Laggy'); + is(scalar @{$res->{msgs}}, 1, + "searched $pfx successfully for From:"); + foreach my $smsg (@{$res->{msgs}}) { + like($smsg->from, qr/Laggy Sender/, + "From appears with $pfx"); + } + } +} + +{ + $rw_commit->(); + $ro->reopen; + my $res = $ro->query('b:hello'); + is(scalar @{$res->{msgs}}, 0, 'no match on body search only'); + $res = $ro->query('bs:smith'); + is(scalar @{$res->{msgs}}, 0, + 'no match on body+subject search for From'); + + $res = $ro->query('q:theatre'); + is(scalar @{$res->{msgs}}, 1, 'only one quoted body'); + like($res->{msgs}->[0]->from, qr/\AQuoter/, 'got quoted body'); + + $res = $ro->query('nq:theatre'); + is(scalar @{$res->{msgs}}, 1, 'only one non-quoted body'); + like($res->{msgs}->[0]->from, qr/\ANon-Quoter/, 'got non-quoted body'); + + foreach my $pfx (qw(b: bs:)) { + $res = $ro->query($pfx . 'theatre'); + is(scalar @{$res->{msgs}}, 2, "searched both bodies for $pfx"); + like($res->{msgs}->[0]->from, qr/\ANon-Quoter/, + "non-quoter first for $pfx"); + } +} + +{ + my $part1 = Email::MIME->create( + attributes => { + content_type => 'text/plain', + disposition => 'attachment', + charset => 'US-ASCII', + encoding => 'quoted-printable', + filename => 'attached_fart.txt', + }, + body_str => 'inside the attachment', + ); + my $part2 = Email::MIME->create( + attributes => { + content_type => 'text/plain', + disposition => 'attachment', + charset => 'US-ASCII', + encoding => 'quoted-printable', + filename => 'part_deux.txt', + }, + body_str => 'inside another', + ); + my $amsg = Email::MIME->create( + header_str => [ + Subject => 'see attachment', + 'Message-ID' => '<file@attached>', + From => 'John Smith <js@example.com>', + To => 'list@example.com', + ], + parts => [ $part1, $part2 ], + ); + ok($rw->add_message($amsg), 'added attachment'); + $rw_commit->(); + $ro->reopen; + my $n = $ro->query('n:attached_fart.txt'); + is(scalar @{$n->{msgs}}, 1, 'got result for n:'); + my $res = $ro->query('part_deux.txt'); + is(scalar @{$res->{msgs}}, 1, 'got result without n:'); + is($n->{msgs}->[0]->mid, $res->{msgs}->[0]->mid, + 'same result with and without'); + my $txt = $ro->query('"inside another"'); + is($txt->{msgs}->[0]->mid, $res->{msgs}->[0]->mid, + 'search inside text attachments works'); } done_testing(); diff --git a/t/spamcheck_spamc.t b/t/spamcheck_spamc.t new file mode 100644 index 00000000..65ac5c2e --- /dev/null +++ b/t/spamcheck_spamc.t @@ -0,0 +1,49 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Cwd; +use Email::Simple; +use IO::File; +use File::Temp qw/tempdir/; +use Fcntl qw(:DEFAULT SEEK_SET); +my $tmpdir = tempdir('spamcheck_spamc-XXXXXX', TMPDIR => 1, CLEANUP => 1); + +use_ok 'PublicInbox::Spamcheck::Spamc'; +my $spamc = PublicInbox::Spamcheck::Spamc->new; +$spamc->{checkcmd} = [qw(cat)]; + +{ + open my $fh, '+>', "$tmpdir/file" or die "open failed: $!"; + ok(!$spamc->spamcheck($fh), 'empty '.ref($fh)); +} +ok(!$spamc->spamcheck(IO::File->new_tmpfile), 'IO::File->new_tmpfile'); + +my $dst = ''; +my $src = <<'EOF'; +Date: Thu, 01 Jan 1970 00:00:00 +0000 +To: <e@example.com> +From: <e@example.com> +Subject: test +Message-ID: <testmessage@example.com> + +EOF +ok($spamc->spamcheck(Email::Simple->new($src), \$dst), 'Email::Simple works'); +is($dst, $src, 'input == output'); + +$dst = ''; +$spamc->{checkcmd} = ['sh', '-c', 'cat; false']; +ok(!$spamc->spamcheck(Email::Simple->new($src), \$dst), 'Failed check works'); +is($dst, $src, 'input == output for spammy example'); + +for my $l (qw(ham spam)) { + my $file = "$tmpdir/$l.out"; + $spamc->{$l.'cmd'} = ['tee', $file ]; + my $method = $l.'learn'; + ok($spamc->$method(Email::Simple->new($src)), "$method OK"); + open my $fh, '<', $file or die "failed to open $file: $!"; + is(eval { local $/, <$fh> }, $src, "$l command ran alright"); +} + +done_testing(); @@ -70,6 +70,15 @@ use PublicInbox::Spawn qw(which spawn popen_rd); is(sysread($fh, $buf, 6), 6, 'sysread got 6 bytes'); is($buf, "hello\n", 'tied gets works'); is(sysread($fh, $buf, 6), 0, 'sysread got EOF'); + $? = 1; + close $fh; + is($?, 0, '$? set properly'); +} + +{ + my $fh = popen_rd([qw(false)]); + close $fh; + isnt($?, 0, '$? set properly: '.$?); } { @@ -78,8 +87,9 @@ use PublicInbox::Spawn qw(which spawn popen_rd); is(kill(0, $pid), 1, 'child process is running'); ok(!defined(sysread($fh, my $buf, 1)) && $!{EAGAIN}, 'sysread returned quickly with EAGAIN'); - is(kill(15, $pid), 1, 'child process killed early'); + is(kill(9, $pid), 1, 'child process killed early'); is(waitpid($pid, 0), $pid, 'child process reapable'); + isnt($?, 0, '$? set properly: '.$?); } done_testing(); diff --git a/t/thread-cycle.t b/t/thread-cycle.t new file mode 100644 index 00000000..b0844490 --- /dev/null +++ b/t/thread-cycle.t @@ -0,0 +1,89 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use_ok('PublicInbox::SearchMsg'); +use_ok('PublicInbox::SearchThread'); +use Email::Simple; +my $mt = eval { + require Mail::Thread; + no warnings 'once'; + $Mail::Thread::nosubject = 1; + $Mail::Thread::noprune = 1; +}; +my @check; +my @msgs = map { + my $msg = $_; + $msg->{references} =~ s/\s+/ /sg if $msg->{references}; + my $simple = Email::Simple->create(header => [ + 'Message-Id' => "<$msg->{mid}>", + 'References' => $msg->{references}, + ]); + push @check, $simple; + bless $msg, 'PublicInbox::SearchMsg' +} ( + +# data from t/testbox-6 in Mail::Thread 2.55: + { mid => '20021124145312.GA1759@nlin.net' }, + { mid => 'slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk', + references => '<20021124145312.GA1759@nlin.net>', + }, + { mid => '15842.10677.577458.656565@jupiter.akutech-local.de', + references => '<20021124145312.GA1759@nlin.net> + <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk>', + }, + { mid => '20021125171807.GK8236@somanetworks.com', + references => '<20021124145312.GA1759@nlin.net> + <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk> + <15842.10677.577458.656565@jupiter.akutech-local.de>', + }, + { mid => '15843.12163.554914.469248@jupiter.akutech-local.de', + references => '<20021124145312.GA1759@nlin.net> + <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk> + <15842.10677.577458.656565@jupiter.akutech-local.de> + <E18GPHf-0000zp-00@cloaked.freeserve.co.uk>', + }, + { mid => 'E18GPHf-0000zp-00@cloaked.freeserve.co.uk', + references => '<20021124145312.GA1759@nlin.net> + <slrnau448m.7l4.markj+0111@cloaked.freeserve.co.uk> + <15842.10677.577458.656565@jupiter.akutech-local.de>' + } +); + +my $st = thread_to_s(\@msgs); + +SKIP: { + skip 'Mail::Thread missing', 1 unless $mt; + $mt = Mail::Thread->new(@check); + $mt->thread; + $mt->order(sub { sort { $a->messageid cmp $b->messageid } @_ }); + my $check = ''; + + my @q = map { (0, $_) } $mt->rootset; + while (@q) { + my $level = shift @q; + my $node = shift @q or next; + $check .= (" "x$level) . $node->messageid . "\n"; + unshift @q, $level + 1, $node->child, $level, $node->next; + } + is($check, $st, 'Mail::Thread output matches'); +} + +done_testing(); + +sub thread_to_s { + my $th = PublicInbox::SearchThread->new(shift); + $th->thread; + $th->order(sub { [ sort { $a->{id} cmp $b->{id} } @{$_[0]} ] }); + my $st = ''; + my @q = map { (0, $_) } @{$th->{rootset}}; + while (@q) { + my $level = shift @q; + my $node = shift @q or next; + $st .= (" "x$level). "$node->{id}\n"; + my $cl = $level + 1; + unshift @q, map { ($cl, $_) } @{$node->{children}}; + } + $st; +} @@ -4,7 +4,46 @@ use strict; use warnings; use Test::More; use Email::MIME; -use PublicInbox::View; +use Plack::Util; +use_ok 'PublicInbox::View'; + +my @q = ( + 'foo@bar', 'foo@bar', + 'a b', "'a b'", + "a'b", "'a'\\''b'", +); +while (@q) { + my $input = shift @q; + my $expect = shift @q; + my $res = PublicInbox::View::squote_maybe($input); + is($res, $expect, "quote $input => $res"); +} + +# FIXME: make this test less fragile +my $ctx = { + env => { HTTP_HOST => 'example.com', 'psgi.url_scheme' => 'http' }, + -inbox => Plack::Util::inline_object( + name => 'test', + search => sub { undef }, + base_url => sub { 'http://example.com/' }, + cloneurl => sub {[]}, + nntp_url => sub {[]}, + description => sub { '' }), +}; +$ctx->{-inbox}->{-primary_address} = 'test@example.com'; + +sub msg_html ($) { + my ($mime) = @_; + + my $s = ''; + my $r = PublicInbox::View::msg_html($ctx, $mime); + my $body = $r->[2]; + while (defined(my $buf = $body->getline)) { + $s .= $buf; + } + $body->close; + $s; +} # plain text { @@ -41,26 +80,12 @@ EOF body => $body, )->as_string; my $mime = Email::MIME->new($s); - my $html = PublicInbox::View::msg_html(undef, $mime); + my $html = msg_html($mime); # ghetto tests - like($html, qr!<a\nhref="\.\./raw"!s, "raw link present"); + like($html, qr!<a\nhref="raw"!s, "raw link present"); like($html, qr/hello world\b/, "body present"); like($html, qr/> keep this inline/, "short quoted text is inline"); - like($html, qr/<a\nid=[^>]+><\/a>> Long and wordy/, - "long quoted text is anchored"); - - # short page - my $pfx = "../hello%40example.com/f/"; - $mime = Email::MIME->new($s); - my $short = PublicInbox::View::msg_html(undef, $mime, $pfx); - like($short, qr!<a\nhref="\.\./hello%40example\.com/f/!s, - "MID link present"); - like($short, qr/\n> keep this inline/, - "short quoted text is inline"); - like($short, qr/<a\nhref="\Q$pfx\E#[^>]+>Long and wordy/, - "long quoted text is made into a link"); - ok(length($short) < length($html), "short page is shorter"); } # multipart crap @@ -85,8 +110,8 @@ EOF parts => $parts, ); - my $html = PublicInbox::View::msg_html(undef, $mime); - like($html, qr/hi\n-+ part #2 -+\nbye\n/, "multipart split"); + my $html = msg_html($mime); + like($html, qr/hi\n.*-- Attachment #2.*\nbye\n/s, "multipart split"); } # multipart email with attached patch @@ -114,8 +139,8 @@ EOF parts => $parts, ); - my $html = PublicInbox::View::msg_html(undef, $mime); - like($html, qr!see attached patch\n-+ foo\.patch -+\n--- a/file\n!, + my $html = msg_html($mime); + like($html, qr!.*Attachment #2: foo\.patch --!, "parts split with filename"); } @@ -140,15 +165,18 @@ EOF ); my $orig = $mime->body_raw; - my $html = PublicInbox::View::msg_html(undef, $mime); + my $html = msg_html($mime); like($orig, qr/hi =3D bye=/, "our test used QP correctly"); like($html, qr/\bhi = bye\b/, "HTML output decoded QP"); } { use PublicInbox::MID qw/id_compress/; + + # n.b: this is probably invalid since we dropped CGI for PSGI: like(id_compress('foo%bar@wtf'), qr/\A[a-f0-9]{40}\z/, "percent always converted to sha1 to workaround buggy httpds"); + is(id_compress('foobar-wtf'), 'foobar-wtf', 'regular ID not compressed'); } diff --git a/t/watch_maildir.t b/t/watch_maildir.t new file mode 100644 index 00000000..3969c80d --- /dev/null +++ b/t/watch_maildir.t @@ -0,0 +1,126 @@ +# Copyright (C) 2016 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use Test::More; +use File::Temp qw/tempdir/; +use Email::MIME; +use Cwd; +use PublicInbox::Config; +my @mods = qw(Filesys::Notify::Simple); +foreach my $mod (@mods) { + eval "require $mod"; + plan skip_all => "$mod missing for watch_maildir.t" if $@; +} + +my $tmpdir = tempdir('watch_maildir-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $git_dir = "$tmpdir/test.git"; +my $maildir = "$tmpdir/md"; +my $spamdir = "$tmpdir/spam"; +use_ok 'PublicInbox::WatchMaildir'; +use_ok 'PublicInbox::Emergency'; +my $cfgpfx = "publicinbox.test"; +my $addr = 'test-public@example.com'; +is(system(qw(git init -q --bare), $git_dir), 0, 'initialized git dir'); + +my $msg = <<EOF; +From: user\@example.com +To: $addr +Subject: spam +Message-Id: <a\@b.com> +Date: Sat, 18 Jun 2016 00:00:00 +0000 + +something +EOF +PublicInbox::Emergency->new($maildir)->prepare(\$msg); +ok(POSIX::mkfifo("$maildir/cur/fifo", 0777)); +my $sem = PublicInbox::Emergency->new($spamdir); # create dirs + +my $config = PublicInbox::Config->new({ + "$cfgpfx.address" => $addr, + "$cfgpfx.mainrepo" => $git_dir, + "$cfgpfx.watch" => "maildir:$maildir", + "$cfgpfx.filter" => 'PublicInbox::Filter::Vger', + "publicinboxlearn.watchspam" => "maildir:$spamdir", +}); + +PublicInbox::WatchMaildir->new($config)->scan; +my $git = PublicInbox::Git->new($git_dir); +my @list = $git->qx(qw(rev-list refs/heads/master)); +is(scalar @list, 1, 'one revision in rev-list'); + +my $write_spam = sub { + is(scalar glob("$spamdir/new/*"), undef, 'no spam existing'); + $sem->prepare(\$msg); + $sem->commit; + my @new = glob("$spamdir/new/*"); + is(scalar @new, 1); + my @p = split(m!/+!, $new[0]); + ok(link($new[0], "$spamdir/cur/".$p[-1].":2,S")); + is(unlink($new[0]), 1); +}; +$write_spam->(); +is(unlink(glob("$maildir/new/*")), 1, 'unlinked old spam'); +PublicInbox::WatchMaildir->new($config)->scan; +@list = $git->qx(qw(rev-list refs/heads/master)); +is(scalar @list, 2, 'two revisions in rev-list'); +@list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); +is(scalar @list, 0, 'tree is empty'); + +# check with scrubbing +{ + $msg .= qq(-- +To unsubscribe from this list: send the line "unsubscribe git" in +the body of a message to majordomo\@vger.kernel.org +More majordomo info at http://vger.kernel.org/majordomo-info.html\n); + PublicInbox::Emergency->new($maildir)->prepare(\$msg); + PublicInbox::WatchMaildir->new($config)->scan; + @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + is(scalar @list, 1, 'tree has one file'); + my $mref = $git->cat_file('HEAD:'.$list[0]); + like($$mref, qr/something\n\z/s, 'message scrubbed on import'); + + is(unlink(glob("$maildir/new/*")), 1, 'unlinked spam'); + $write_spam->(); + PublicInbox::WatchMaildir->new($config)->scan; + @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + is(scalar @list, 0, 'tree is empty'); + @list = $git->qx(qw(rev-list refs/heads/master)); + is(scalar @list, 4, 'four revisions in rev-list'); +} + +{ + my $fail_bin = getcwd()."/t/fail-bin"; + ok(-x "$fail_bin/spamc", "mock spamc exists"); + my $fail_path = "$fail_bin:$ENV{PATH}"; # for spamc ham mock + local $ENV{PATH} = $fail_path; + PublicInbox::Emergency->new($maildir)->prepare(\$msg); + $config->{'publicinboxwatch.spamcheck'} = 'spamc'; + { + local $SIG{__WARN__} = sub {}; # quiet spam check warning + PublicInbox::WatchMaildir->new($config)->scan; + } + @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + is(scalar @list, 0, 'tree has no files spamc checked'); + is(unlink(glob("$maildir/new/*")), 1); +} + +{ + my $main_bin = getcwd()."/t/main-bin"; + ok(-x "$main_bin/spamc", "mock spamc exists"); + my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock + local $ENV{PATH} = $main_path; + PublicInbox::Emergency->new($maildir)->prepare(\$msg); + $config->{'publicinboxwatch.spamcheck'} = 'spamc'; + @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + PublicInbox::WatchMaildir->new($config)->scan; + @list = $git->qx(qw(ls-tree -r --name-only refs/heads/master)); + is(scalar @list, 1, 'tree has one file after spamc checked'); + + # XXX: workaround some weird caching/memoization in cat-file, + # shouldn't be an issue in real-world use, though... + $git = PublicInbox::Git->new($git_dir); + + my $mref = $git->cat_file('refs/heads/master:'.$list[0]); + like($$mref, qr/something\n\z/s, 'message scrubbed on import'); +} + +done_testing; |