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 {
  43         my $failbox = "$home/fail.mbox";
  44         local $ENV{PI_FAILBOX} = $failbox;
  45         local $ENV{HOME} = $home;
  46         local $ENV{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/mid/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/all.atom.xml");
 121         like($res->{body}, qr/<title>test for public-inbox/,
 122                 "set title in XML feed");
 123         like($res->{body},
 124                 qr!http://test\.example\.com/test/mid/blah%40example\.com!,
 125                 "link id set");
 126         like($res->{body}, qr/what\?/, "reply included");
 127
 128         $res = cgi_run("/test/index.atom.xml");
 129         unlike($res->{body}, qr/what\?/, "reply not included in index");
 130 }
 131
 132 done_testing();
 133
 134 sub run_with_env {
 135         my ($env, @args) = @_;
 136         my $init = sub { foreach my $k (keys %$env) { $ENV{$k} = $env->{$k} } };
 137         run(@args, init => $init);
 138 }
 139
 140 sub cgi_run {
 141         my %env = (
 142                 PATH_INFO => $_[0],
 143                 QUERY_STRING => $_[1] || "",
 144                 REQUEST_METHOD => $_[2] || "GET",
 145                 GATEWAY_INTERFACE => 'CGI/1.1',
 146                 HTTP_ACCEPT => '*/*',
 147                 HTTP_HOST => 'test.example.com',
 148         );
 149         my ($in, $out, $err) = ("", "", "");
 150         my $rc = run_with_env(\%env, [CGI], \$in, \$out, \$err);
 151         my ($head, $body) = split(/\r\n\r\n/, $out, 2);
 152         { head => $head, body => $body, rc => $rc, err => $err }
 153 }