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