]> Sergey Matveev's repositories - public-inbox.git/blobdiff - t/cgi.t
treewide: "require" + "use" cleanup and docs
[public-inbox.git] / t / cgi.t
diff --git a/t/cgi.t b/t/cgi.t
index d84e63487a43a367f89e796caf03260faa0159e6..9f67d5c0bd0004d89275c0d4e22a615993c3bc48 100644 (file)
--- a/t/cgi.t
+++ b/t/cgi.t
@@ -1,30 +1,20 @@
-# Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
-# License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+# Copyright (C) 2014-2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <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/;
-
-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(CLEANUP => 1);
+use PublicInbox::TestCommon;
+my ($tmpdir, $for_destroy) = tmpdir();
 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)");
@@ -32,25 +22,28 @@ my $cfgpfx = "publicinbox.test";
        open my $fh, '>', "$maindir/description" or die "open: $!\n";
        print $fh "test for public-inbox\n";
        close $fh or die "close: $!\n";
-       my %cfg = (
-               "$cfgpfx.address" => $addr,
-               "$cfgpfx.mainrepo" => $maindir,
-       );
-       while (my ($k,$v) = each %cfg) {
-               is(0, system(qw(git config --file), $pi_config, $k, $v),
-                       "setup $k");
-       }
+       open $fh, '>>', $pi_config or die;
+       print $fh <<EOF or die;
+[publicinbox "test"]
+       address = $addr
+       inboxdir = $maindir
+       indexlevel = basic
+EOF
+       close $fh or die "close: $!\n";
 }
 
-my $failbox = "$home/fail.mbox";
-local $ENV{PI_EMERGENCY} = $failbox;
+use_ok 'PublicInbox::Inbox';
+use_ok 'PublicInbox::InboxWritable';
+use_ok 'PublicInbox::Config';
+my $cfg = PublicInbox::Config->new($pi_config);
+my $ibx = $cfg->lookup_name('test');
+my $im = PublicInbox::InboxWritable->new($ibx)->importer;
+
 {
        local $ENV{HOME} = $home;
-       local $ENV{ORIGINAL_RECIPIENT} = $addr;
 
-       # ensure successful message delivery
-       {
-               my $simple = Email::Simple->new(<<EOF);
+       # inject some messages:
+       my $mime = Email::MIME->new(<<EOF);
 From: Me <me\@example.com>
 To: You <you\@example.com>
 Cc: $addr
@@ -60,16 +53,10 @@ 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`;
-               like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
-       }
+       $im->add($mime);
 
        # 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,57 +70,10 @@ 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`;
-               like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
-       }
-
-}
-
-# obvious failures, first
-{
-       local $ENV{HOME} = $home;
-       my $res = cgi_run("/", "", "PUT");
-       like($res->{head}, qr/Status:\s*405/i, "PUT not allowed");
-
-       $res = cgi_run("/");
-       like($res->{head}, qr/Status:\s*404/i, "index returns 404");
-}
-
-# atom feeds
-{
-       local $ENV{HOME} = $home;
-       my $res = cgi_run("/test/atom.xml");
-       like($res->{body}, qr/<title>test for public-inbox/,
-               "set title in XML feed");
-       like($res->{body},
-               qr!http://test\.example\.com/test/m/blah%40example\.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
-}
+       $im->add($reply);
 
-# message-id pages
-{
-       local $ENV{HOME} = $home;
        my $slashy_mid = 'slashy/asdf@example.com';
-       my $reply = Email::Simple->new(<<EOF);
+       my $slashy = Email::MIME->new(<<EOF);
 From: You <you\@example.com>
 To: Me <me\@example.com>
 Cc: $addr
@@ -143,50 +83,28 @@ 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($slashy);
+       $im->done;
 
-       my $res = cgi_run("/test/m/slashy%2fasdf%40example.com/raw");
+       my $res = cgi_run("/test/slashy/asdf\@example.com/raw");
        like($res->{body}, qr/Message-Id: <\Q$slashy_mid\E>/,
                "slashy mid raw hit");
-
-       $res = cgi_run("/test/m/blahblah\@example.com/raw");
-       like($res->{body}, qr/Message-Id: <blahblah\@example\.com>/,
-               "mid raw hit");
-       $res = cgi_run("/test/m/blahblah\@example.con/raw");
-       like($res->{head}, qr/Status: 404 Not Found/, "mid raw miss");
-
-       $res = cgi_run("/test/m/blahblah\@example.com/");
-       like($res->{body}, qr/\A<html>/, "mid html hit");
-       like($res->{head}, qr/Status: 200 OK/, "200 response");
-       $res = cgi_run("/test/m/blahblah\@example.con/");
-       like($res->{head}, qr/Status: 404 Not Found/, "mid html miss");
-
-       $res = cgi_run("/test/f/blahblah\@example.com/");
-       like($res->{body}, qr/\A<html>/, "mid html");
-       like($res->{head}, qr/Status: 200 OK/, "200 response");
-       $res = cgi_run("/test/f/blahblah\@example.con/");
-       like($res->{head}, qr/Status: 404 Not Found/, "mid html miss");
-
-       $res = cgi_run("/test/");
-       like($res->{body}, qr/slashy%2Fasdf%40example\.com/,
-               "slashy URL generated correctly");
 }
 
 # retrieve thread as an mbox
 {
        local $ENV{HOME} = $home;
-       local $ENV{PATH} = $main_path;
-       my $path = "/test/t/blahblah%40example.com/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;
+       my $indexed;
+       eval {
+               require DBD::SQLite;
+               require PublicInbox::SearchIdx;
+               my $s = PublicInbox::SearchIdx->new($ibx, 1);
+               $s->index_sync;
+               $indexed = 1;
+       };
        if ($indexed) {
                $res = cgi_run($path);
                like($res->{head}, qr/^Status: 200 /, "search returned mbox");
@@ -199,48 +117,41 @@ EOF
                };
        } else {
                like($res->{head}, qr/^Status: 501 /, "search not available");
+               SKIP: { skip 'DBD::SQLite not available', 2 };
        }
 
        my $have_xml_feed = eval { require XML::Feed; 1 } if $indexed;
        if ($have_xml_feed) {
-               $path = "/test/t/blahblah%40example.com/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/xml!m,
+               like($res->{head}, qr!^Content-Type: application/atom\+xml!m,
                        "search returned atom");
                my $p = XML::Feed->parse(\($res->{body}));
                is($p->format, "Atom", "parsed atom feed");
                is(scalar $p->entries, 3, "parsed three entries");
+       } else {
+               SKIP: { skip 'DBD::SQLite or XML::Feed missing', 2 };
        }
 }
 
-# redirect list-name-only URLs
-{
-       local $ENV{HOME} = $home;
-       my $res = cgi_run("/test");
-       like($res->{head}, qr/Status: 301 Moved/, "redirected status");
-       like($res->{head}, qr!/test/!, "redirected with slash");
-}
-
 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);
-}
-
 sub cgi_run {
        my %env = (
                PATH_INFO => $_[0],
                QUERY_STRING => $_[1] || "",
+               SCRIPT_NAME => '',
+               REQUEST_URI => $_[0] . ($_[1] ? "?$_[1]" : ''),
                REQUEST_METHOD => $_[2] || "GET",
                GATEWAY_INTERFACE => 'CGI/1.1',
                HTTP_ACCEPT => '*/*',
                HTTP_HOST => 'test.example.com',
        );
        my ($in, $out, $err) = ("", "", "");
-       my $rc = run_with_env(\%env, [CGI], \$in, \$out, \$err);
+       my $rdr = { 0 => \$in, 1 => \$out, 2 => \$err };
+       run_script(['.cgi'], \%env, $rdr);
+       die "unexpected error: \$?=$?" if $?;
        my ($head, $body) = split(/\r\n\r\n/, $out, 2);
-       { head => $head, body => $body, rc => $rc, err => $err }
+       { head => $head, body => $body, err => $err }
 }