diff options
Diffstat (limited to 'xt/httpd-async-stream.t')
| -rw-r--r-- | xt/httpd-async-stream.t | 82 |
1 files changed, 57 insertions, 25 deletions
diff --git a/xt/httpd-async-stream.t b/xt/httpd-async-stream.t index 22a96875..21d09331 100644 --- a/xt/httpd-async-stream.t +++ b/xt/httpd-async-stream.t @@ -1,17 +1,19 @@ #!perl -w -# Copyright (C) 2020 all contributors <meta@public-inbox.org> +# Copyright (C) all contributors <meta@public-inbox.org> # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> # Expensive test to validate compression and TLS. -use strict; -use Test::More; +use v5.12; +use autodie; +use PublicInbox::IO qw(write_file); +use IO::Uncompress::Gunzip qw(gunzip $GunzipError); use PublicInbox::TestCommon; use PublicInbox::DS qw(now); -use PublicInbox::Spawn qw(which popen_rd); +use PublicInbox::Spawn qw(popen_rd); use Digest::MD5; use POSIX qw(_exit); my $inboxdir = $ENV{GIANT_INBOX_DIR}; plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; -my $curl = which('curl') or plan skip_all => "curl(1) missing for $0"; +my $curl = require_cmd('curl'); my ($tmpdir, $for_destroy) = tmpdir(); require_mods(qw(DBD::SQLite)); my $JOBS = $ENV{TEST_JOBS} // 4; @@ -23,33 +25,40 @@ diag "TEST_JOBS=$JOBS TEST_ENDPOINT=$endpoint TEST_CURL_OPT=$curl_opt"; my @CURL_OPT = (qw(-HHost:example.com -sSf), split(' ', $curl_opt)); my $make_local_server = sub { + my ($http) = @_; my $pi_config = "$tmpdir/config"; - open my $fh, '>', $pi_config or die "open($pi_config): $!"; - print $fh <<"" or die "print $pi_config: $!"; + write_file '>', $pi_config, <<""; [publicinbox "test"] inboxdir = $inboxdir address = test\@example.com - close $fh or die "close($pi_config): $!"; my ($out, $err) = ("$tmpdir/out", "$tmpdir/err"); - for ($out, $err) { - open my $fh, '>', $_ or die "truncate: $!"; - } - my $http = tcp_server(); - my $rdr = { 3 => $http }; + for ($out, $err) { open my $fh, '>', $_ } # not using multiple workers, here, since we want to increase # the chance of tripping concurrency bugs within PublicInbox/HTTP*.pm my $cmd = [ '-httpd', "--stdout=$out", "--stderr=$err", '-W0' ]; - my $host_port = $http->sockhost.':'.$http->sockport; + my $host_port = tcp_host_port($http); push @$cmd, "-lhttp://$host_port"; my $url = "$host_port/test/$endpoint"; print STDERR "# CMD ". join(' ', @$cmd). "\n"; my $env = { PI_CONFIG => $pi_config }; - (start_script($cmd, $env, $rdr), $url); + (start_script($cmd, $env, { 3 => $http }), $url) }; -my ($td, $url) = $make_local_server->(); +my ($td, $url) = $make_local_server->(my $http = tcp_server()); + +my $s1 = tcp_connect($http); +my $rbuf = do { # pipeline while reading long response + my $req = <<EOM; +GET /test/$endpoint HTTP/1.1\r +Host: example.com\r +\r +EOM + is syswrite($s1, $req), length($req), 'initial long req'; + <$s1>; +}; +like $rbuf, qr!\AHTTP/1\.1 200\b!, 'started reading 200 response'; my $do_get_all = sub { my ($job) = @_; @@ -58,7 +67,7 @@ my $do_get_all = sub { my ($buf, $nr); my $bytes = 0; my $t0 = now(); - my ($rd, $pid) = popen_rd([$curl, @CURL_OPT, $url]); + my $rd = popen_rd([$curl, @CURL_OPT, $url]); while (1) { $nr = sysread($rd, $buf, 65536); last if !$nr; @@ -67,25 +76,23 @@ my $do_get_all = sub { } my $res = $dig->hexdigest; my $elapsed = sprintf('%0.3f', now() - $t0); - close $rd or die "close curl failed: $!\n"; - waitpid($pid, 0) == $pid or die "waitpid failed: $!\n"; - $? == 0 or die "curl failed: $?\n"; + $rd->close or xbail "close curl failed: $! \$?=$?\n"; print STDERR "# $job $$ ($?) $res (${elapsed}s) $bytes bytes\n"; $res; }; my (%pids, %res); for my $job (1..$JOBS) { - pipe(my ($r, $w)) or die; + pipe(my $r, my $w); my $pid = fork; if ($pid == 0) { - close $r or die; + close $r; my $res = $do_get_all->($job); - print $w $res or die; - close $w or die; + print $w $res; + close $w; _exit(0); } - close $w or die; + close $w; $pids{$pid} = [ $job, $r ]; } @@ -98,6 +105,31 @@ while (scalar keys %pids) { push @{$res{$sum}}, $job; } is(scalar keys %res, 1, 'all got the same result'); +{ + my $req = <<EOM; +GET /test/manifest.js.gz HTTP/1.1\r +Host: example.com\r +Connection: close\r +\r +EOM + is syswrite($s1, $req), length($req), + 'pipeline another request while reading long response'; + diag 'reading remainder of slow response'; + my $res = do { local $/ = "\r\n\r\n"; <$s1> }; + like $res, qr/^Transfer-Encoding: chunked\r\n/sm, 'chunked response'; + { + local $/ = "\r\n"; # get to final chunk + while (defined(my $l = <$s1>)) { last if $l eq "0\r\n" } + }; + is scalar(readline($s1)), "\r\n", 'got final CRLF from 1st response'; + diag "second response:"; + $res = do { local $/ = "\r\n\r\n"; <$s1> }; + like $res, qr!\AHTTP/1\.1 200 !, 'response for pipelined req'; + gunzip($s1 => \my $json) or xbail "gunzip $GunzipError"; + my $m = PublicInbox::Config::json()->decode($json); + like $m->{'/test'}->{fingerprint}, qr/\A[0-9a-f]{40,}\z/, + 'acceptable fingerprint in response'; +} $td->kill; $td->join; is($?, 0, 'no error on -httpd exit'); |