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/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
 114 # indices
 115 {
 116         local $ENV{HOME} = $home;
 117         my $res = cgi_run("/test/");
 118         like($res->{head}, qr/Status: 200 OK/, "index returns 200");
 119
 120         my $idx = cgi_run("/test/index.html");
 121         $idx->{body} =~ s!/index.html(\?r=)!/$1!; # dirty...
 122         is_deeply($res, $idx,
 123                 '/$LISTNAME/ and /$LISTNAME/index.html are nearly identical');
 124         # more checks in t/feed.t
 125 }
 126
 127 # message-id pages
 128 {
 129         local $ENV{HOME} = $home;
 130         my $slashy_mid = 'slashy/asdf@example.com';
 131         my $reply = Email::Simple->new(<<EOF);
 132 From: You <you\@example.com>
 133 To: Me <me\@example.com>
 134 Cc: $addr
 135 Message-Id: <$slashy_mid>
 136 Subject: Re: hihi
 137 Date: Thu, 01 Jan 1970 00:00:01 +0000
 138
 139 slashy
 140 EOF
 141         my $in = $reply->as_string;
 142
 143         {
 144                 local $ENV{HOME} = $home;
 145                 local $ENV{ORIGINAL_RECIPIENT} = $addr;
 146                 run_with_env({PATH => $main_path}, [$mda], \$in);
 147         }
 148         local $ENV{GIT_DIR} = $maindir;
 149
 150         my $res = cgi_run("/test/m/slashy%2fasdf%40example.com.txt");
 151         like($res->{body}, qr/Message-Id: <\Q$slashy_mid\E>/,
 152                 "slashy mid.txt hit");
 153
 154         $res = cgi_run("/test/m/blahblah\@example.com.txt");
 155         like($res->{body}, qr/Message-Id: <blahblah\@example\.com>/,
 156                 "mid.txt hit");
 157         $res = cgi_run("/test/m/blahblah\@example.con.txt");
 158         like($res->{head}, qr/Status: 404 Not Found/, "mid.txt miss");
 159
 160         $res = cgi_run("/test/m/blahblah\@example.com.html");
 161         like($res->{body}, qr/\A<html>/, "mid.html hit");
 162         like($res->{head}, qr/Status: 200 OK/, "200 response");
 163         $res = cgi_run("/test/m/blahblah\@example.con.html");
 164         like($res->{head}, qr/Status: 404 Not Found/, "mid.html miss");
 165
 166         $res = cgi_run("/test/f/blahblah\@example.com.html");
 167         like($res->{body}, qr/\A<html>/, "mid.html hit");
 168         like($res->{head}, qr/Status: 200 OK/, "200 response");
 169         $res = cgi_run("/test/f/blahblah\@example.con.html");
 170         like($res->{head}, qr/Status: 404 Not Found/, "mid.html miss");
 171
 172         $res = cgi_run("/test/");
 173         like($res->{body}, qr/slashy%2Fasdf%40example\.com/,
 174                 "slashy URL generated correctly");
 175 }
 176
 177 # redirect list-name-only URLs
 178 {
 179         local $ENV{HOME} = $home;
 180         my $res = cgi_run("/test");
 181         like($res->{head}, qr/Status: 301 Moved/, "redirected status");
 182         like($res->{head}, qr!/test/!, "redirected with slash");
 183 }
 184
 185 done_testing();
 186
 187 sub run_with_env {
 188         my ($env, @args) = @_;
 189         my $init = sub { foreach my $k (keys %$env) { $ENV{$k} = $env->{$k} } };
 190         run(@args, init => $init);
 191 }
 192
 193 sub cgi_run {
 194         my %env = (
 195                 PATH_INFO => $_[0],
 196                 QUERY_STRING => $_[1] || "",
 197                 REQUEST_METHOD => $_[2] || "GET",
 198                 GATEWAY_INTERFACE => 'CGI/1.1',
 199                 HTTP_ACCEPT => '*/*',
 200                 HTTP_HOST => 'test.example.com',
 201         );
 202         my ($in, $out, $err) = ("", "", "");
 203         my $rc = run_with_env(\%env, [CGI], \$in, \$out, \$err);
 204         my ($head, $body) = split(/\r\n\r\n/, $out, 2);
 205         { head => $head, body => $body, rc => $rc, err => $err }
 206 }