X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fplack.t;h=a5fd54c9981c3c845b05262085e789ed6b867155;hb=refs%2Fheads%2Fmaster;hp=ea31879285fd6d89268677a6eb6941c11fffc6e7;hpb=af8434f5f729a541cf8c50dfcb7d96a413facd2b;p=public-inbox.git diff --git a/t/plack.t b/t/plack.t index ea318792..7f80f488 100644 --- a/t/plack.t +++ b/t/plack.t @@ -1,114 +1,48 @@ -# Copyright (C) 2014-2020 all contributors +#!perl -w +# Copyright (C) all contributors # License: AGPL-3.0+ use strict; -use warnings; -use Test::More; -use Email::MIME; +use v5.10.1; use PublicInbox::TestCommon; my $psgi = "./examples/public-inbox.psgi"; -my ($tmpdir, $for_destroy) = tmpdir(); -my $pi_config = "$tmpdir/config"; -my $inboxdir = "$tmpdir/main.git"; -my $addr = 'test-public@example.com'; my @mods = qw(HTTP::Request::Common Plack::Test URI::Escape); require_mods(@mods); -use_ok 'PublicInbox::Import'; -use_ok 'PublicInbox::Git'; -my @ls; - foreach my $mod (@mods) { use_ok $mod; } -local $ENV{PI_CONFIG} = $pi_config; ok(-f $psgi, "psgi example file found"); +my ($tmpdir, $for_destroy) = tmpdir(); my $pfx = 'http://example.com/test'; -ok(run_script(['-init', 'test', $inboxdir, "$pfx/", $addr]), - 'initialized repo'); -PublicInbox::Import::run_die([qw(git config -f), $pi_config, - 'publicinbox.test.newsgroup', 'inbox.test']); -open my $fh, '>', "$inboxdir/description" or die "open: $!\n"; -print $fh "test for public-inbox\n"; -close $fh or die "close: $!\n"; -my $app = require $psgi; -my $git = PublicInbox::Git->new($inboxdir); -my $im = PublicInbox::Import->new($git, 'test', $addr); -# ensure successful message delivery -{ - my $mime = Email::MIME->new(<{-primary_address}; + $im->add($eml) or xbail '->add'; + $eml->header_set('Content-Type', + "text/plain; charset=\rso\rb\0gus\rithurts"); + $eml->header_set('Message-ID', ''); + $im->add($eml) or xbail '->add'; + $im->add(PublicInbox::Eml->new(<add'; From: Me To: You Cc: $addr Message-Id: Subject: hihi Date: Fri, 02 Oct 1993 00:00:00 +0000 +Content-Type: text/plain; charset=iso-8859-1 > quoted text zzzzzz EOF - $im->add($mime); - $im->done; - my $rev = $git->qx(qw(rev-list HEAD)); - like($rev, qr/\A[a-f0-9]{40}/, "good revision committed"); - @ls = $git->qx(qw(ls-tree -r --name-only HEAD)); - chomp @ls; - # multipart with two text bodies - my %attr_text = (attributes => { content_type => 'text/plain' }); - my $parts = [ - Email::MIME->create(%attr_text, body => 'hi'), - Email::MIME->create(%attr_text, body => 'bye') - ]; - $mime = Email::MIME->create( - header_str => [ - From => 'a@example.com', - Subject => 'blargh', - 'Message-ID' => '', - 'In-Reply-To' => '' - ], - parts => $parts, - ); - $im->add($mime); + $im->add(eml_load('t/plack-2-txt-bodies.eml')) or BAIL_OUT '->add'; # multipart with attached patch + filename - $parts = [ Email::MIME->create(%attr_text, body => 'hi, see attached'), - Email::MIME->create( - attributes => { - content_type => 'text/plain', - filename => "foo&.patch", - }, - body => "--- a/file\n+++ b/file\n" . - "@@ -49, 7 +49,34 @@\n" - ) - ]; - $mime = Email::MIME->create( - header_str => [ - From => 'a@example.com', - Subject => '[PATCH] asdf', - 'Message-ID' => '' - ], - parts => $parts - ); - $im->add($mime); + $im->add(eml_load('t/plack-attached-patch.eml')) or BAIL_OUT '->add'; - # multipart collapsed to single quoted-printable text/plain - $parts = [ - Email::MIME->create( - attributes => { - content_type => 'text/plain', - encoding => 'quoted-printable' - }, - body => 'hi = bye', - ) - ]; - $mime = Email::MIME->create( - header_str => [ - From => 'qp@example.com', - Subject => 'QP', - 'Message-ID' => '', - ], - parts => $parts, - ); - like($mime->body_raw, qr/hi =3D bye=/, 'our test used QP correctly'); - $im->add($mime); + $im->add(eml_load('t/data/attached-mbox-with-utf8.eml')) or xbail 'add'; + # multipart collapsed to single quoted-printable text/plain + $im->add(eml_load('t/plack-qp.eml')) or BAIL_OUT '->add'; my $crlf = < @@ -124,91 +58,90 @@ Date: Fri, 02 Oct 1993 00:00:00 +0000 :( EOF $crlf =~ s/\n/\r\n/sg; - $im->add(Email::MIME->new($crlf)); + $im->add(PublicInbox::Eml->new($crlf)) or BAIL_OUT '->add'; - $im->done; -} + open my $fh, '>', "$ibx->{inboxdir}/description" or BAIL_OUT "open: $!"; + print $fh "test for public-inbox\n" or BAIL_OUT; + close $fh or BAIL_OUT "close: $!"; + open $fh, '>', "$ibx->{inboxdir}/pi_config"; + print $fh <{inboxdir} + newsgroup = inbox.test + address = $addr + url = $pfx/ +EOF + close $fh or BAIL_OUT "close: $!"; +}); -test_psgi($app, sub { +my $env = { PI_CONFIG => "$ibx->{inboxdir}/pi_config", TMPDIR => $tmpdir }; +local @ENV{keys %$env} = values %$env; +my $c1 = sub { my ($cb) = @_; + my $uri = $ENV{PLACK_TEST_EXTERNALSERVER_URI} // 'http://example.com'; + $pfx = "$uri/test"; + foreach my $u (qw(robots.txt favicon.ico .well-known/foo)) { - my $res = $cb->(GET("http://example.com/$u")); + my $res = $cb->(GET("$uri/$u")); is($res->code, 404, "$u is missing"); } -}); -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET('http://example.com/test/crlf@example.com/')); + my $res = $cb->(GET("$uri/test/crlf\@example.com/")); is($res->code, 200, 'retrieved CRLF as HTML'); + like($res->content, qr/mailto:me\@example/, 'no %40, per RFC 6068'); unlike($res->content, qr/\r/, 'no CR in HTML'); - $res = $cb->(GET('http://example.com/test/crlf@example.com/raw')); + $res = $cb->(GET("$uri/test/crlf\@example.com/raw")); is($res->code, 200, 'retrieved CRLF raw'); like($res->content, qr/\r/, 'CR preserved in raw message'); -}); + $res = $cb->(GET("$uri/test/bogus\@example.com/raw")); + is($res->code, 404, 'missing /raw is 404'); -# 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)); + # redirect with newsgroup + my $from = "$uri/inbox.test"; + my $to = "http://example.com/test/"; + $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 { - my ($cb) = @_; - my $from = 'http://example.com/test'; - my $to = "$from/"; - my $res = $cb->(GET($from)); + # redirect with trailing / + $from = "$uri/test"; + $to = "$from/"; + $res = $cb->(GET($from)); is(301, $res->code, 'is permanent redirect'); is($to, $res->header('Location'), 'redirect location matches with trailing slash'); -}); -foreach my $t (qw(t T)) { - test_psgi($app, sub { - my ($cb) = @_; + for my $t (qw(T t)) { my $u = $pfx . "/blah\@example.com/$t"; - my $res = $cb->(GET($u)); + $res = $cb->(GET($u)); is(301, $res->code, "redirect for missing /"); my $location = $res->header('Location'); like($location, qr!/\Q$t\E/#u\z!, 'redirected with missing /'); - }); -} -foreach my $t (qw(f)) { - test_psgi($app, sub { - my ($cb) = @_; + } + + for my $t (qw(f)) { # legacy redirect my $u = $pfx . "/blah\@example.com/$t"; - my $res = $cb->(GET($u)); + $res = $cb->(GET($u)); is(301, $res->code, "redirect for legacy /f"); my $location = $res->header('Location'); like($location, qr!/blah\@example\.com/\z!, 'redirected with missing /'); - }); -} + } -test_psgi($app, sub { - my ($cb) = @_; - my $atomurl = 'http://example.com/test/new.atom'; - my $res = $cb->(GET('http://example.com/test/new.html')); + my $atomurl = "$uri/test/new.atom"; + $res = $cb->(GET("$uri/test/new.html")); is(200, $res->code, 'success response received'); like($res->content, qr!href="new\.atom"!, 'atom URL generated'); like($res->content, qr!href="blah\@example\.com/"!, 'index generated'); like($res->content, qr!1993-10-02!, 'date set'); -}); -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . '/atom.xml')); + $res = $cb->(GET($pfx . '/atom.xml')); is(200, $res->code, 'success response received for atom'); my $body = $res->content; like($body, qr!link\s+href="\Q$pfx\E/blah\@example\.com/"!s, @@ -218,17 +151,17 @@ test_psgi($app, sub { like($body, qr/zzzzzz/, 'body included'); $res = $cb->(GET($pfx . '/description')); like($res->content, qr/test for public-inbox/, 'got description'); -}); -test_psgi($app, sub { - my ($cb) = @_; my $path = '/blah@example.com/'; - my $res = $cb->(GET($pfx . $path)); + $res = $cb->(GET($pfx . $path)); is(200, $res->code, "success for $path"); my $html = $res->content; + like($html, qr!\bhref="\Q../_/text/help/"!, 'help available'); like($html, qr!hihi - Me!, 'HTML returned'); - like($html, qr!over'); $path .= 'f/'; $res = $cb->(GET($pfx . $path)); @@ -249,76 +182,79 @@ test_psgi($app, sub { $res = $cb->(GET($pfx . '/qp@example.com/')); like($res->content, qr/\bhi = bye\b/, "HTML output decoded QP"); -}); -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . '/blah@example.com/raw')); + $res = $cb->(GET($pfx . '/attached-mbox-with-utf8@example/')); + like($res->content, qr/: Bjørn /, 'UTF-8 in mbox #1'); + like($res->content, qr/: j Żen/, 'UTF-8 in mbox #2'); + + $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"); -}); + is($res->header('Content-Type'), 'text/plain; charset=iso-8859-1', + 'charset from message used'); + + $res = $cb->(GET($pfx . '/broken@example.com/raw')); + is($res->header('Content-Type'), 'text/plain; charset=UTF-8', + 'broken charset ignored'); + + $res = $cb->(GET($pfx . '/199707281508.AAA24167@hoyogw.example/raw')); + is($res->header('Content-Type'), 'text/plain; charset=ISO-2022-JP', + 'ISO-2002-JP returned'); + chomp($body = $res->content); + my $raw = PublicInbox::Eml->new(\$body); + is($raw->body_raw, $eml->body_raw, 'ISO-2022-JP body unmodified'); + + $res = $cb->(GET($pfx . '/blah@example.com/t.mbox.gz')); + is(501, $res->code, '501 when overview missing'); + like($res->content, qr!\bOverview\b!, 'overview omission noted'); -# legacy redirects -foreach my $t (qw(m f)) { - test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah\@example.com.txt")); + # legacy redirects + for my $t (qw(m f)) { + $res = $cb->(GET($pfx . "/$t/blah\@example.com.txt")); is(301, $res->code, "redirect for old $t .txt link"); - my $location = $res->header('Location'); + $location = $res->header('Location'); like($location, qr!/blah\@example\.com/raw\z!, ".txt redirected to /raw"); - }); -} - -my %umap = ( - 'm' => '', - 'f' => '', - 't' => 't/', -); -while (my ($t, $e) = each %umap) { - test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(GET($pfx . "/$t/blah\@example.com.html")); + } + + my %umap = ( + 'm' => '', + 'f' => '', + 't' => 't/', + ); + while (my ($t, $e) = each %umap) { + $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\@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\@example.com.$sfx")); + $location = $res->header('Location'); + like($location, qr!/blah\@example\.com/$e(?:#u)?\z!, + ".html redirected to new location"); + } + + for my $sfx (qw(mbox mbox.gz)) { + $res = $cb->(GET($pfx . "/t/blah\@example.com.$sfx")); is(301, $res->code, 'redirect for old thread link'); - my $location = $res->header('Location'); + $location = $res->header('Location'); like($location, qr!/blah\@example\.com/t\.mbox(?:\.gz)?\z!, "$sfx redirected to /mbox.gz"); - }); -} -test_psgi($app, sub { - my ($cb) = @_; + } + # for a while, we used to support /$INBOX/$X40/ # when we "compressed" long Message-IDs to SHA-1 # Now we're stuck supporting them forever :< - foreach my $path (@ls) { - $path =~ tr!/!!d; - my $from = "http://example.com/test/$path/"; - my $res = $cb->(GET($from)); + for my $path ('f2912279bd7bcd8b7ab3033234942d58746d56f7') { + $from = "$uri/test/$path/"; + $res = $cb->(GET($from)); is(301, $res->code, 'is permanent redirect'); like($res->header('Location'), qr!/test/blah\@example\.com/!, 'redirect from x40 MIDs works'); } -}); -# dumb HTTP clone/fetch support -test_psgi($app, sub { - my ($cb) = @_; - my $path = '/test/info/refs'; + # dumb HTTP clone/fetch support + $path = '/test/info/refs'; my $req = HTTP::Request->new('GET' => $path); - my $res = $cb->($req); + $res = $cb->($req); is(200, $res->code, 'refs readable'); my $orig = $res->content; @@ -331,19 +267,14 @@ test_psgi($app, sub { $res = $cb->($req); is(206, $res->code, 'got partial another response'); is($res->content, substr($orig, 5), 'partial body OK past end'); -}); -# things which should fail -test_psgi($app, sub { - my ($cb) = @_; - my $res = $cb->(PUT('/')); + # things which should fail + $res = $cb->(PUT('/')); is(405, $res->code, 'no PUT to / allowed'); $res = $cb->(PUT('/test/')); is(405, $res->code, 'no PUT /$INBOX allowed'); - - # TODO - # $res = $cb->(GET('/')); -}); - -done_testing(); +}; +test_psgi(require $psgi, $c1); +test_httpd($env, $c1); +done_testing;