t/cgi.t

   1 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use Email::MIME;
   7 use File::Temp qw/tempdir/;
   8 use Cwd;
   9 use IPC::Run qw/run/;
  10
  11 use constant CGI => "blib/script/public-inbox.cgi";
  12 my $mda = "blib/script/public-inbox-mda";
  13 my $tmpdir = tempdir(CLEANUP => 1);
  14 my $home = "$tmpdir/pi-home";
  15 my $pi_home = "$home/.public-inbox";
  16 my $pi_config = "$pi_home/config";
  17 my $maindir = "$tmpdir/main.git";
  18 my $main_bin = getcwd()."/t/main-bin";
  19 my $main_path = "$main_bin:$ENV{PATH}"; # for spamc ham mock
  20 my $addr = 'test-public@example.com';
  21 my $cfgpfx = "publicinbox.test";
  22
  23 {
  24         ok(-x "$main_bin/spamc",
  25                 "spamc ham mock found (run in top of source tree");
  26         ok(-x $mda, "$mda is executable");
  27         is(1, mkdir($home, 0755), "setup ~/ for testing");
  28         is(1, mkdir($pi_home, 0755), "setup ~/.public-inbox");
  29         is(0, system(qw(git init -q --bare), $maindir), "git init (main)");
  30
  31         my %cfg = (
  32                 "$cfgpfx.address" => $addr,
  33                 "$cfgpfx.mainrepo" => $maindir,
  34                 "$cfgpfx.description" => 'test for public-inbox',
  35         );
  36         while (my ($k,$v) = each %cfg) {
  37                 is(0, system(qw(git config --file), $pi_config, $k, $v),
  38                         "setup $k");
  39         }
  40 }
  41
  42 my $failbox = "$home/fail.mbox";
  43 local $ENV{PI_EMERGENCY} = $failbox;
  44 {
  45         local $ENV{HOME} = $home;
  46         local $ENV{ORIGINAL_RECIPIENT} = $addr;
  47
  48         # ensure successful message delivery
  49         {
  50                 my $simple = Email::Simple->new(<<EOF);
  51 From: Me <me\@example.com>
  52 To: You <you\@example.com>
  53 Cc: $addr
  54 Message-Id: <blah\@example.com>
  55 Subject: hihi
  56 Date: Thu, 01 Jan 1970 00:00:00 +0000
  57
  58 zzzzzz
  59 EOF
  60                 my $in = $simple->as_string;
  61                 run_with_env({PATH => $main_path}, [$mda], \$in);
  62                 local $ENV{GIT_DIR} = $maindir;
  63                 my $rev = `git rev-list HEAD`;
  64                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
  65         }
  66
  67         # deliver a reply, too
  68         {
  69                 my $reply = Email::Simple->new(<<EOF);
  70 From: You <you\@example.com>
  71 To: Me <me\@example.com>
  72 Cc: $addr
  73 In-Reply-To: <blah\@example.com>
  74 Message-Id: <blahblah\@example.com>
  75 Subject: Re: hihi
  76 Date: Thu, 01 Jan 1970 00:00:01 +0000
  77
  78 Me wrote:
  79 > zzzzzz
  80
  81 what?
  82 EOF
  83                 my $in = $reply->as_string;
  84                 run_with_env({PATH => $main_path}, [$mda], \$in);
  85                 local $ENV{GIT_DIR} = $maindir;
  86                 my $rev = `git rev-list HEAD`;
  87                 like($rev, qr/\A[a-f0-9]{40}/, "good revision committed");
  88         }
  89
  90 }
  91
  92 # obvious failures, first
  93 {
  94         local $ENV{HOME} = $home;
  95         my $res = cgi_run("/", "", "PUT");
  96         like($res->{head}, qr/Status:\s*405/i, "PUT not allowed");
  97
  98         $res = cgi_run("/");
  99         like($res->{head}, qr/Status:\s*404/i, "index returns 404");
 100 }
 101
 102 # atom feeds
 103 {
 104         local $ENV{HOME} = $home;
 105         my $res = cgi_run("/test/all.atom.xml");
 106         like($res->{body}, qr/<title>test for public-inbox/,
 107                 "set title in XML feed");
 108         like($res->{body},
 109                 qr!http://test\.example\.com/test/m/blah%40example\.com!,
 110                 "link id set");
 111         like($res->{body}, qr/what\?/, "reply included");
 112
 113         $res = cgi_run("/test/index.atom.xml");
 114         unlike($res->{body}, qr/what\?/, "reply not included in index");
 115 }
 116
 117 # indices
 118 {
 119         local $ENV{HOME} = $home;
 120         my $res = cgi_run("/test/");
 121         like($res->{head}, qr/Status: 200 OK/, "index returns 200");
 122
 123         my $idx = cgi_run("/test/index.html");
 124         $idx->{body} =~ s!/index.html(\?r=)!/$1!; # dirty...
 125         is_deeply($res, $idx,
 126                 '/$LISTNAME/ and /$LISTNAME/index.html are nearly identical');
 127         # more checks in t/feed.t
 128 }
 129
 130 # message-id pages
 131 {
 132         local $ENV{HOME} = $home;
 133         my $slashy_mid = 'slashy/asdf@example.com';
 134         my $reply = Email::Simple->new(<<EOF);
 135 From: You <you\@example.com>
 136 To: Me <me\@example.com>
 137 Cc: $addr
 138 Message-Id: <$slashy_mid>
 139 Subject: Re: hihi
 140 Date: Thu, 01 Jan 1970 00:00:01 +0000
 141
 142 slashy
 143 EOF
 144         my $in = $reply->as_string;
 145
 146         {
 147                 local $ENV{HOME} = $home;
 148                 local $ENV{ORIGINAL_RECIPIENT} = $addr;
 149                 run_with_env({PATH => $main_path}, [$mda], \$in);
 150         }
 151         local $ENV{GIT_DIR} = $maindir;
 152
 153         my $res = cgi_run("/test/m/slashy%2fasdf%40example.com.txt");
 154         like($res->{body}, qr/Message-Id: <\Q$slashy_mid\E>/,
 155                 "slashy mid.txt hit");
 156
 157         $res = cgi_run("/test/m/blahblah\@example.com.txt");
 158         like($res->{body}, qr/Message-Id: <blahblah\@example\.com>/,
 159                 "mid.txt hit");
 160         $res = cgi_run("/test/m/blahblah\@example.con.txt");
 161         like($res->{head}, qr/Status: 404 Not Found/, "mid.txt miss");
 162
 163         $res = cgi_run("/test/m/blahblah\@example.com.html");
 164         like($res->{body}, qr/\A<html>/, "mid.html hit");
 165         like($res->{head}, qr/Status: 200 OK/, "200 response");
 166         $res = cgi_run("/test/m/blahblah\@example.con.html");
 167         like($res->{head}, qr/Status: 404 Not Found/, "mid.html miss");
 168
 169         $res = cgi_run("/test/f/blahblah\@example.com.html");
 170         like($res->{body}, qr/\A<html>/, "mid.html hit");
 171         like($res->{head}, qr/Status: 200 OK/, "200 response");
 172         $res = cgi_run("/test/f/blahblah\@example.con.html");
 173         like($res->{head}, qr/Status: 404 Not Found/, "mid.html miss");
 174
 175         $res = cgi_run("/test/");
 176         like($res->{body}, qr/slashy%2Fasdf%40example\.com/,
 177                 "slashy URL generated correctly");
 178 }
 179
 180 # redirect list-name-only URLs
 181 {
 182         local $ENV{HOME} = $home;
 183         my $res = cgi_run("/test");
 184         like($res->{head}, qr/Status: 301 Moved/, "redirected status");
 185         like($res->{head}, qr!/test/!, "redirected with slash");
 186 }
 187
 188 done_testing();
 189
 190 sub run_with_env {
 191         my ($env, @args) = @_;
 192         my $init = sub { foreach my $k (keys %$env) { $ENV{$k} = $env->{$k} } };
 193         run(@args, init => $init);
 194 }
 195
 196 sub cgi_run {
 197         my %env = (
 198                 PATH_INFO => $_[0],
 199                 QUERY_STRING => $_[1] || "",
 200                 REQUEST_METHOD => $_[2] || "GET",
 201                 GATEWAY_INTERFACE => 'CGI/1.1',
 202                 HTTP_ACCEPT => '*/*',
 203                 HTTP_HOST => 'test.example.com',
 204         );
 205         my ($in, $out, $err) = ("", "", "");
 206         my $rc = run_with_env(\%env, [CGI], \$in, \$out, \$err);
 207         my ($head, $body) = split(/\r\n\r\n/, $out, 2);
 208         { head => $head, body => $body, rc => $rc, err => $err }
 209 }