]> Sergey Matveev's repositories - public-inbox.git/blob - xt/httpd-async-stream.t
lei_mirror: simplify forkgroup-related subs
[public-inbox.git] / xt / httpd-async-stream.t
1 #!perl -w
2 # Copyright (C) 2020-2021 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 my $endpoint = $ENV{TEST_ENDPOINT} // 'all.mbox.gz';
19 my $curl_opt = $ENV{TEST_CURL_OPT} // '';
20 diag "TEST_JOBS=$JOBS TEST_ENDPOINT=$endpoint TEST_CURL_OPT=$curl_opt";
21
22 # we set Host: to ensure stable results across test runs
23 my @CURL_OPT = (qw(-HHost:example.com -sSf), split(' ', $curl_opt));
24
25 my $make_local_server = sub {
26         my $pi_config = "$tmpdir/config";
27         open my $fh, '>', $pi_config or die "open($pi_config): $!";
28         print $fh <<"" or die "print $pi_config: $!";
29 [publicinbox "test"]
30 inboxdir = $inboxdir
31 address = test\@example.com
32
33         close $fh or die "close($pi_config): $!";
34         my ($out, $err) = ("$tmpdir/out", "$tmpdir/err");
35         for ($out, $err) {
36                 open my $fh, '>', $_ or die "truncate: $!";
37         }
38         my $http = tcp_server();
39         my $rdr = { 3 => $http };
40
41         # not using multiple workers, here, since we want to increase
42         # the chance of tripping concurrency bugs within PublicInbox/HTTP*.pm
43         my $cmd = [ '-httpd', "--stdout=$out", "--stderr=$err", '-W0' ];
44         my $host_port = tcp_host_port($http);
45         push @$cmd, "-lhttp://$host_port";
46         my $url = "$host_port/test/$endpoint";
47         print STDERR "# CMD ". join(' ', @$cmd). "\n";
48         my $env = { PI_CONFIG => $pi_config };
49         (start_script($cmd, $env, $rdr), $url);
50 };
51
52 my ($td, $url) = $make_local_server->();
53
54 my $do_get_all = sub {
55         my ($job) = @_;
56         local $SIG{__DIE__} = sub { print STDERR $job, ': ', @_; _exit(1) };
57         my $dig = Digest::MD5->new;
58         my ($buf, $nr);
59         my $bytes = 0;
60         my $t0 = now();
61         my ($rd, $pid) = popen_rd([$curl, @CURL_OPT, $url]);
62         while (1) {
63                 $nr = sysread($rd, $buf, 65536);
64                 last if !$nr;
65                 $dig->add($buf);
66                 $bytes += $nr;
67         }
68         my $res = $dig->hexdigest;
69         my $elapsed = sprintf('%0.3f', now() - $t0);
70         close $rd or die "close curl failed: $!\n";
71         waitpid($pid, 0) == $pid or die "waitpid failed: $!\n";
72         $? == 0 or die "curl failed: $?\n";
73         print STDERR "# $job $$ ($?) $res (${elapsed}s) $bytes bytes\n";
74         $res;
75 };
76
77 my (%pids, %res);
78 for my $job (1..$JOBS) {
79         pipe(my ($r, $w)) or die;
80         my $pid = fork;
81         if ($pid == 0) {
82                 close $r or die;
83                 my $res = $do_get_all->($job);
84                 print $w $res or die;
85                 close $w or die;
86                 _exit(0);
87         }
88         close $w or die;
89         $pids{$pid} = [ $job, $r ];
90 }
91
92 while (scalar keys %pids) {
93         my $pid = waitpid(-1, 0) or next;
94         my $child = delete $pids{$pid} or next;
95         my ($job, $rpipe) = @$child;
96         is($?, 0, "$job done");
97         my $sum = do { local $/; <$rpipe> };
98         push @{$res{$sum}}, $job;
99 }
100 is(scalar keys %res, 1, 'all got the same result');
101 $td->kill;
102 $td->join;
103 is($?, 0, 'no error on -httpd exit');
104 done_testing;