xt/httpd-async-stream.t

   1 #!perl -w
   2 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 # Expensive test to validate compression and TLS.
   5 use strict;
   6 use Test::More;
   7 use PublicInbox::TestCommon;
   8 use PublicInbox::DS qw(now);
   9 use PublicInbox::Spawn qw(which popen_rd);
  10 use Digest::MD5;
  11 use POSIX qw(_exit);
  12 my $inboxdir = $ENV{GIANT_INBOX_DIR};
  13 plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir;
  14 my $curl = which('curl') or plan skip_all => "curl(1) missing for $0";
  15 my ($tmpdir, $for_destroy) = tmpdir();
  16 require_mods(qw(DBD::SQLite));
  17 my $JOBS = $ENV{TEST_JOBS} // 4;
  18 diag "TEST_JOBS=$JOBS";
  19
  20 my $make_local_server = sub {
  21         my $pi_config = "$tmpdir/config";
  22         open my $fh, '>', $pi_config or die "open($pi_config): $!";
  23         print $fh <<"" or die "print $pi_config: $!";
  24 [publicinbox "test"]
  25 inboxdir = $inboxdir
  26 address = test\@example.com
  27
  28         close $fh or die "close($pi_config): $!";
  29         my ($out, $err) = ("$tmpdir/out", "$tmpdir/err");
  30         for ($out, $err) {
  31                 open my $fh, '>', $_ or die "truncate: $!";
  32         }
  33         my $http = tcp_server();
  34         my $rdr = { 3 => $http };
  35
  36         # not using multiple workers, here, since we want to increase
  37         # the chance of tripping concurrency bugs within PublicInbox/HTTP*.pm
  38         my $cmd = [ '-httpd', "--stdout=$out", "--stderr=$err", '-W0' ];
  39         my $host_port = $http->sockhost.':'.$http->sockport;
  40         push @$cmd, "-lhttp://$host_port";
  41         my $url = "$host_port/test/all.mbox.gz";
  42         print STDERR "# CMD ". join(' ', @$cmd). "\n";
  43         my $env = { PI_CONFIG => $pi_config };
  44         (start_script($cmd, $env, $rdr), $url);
  45 };
  46
  47 my ($td, $url) = $make_local_server->();
  48
  49 my $do_get_all = sub {
  50         my ($job) = @_;
  51         local $SIG{__DIE__} = sub { print STDERR $job, ': ', @_; _exit(1) };
  52         my $dig = Digest::MD5->new;
  53         my ($buf, $nr);
  54         my $bytes = 0;
  55         my $t0 = now();
  56         my ($rd, $pid) = popen_rd([$curl, qw(-HHost:example.com -sSf), $url]);
  57         while (1) {
  58                 $nr = sysread($rd, $buf, 65536);
  59                 last if !$nr;
  60                 $dig->add($buf);
  61                 $bytes += $nr;
  62         }
  63         my $res = $dig->hexdigest;
  64         my $elapsed = sprintf('%0.3f', now() - $t0);
  65         close $rd or die "close curl failed: $!\n";
  66         waitpid($pid, 0) == $pid or die "waitpid failed: $!\n";
  67         $? == 0 or die "curl failed: $?\n";
  68         print STDERR "# $job $$ ($?) $res (${elapsed}s) $bytes bytes\n";
  69         $res;
  70 };
  71
  72 my (%pids, %res);
  73 for my $job (1..$JOBS) {
  74         pipe(my ($r, $w)) or die;
  75         my $pid = fork;
  76         if ($pid == 0) {
  77                 close $r or die;
  78                 my $res = $do_get_all->($job);
  79                 print $w $res or die;
  80                 close $w or die;
  81                 _exit(0);
  82         }
  83         close $w or die;
  84         $pids{$pid} = [ $job, $r ];
  85 }
  86
  87 while (scalar keys %pids) {
  88         my $pid = waitpid(-1, 0) or next;
  89         my $child = delete $pids{$pid} or next;
  90         my ($job, $rpipe) = @$child;
  91         is($?, 0, "$job done");
  92         my $sum = do { local $/; <$rpipe> };
  93         push @{$res{$sum}}, $job;
  94 }
  95 is(scalar keys %res, 1, 'all got the same result');
  96 $td->kill;
  97 $td->join;
  98 is($?, 0, 'no error on -httpd exit');
  99 done_testing;