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