t/cgi.t

   1 #!perl -w
   2 # Copyright (C) 2014-2021 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use strict;
   5 use v5.10.1;
   6 use PublicInbox::TestCommon;
   7 use IO::Uncompress::Gunzip qw(gunzip);
   8 require_mods(qw(Plack::Handler::CGI Plack::Util));
   9 require PublicInbox::Eml;
  10 require PublicInbox::Import;
  11 require PublicInbox::Inbox;
  12 require PublicInbox::InboxWritable;
  13 require PublicInbox::Config;
  14 my ($tmpdir, $for_destroy) = tmpdir();
  15 my $home = "$tmpdir/pi-home";
  16 my $pi_home = "$home/.public-inbox";
  17 my $pi_config = "$pi_home/config";
  18 my $maindir = "$tmpdir/main.git";
  19 my $addr = 'test-public@example.com';
  20 PublicInbox::Import::init_bare($maindir);
  21 {
  22         mkdir($home, 0755) or BAIL_OUT $!;
  23         mkdir($pi_home, 0755) or BAIL_OUT $!;
  24         open my $fh, '>>', $pi_config or BAIL_OUT $!;
  25         print $fh <<EOF or BAIL_OUT $!;
  26 [publicinbox "test"]
  27         address = $addr
  28         inboxdir = $maindir
  29         indexlevel = basic
  30 EOF
  31         close $fh or BAIL_OUT $!;
  32 }
  33
  34 my $cfg = PublicInbox::Config->new($pi_config);
  35 my $ibx = $cfg->lookup_name('test');
  36 my $im = PublicInbox::InboxWritable->new($ibx)->importer(0);
  37
  38 {
  39         local $ENV{HOME} = $home;
  40
  41         # inject some messages:
  42         my $mime = PublicInbox::Eml->new(<<EOF);
  43 From: Me <me\@example.com>
  44 To: You <you\@example.com>
  45 Cc: $addr
  46 Message-Id: <blah\@example.com>
  47 Subject: hihi
  48 Date: Thu, 01 Jan 1970 00:00:00 +0000
  49
  50 zzzzzz
  51 EOF
  52         ok($im->add($mime), 'added initial message');
  53
  54         $mime->header_set('Message-ID', '<toobig@example.com>');
  55         $mime->body_set("z\n" x 1024);
  56         ok($im->add($mime), 'added big message');
  57
  58         # deliver a reply, too
  59         $mime = PublicInbox::Eml->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         ok($im->add($mime), 'added reply');
  74
  75         my $slashy_mid = 'slashy/asdf@example.com';
  76         my $slashy = PublicInbox::Eml->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         ok($im->add($slashy), 'added slash');
  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 SKIP: {
  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 $cmd = ['-index', $ibx->{inboxdir}, '--max-size=2k'];
 101         my $opt = { 2 => \(my $err) };
 102         my $indexed = run_script($cmd, undef, $opt);
 103         if ($indexed) {
 104                 $res = cgi_run($path);
 105                 like($res->{head}, qr/^Status: 200 /, "search returned mbox");
 106                 my $in = $res->{body};
 107                 my $out;
 108                 gunzip(\$in => \$out);
 109                 like($out, qr/^From /m, "From lines in mbox");
 110                 $res = cgi_run('/test/toobig@example.com/');
 111                 like($res->{head}, qr/^Status: 300 /,
 112                         'did not index or return >max-size message');
 113                 like($err, qr/skipping [a-f0-9]{40,}/,
 114                         'warned about skipping large OID');
 115         } else {
 116                 like($res->{head}, qr/^Status: 501 /, "search not available");
 117                 skip('DBD::SQLite not available', 7); # (4 - 1) above, 4 below
 118         }
 119         require_mods('XML::TreePP', 4);
 120         $path = "/test/blahblah\@example.com/t.atom";
 121         $res = cgi_run($path);
 122         like($res->{head}, qr/^Status: 200 /, "atom returned 200");
 123         like($res->{head}, qr!^Content-Type: application/atom\+xml!m,
 124                 "search returned atom");
 125         my $t = XML::TreePP->new->parse($res->{body});
 126         is(scalar @{$t->{feed}->{entry}}, 3, "parsed three entries");
 127         like($t->{feed}->{-xmlns}, qr/\bAtom\b/,
 128                         'looks like an an Atom feed');
 129 }
 130
 131 done_testing();
 132
 133 sub cgi_run {
 134         my $env = {
 135                 PATH_INFO => $_[0],
 136                 QUERY_STRING => $_[1] || "",
 137                 SCRIPT_NAME => '',
 138                 REQUEST_URI => $_[0] . ($_[1] ? "?$_[1]" : ''),
 139                 REQUEST_METHOD => $_[2] || "GET",
 140                 GATEWAY_INTERFACE => 'CGI/1.1',
 141                 HTTP_ACCEPT => '*/*',
 142                 HTTP_HOST => 'test.example.com',
 143         };
 144         my ($in, $out, $err) = ("", "", "");
 145         my $rdr = { 0 => \$in, 1 => \$out, 2 => \$err };
 146         run_script(['.cgi'], $env, $rdr);
 147         fail "unexpected error: \$?=$? ($err)" if $?;
 148         my ($head, $body) = split(/\r\n\r\n/, $out, 2);
 149         { head => $head, body => $body, err => $err }
 150 }