t/httpd.t

   1 # Copyright (C) 2016 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6
   7 foreach my $mod (qw(Plack::Util Plack::Builder Danga::Socket
   8                         HTTP::Date HTTP::Status)) {
   9         eval "require $mod";
  10         plan skip_all => "$mod missing for httpd.t" if $@;
  11 }
  12 use File::Temp qw/tempdir/;
  13 use Cwd qw/getcwd/;
  14 use IO::Socket;
  15 use Fcntl qw(FD_CLOEXEC F_SETFD F_GETFD);
  16 use Socket qw(SO_KEEPALIVE IPPROTO_TCP TCP_NODELAY);
  17
  18 # FIXME: too much setup
  19 my $tmpdir = tempdir('pi-httpd-XXXXXX', TMPDIR => 1, CLEANUP => 1);
  20 my $home = "$tmpdir/pi-home";
  21 my $err = "$tmpdir/stderr.log";
  22 my $out = "$tmpdir/stdout.log";
  23 my $maindir = "$tmpdir/main.git";
  24 my $group = 'test-httpd';
  25 my $addr = $group . '@example.com';
  26 my $cfgpfx = "publicinbox.$group";
  27 my $httpd = 'blib/script/public-inbox-httpd';
  28 my $init = 'blib/script/public-inbox-init';
  29
  30 my %opts = (
  31         LocalAddr => '127.0.0.1',
  32         ReuseAddr => 1,
  33         Proto => 'tcp',
  34         Type => SOCK_STREAM,
  35         Listen => 1024,
  36 );
  37 my $sock = IO::Socket::INET->new(%opts);
  38 my $pid;
  39 use_ok 'PublicInbox::Git';
  40 use_ok 'PublicInbox::Import';
  41 use_ok 'Email::MIME';
  42 END { kill 'TERM', $pid if defined $pid };
  43 {
  44         local $ENV{HOME} = $home;
  45         ok(!system($init, $group, $maindir, 'http://example.com/', $addr),
  46                 'init ran properly');
  47
  48         # ensure successful message delivery
  49         {
  50                 my $mime = Email::MIME->new(<<EOF);
  51 From: Me <me\@example.com>
  52 To: You <you\@example.com>
  53 Cc: $addr
  54 Message-Id: <nntp\@example.com>
  55 Subject: hihi
  56 Date: Thu, 01 Jan 1970 06:06:06 +0000
  57
  58 nntp
  59 EOF
  60                 $mime->header_set('List-Id', "<$addr>");
  61                 my $git = PublicInbox::Git->new($maindir);
  62                 my $im = PublicInbox::Import->new($git, 'test', $addr);
  63                 $im->add($mime);
  64                 $im->done($mime);
  65         }
  66         ok($sock, 'sock created');
  67         $! = 0;
  68         my $fl = fcntl($sock, F_GETFD, 0);
  69         ok(! $!, 'no error from fcntl(F_GETFD)');
  70         is($fl, FD_CLOEXEC, 'cloexec set by default (Perl behavior)');
  71         $pid = fork;
  72         if ($pid == 0) {
  73                 use POSIX qw(dup2);
  74                 # pretend to be systemd
  75                 fcntl($sock, F_SETFD, $fl &= ~FD_CLOEXEC);
  76                 dup2(fileno($sock), 3) or die "dup2 failed: $!\n";
  77                 $ENV{LISTEN_PID} = $$;
  78                 $ENV{LISTEN_FDS} = 1;
  79                 exec $httpd, "--stdout=$out", "--stderr=$err";
  80                 die "FAIL: $!\n";
  81         }
  82         ok(defined $pid, 'forked httpd process successfully');
  83         $! = 0;
  84         fcntl($sock, F_SETFD, $fl |= FD_CLOEXEC);
  85         ok(! $!, 'no error from fcntl(F_SETFD)');
  86         my $host = $sock->sockhost;
  87         my $port = $sock->sockport;
  88         my $conn = IO::Socket::INET->new(PeerAddr => $host,
  89                                 PeerPort => $port,
  90                                 Proto => 'tcp',
  91                                 Type => SOCK_STREAM);
  92         ok($conn, 'connected');
  93         ok($conn->write("GET / HTTP/1.0\r\n\r\n"), 'wrote data to socket');
  94         {
  95                 my $buf;
  96                 ok($conn->read($buf, 4096), 'read some bytes');
  97                 like($buf, qr!\AHTTP/1\.[01] 404\b!, 'got 404 response');
  98                 is($conn->read($buf, 1), 0, "EOF");
  99         }
 100
 101         is(system(qw(git clone -q --mirror),
 102                         "http://$host:$port/$group", "$tmpdir/clone.git"),
 103                 0, 'smart clone successful');
 104
 105         # ensure dumb cloning works, too:
 106         is(system('git', "--git-dir=$maindir",
 107                 qw(config http.uploadpack false)),
 108                 0, 'disable http.uploadpack');
 109         is(system(qw(git clone -q --mirror),
 110                         "http://$host:$port/$group", "$tmpdir/dumb.git"),
 111                 0, 'clone successful');
 112
 113         ok(kill('TERM', $pid), 'killed httpd');
 114         $pid = undef;
 115         waitpid(-1, 0);
 116
 117         is(system('git', "--git-dir=$tmpdir/clone.git",
 118                   qw(fsck --no-verbose)), 0,
 119                 'fsck on cloned directory successful');
 120 }
 121
 122 done_testing();
 123
 124 1;