t/cgi.t

   1 # Copyright (C) 2014-2019 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 # FIXME: this test is too slow and most non-CGI-requirements
   4 # should be moved over to things which use test_psgi
   5 use strict;
   6 use warnings;
   7 use Test::More;
   8 use Email::MIME;
   9 use PublicInbox::TestCommon;
  10 my ($tmpdir, $for_destroy) = tmpdir();
  11 my $home = "$tmpdir/pi-home";
  12 my $pi_home = "$home/.public-inbox";
  13 my $pi_config = "$pi_home/config";
  14 my $maindir = "$tmpdir/main.git";
  15 my $addr = 'test-public@example.com';
  16
  17 {
  18         is(1, mkdir($home, 0755), "setup ~/ for testing");
  19         is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox");
  20         is(0, system(qw(git init -q --bare), $maindir), "git init (main)");
  21
  22         open my $fh, '>', "$maindir/description" or die "open: $!\n";
  23         print $fh "test for public-inbox\n";
  24         close $fh or die "close: $!\n";
  25         open $fh, '>>', $pi_config or die;
  26         print $fh <<EOF or die;
  27 [publicinbox "test"]
  28         address = $addr
  29         inboxdir = $maindir
  30         indexlevel = basic
  31 EOF
  32         close $fh or die "close: $!\n";
  33 }
  34
  35 use_ok 'PublicInbox::Inbox';
  36 use_ok 'PublicInbox::InboxWritable';
  37 use_ok 'PublicInbox::Config';
  38 my $cfg = PublicInbox::Config->new($pi_config);
  39 my $ibx = $cfg->lookup_name('test');
  40 my $im = PublicInbox::InboxWritable->new($ibx)->importer;
  41
  42 {
  43         local $ENV{HOME} = $home;
  44
  45         # inject some messages:
  46         my $mime = Email::MIME->new(<<EOF);
  47 From: Me <me\@example.com>
  48 To: You <you\@example.com>
  49 Cc: $addr
  50 Message-Id: <blah\@example.com>
  51 Subject: hihi
  52 Date: Thu, 01 Jan 1970 00:00:00 +0000
  53
  54 zzzzzz
  55 EOF
  56         $im->add($mime);
  57
  58         # deliver a reply, too
  59         my $reply = Email::MIME->new(<<EOF);
  60 From: You <you\@example.com>
  61 To: Me <me\@example.com>
  62 Cc: $addr
  63 In-Reply-To: <blah\@example.com>
  64 Message-Id: <blahblah\@example.com>
  65 Subject: Re: hihi
  66 Date: Thu, 01 Jan 1970 00:00:01 +0000
  67
  68 Me wrote:
  69 > zzzzzz
  70
  71 what?
  72 EOF
  73         $im->add($reply);
  74
  75         my $slashy_mid = 'slashy/asdf@example.com';
  76         my $slashy = Email::MIME->new(<<EOF);
  77 From: You <you\@example.com>
  78 To: Me <me\@example.com>
  79 Cc: $addr
  80 Message-Id: <$slashy_mid>
  81 Subject: Re: hihi
  82 Date: Thu, 01 Jan 1970 00:00:01 +0000
  83
  84 slashy
  85 EOF
  86         $im->add($slashy);
  87         $im->done;
  88
  89         my $res = cgi_run("/test/slashy/asdf\@example.com/raw");
  90         like($res->{body}, qr/Message-Id: <\Q$slashy_mid\E>/,
  91                 "slashy mid raw hit");
  92 }
  93
  94 # retrieve thread as an mbox
  95 {
  96         local $ENV{HOME} = $home;
  97         my $path = "/test/blahblah\@example.com/t.mbox.gz";
  98         my $res = cgi_run($path);
  99         like($res->{head}, qr/^Status: 501 /, "search not-yet-enabled");
 100         my $indexed;
 101         eval {
 102                 require DBD::SQLite;
 103                 require PublicInbox::SearchIdx;
 104                 my $s = PublicInbox::SearchIdx->new($ibx, 1);
 105                 $s->index_sync;
 106                 $indexed = 1;
 107         };
 108         if ($indexed) {
 109                 $res = cgi_run($path);
 110                 like($res->{head}, qr/^Status: 200 /, "search returned mbox");
 111                 eval {
 112                         require IO::Uncompress::Gunzip;
 113                         my $in = $res->{body};
 114                         my $out;
 115                         IO::Uncompress::Gunzip::gunzip(\$in => \$out);
 116                         like($out, qr/^From /m, "From lines in mbox");
 117                 };
 118         } else {
 119                 like($res->{head}, qr/^Status: 501 /, "search not available");
 120                 SKIP: { skip 'DBD::SQLite not available', 2 };
 121         }
 122
 123         my $have_xml_feed = eval { require XML::Feed; 1 } if $indexed;
 124         if ($have_xml_feed) {
 125                 $path = "/test/blahblah\@example.com/t.atom";
 126                 $res = cgi_run($path);
 127                 like($res->{head}, qr/^Status: 200 /, "atom returned 200");
 128                 like($res->{head}, qr!^Content-Type: application/atom\+xml!m,
 129                         "search returned atom");
 130                 my $p = XML::Feed->parse(\($res->{body}));
 131                 is($p->format, "Atom", "parsed atom feed");
 132                 is(scalar $p->entries, 3, "parsed three entries");
 133         } else {
 134                 SKIP: { skip 'DBD::SQLite or XML::Feed missing', 2 };
 135         }
 136 }
 137
 138 done_testing();
 139
 140 sub cgi_run {
 141         my %env = (
 142                 PATH_INFO => $_[0],
 143                 QUERY_STRING => $_[1] || "",
 144                 SCRIPT_NAME => '',
 145                 REQUEST_URI => $_[0] . ($_[1] ? "?$_[1]" : ''),
 146                 REQUEST_METHOD => $_[2] || "GET",
 147                 GATEWAY_INTERFACE => 'CGI/1.1',
 148                 HTTP_ACCEPT => '*/*',
 149                 HTTP_HOST => 'test.example.com',
 150         );
 151         my ($in, $out, $err) = ("", "", "");
 152         my $rdr = { 0 => \$in, 1 => \$out, 2 => \$err };
 153         run_script(['.cgi'], \%env, $rdr);
 154         die "unexpected error: \$?=$?" if $?;
 155         my ($head, $body) = split(/\r\n\r\n/, $out, 2);
 156         { head => $head, body => $body, err => $err }
 157 }