From 6df9c39d80b1049589e6f8dcdc476aa8742709c6 Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Sun, 13 Jul 2025 00:08:35 +0000 Subject: [PATCH] http: introduce a reverse proxy PSGI app While nginx is (and is likely to remain) a popular reverse proxy, it is a commercial open core project nowadays which I haven't used in production in over a decade (since I used a Ruby reverse proxy, instead). Furthermore, nginx|haproxy|etc. is another dependency sysadmins need to configure and maintain in addition to our daemons (and varnish). Since our Perl code already needs to deal with IMAP scraper bots, it might as well deal with HTTP(S) ones as well :P Notable advantages of PublicInbox::PsgiRproxy over nginx for HTTPS termination include: * Response buffering is lazy by default. That is, whereas (last I checked) nginx either (a) buffers a response body in full before sending it or (b) doesn't buffer at all. (a) is safe for reducing backend contention but increases latency, whereas (b) allows slow clients to bottleneck fast backends. PublicInbox::PsgiRproxy defaults to writing to the client immediately (unbuffered), but starts buffering when a client can't keep up with the backend. * Perl configuration allows easier development of custom modules ("Plack middleware" in our case) for inspection of requests in Perl. It gives the PSGI env a way to detect reused connections and the $env->{'psgix.io'} handle can be used for TCP/TLS fingerprinting of suspected bots. * Trailers following chunked requests are supported (but mapped to headers for the backend). Response trailers are not yet supported since browsers (even bloated "modern" ones) can't seem to handle them. This PSGI reverse proxy has been fronting https://public-inbox.org and the https://yhbt.net/lore/ mirror for over a month, now. --- MANIFEST | 3 + lib/PublicInbox/H1ReqRes.pm | 378 ++++++++++++++++++++++++++++++++++ lib/PublicInbox/PsgiRproxy.pm | 98 +++++++++ t/httpd-corner.psgi | 14 ++ t/psgi_rproxy.t | 133 ++++++++++++ 5 files changed, 626 insertions(+) create mode 100644 lib/PublicInbox/H1ReqRes.pm create mode 100644 lib/PublicInbox/PsgiRproxy.pm create mode 100644 t/psgi_rproxy.t diff --git a/MANIFEST b/MANIFEST index 674b544ca..cc105c191 100644 --- a/MANIFEST +++ b/MANIFEST @@ -210,6 +210,7 @@ lib/PublicInbox/GitAsyncCat.pm lib/PublicInbox/GitCredential.pm lib/PublicInbox/GitHTTPBackend.pm lib/PublicInbox/GzipFilter.pm +lib/PublicInbox/H1ReqRes.pm lib/PublicInbox/HTTP.pm lib/PublicInbox/HTTPD.pm lib/PublicInbox/HlMod.pm @@ -329,6 +330,7 @@ lib/PublicInbox/POP3.pm lib/PublicInbox/POP3D.pm lib/PublicInbox/PktOp.pm lib/PublicInbox/PsgiLimiter.pm +lib/PublicInbox/PsgiRproxy.pm lib/PublicInbox/Qspawn.pm lib/PublicInbox/Reply.pm lib/PublicInbox/RepoAtom.pm @@ -599,6 +601,7 @@ t/psgi_bad_mids.t t/psgi_log.psgi t/psgi_mount.t t/psgi_multipart_not.t +t/psgi_rproxy.t t/psgi_scan_all.t t/psgi_search.t t/psgi_text.t diff --git a/lib/PublicInbox/H1ReqRes.pm b/lib/PublicInbox/H1ReqRes.pm new file mode 100644 index 000000000..bb68bcf3b --- /dev/null +++ b/lib/PublicInbox/H1ReqRes.pm @@ -0,0 +1,378 @@ +# Copyright (C) all contributors +# License: AGPL-3.0+ +# +# HTTP/1.x request/response object to a backend HTTP server, +# not tied to PublicInbox::WWW but uses public-inbox-{httpd,netd} +# features. Only used by PublicInbox::PsgiRproxy +package PublicInbox::H1ReqRes; +use v5.12; +use parent qw(PublicInbox::DS); +use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT); +# HTTP::Parser::XS is already used by most Plack installations +use HTTP::Parser::XS qw(parse_http_response HEADERS_AS_ARRAYREF); +use B qw(cstring); +use Carp qw(confess carp); + +use constant { # duplicated from HTTP.pm + CHUNK_START => -1, # [a-f0-9]+\r\n + CHUNK_END => -2, # \r\n + CHUNK_TLR_END => -3, # (trailers*)?\r\n + CHUNK_MAX_HDR => 256, +}; + +sub new { + my ($cls, $sock, $env, $rproxy, $wcb) = @_; + my $self = bless { + wbuf => [ \&send_req_hdr ], + wcb => $wcb, # write callbacke from PSGI server + rproxy => $rproxy, # PublicInbox::PsgiRproxy + env => $env, + # http_out # PublicInbox::HTTP::{Identity,Chunked} + }, $cls; + $self->SUPER::new($sock, EPOLLOUT|EPOLLONESHOT); +} + +# expands $fullpath in proxied request destination +sub fullpath { + my $env = $_[-1]; + my ($sn, $u) = @$env{qw(SCRIPT_NAME REQUEST_URI)}; + $u =~ m!\A(?:https?://[^/]+)?\Q$sn\E(/.+)\z!i ? $1 : $sn.$u; +} + +# expands $host in proxied request destination +sub host { + my ($env) = $_[-1]; + $env->{HTTP_HOST} // $env->{SERVER_NAME}; +} + +sub send_req_hdr { # called by flush_write + my ($self) = @_; + my $env = $self->{env}; + my $path = $self->{rproxy}->{path}; # $fullpath + my $prot = $env->{SERVER_PROTOCOL} // 'HTTP/1.0'; + $path =~ s!\$(\w+)!$self->$1($env)!sge; + my ($k, $v); + my $req = <{REQUEST_METHOD} $path $prot\r +X-Forwarded-Proto: $env->{'psgi.url_scheme'}\r +Connection: close\r +EOM + $v = $env->{HTTP_X_FORWARDED_FOR} // ''; + $v .= ', ' if $v =~ /\S/; + $req .= "X-Forwarded-For: $v$env->{REMOTE_ADDR}\r\n"; + while (($k, $v) = each %$env) { + next if $k =~ m!\AHTTP_(?:VERSION|CONNECTION|EXPECT|KEEP_ALIVE + |X_FORWARDED_FOR|TRAILER|UPGRADE)\z!sx; + # PublicInbox::HTTP already decoded chunked encoding, but + # there may be other encodings which we pass straight through. + # No idea if non-chunked Transfer-Encoding actually gets + # used anywhere... + if ($k eq 'HTTP_TRANSFER_ENCODING') { + my @v = grep !/\Achunked\z/i, split /\s*,\s*/, $v; + @v and $req .= 'Transfer-Encoding: '. + join(', ', @v)."\r\n"; + } elsif ($k =~ /\AHTTP_(.+)\z/) { + $k = $1; + $k =~ tr/_/-/; + $req .= "$k: $v\r\n"; + } + } + $v = $env->{CONTENT_TYPE} and $req .= "Content-Type: $v\r\n"; + # psgi.input always has an fstat(2)-able FD behind it w/ pi-httpd + if ($v = -s $env->{'psgi.input'}) { + $req .= "Content-Length: $v\r\n"; + $self->{req_left} = $v; + } + $req .= "\r\n"; + $self->write(\$req); + $self->write($v ? \&send_req_body : \&pass_res_hdr); +} + +sub _pass_done ($) { + delete($_[0]->{http_out})->close; + $_[0]->close; + undef; +} + +sub read_err ($$;$) { + my ($self, $next_cb, $len) = @_; + if ($self->{sock}) { # EAGAIN, wait for ->event_step + push(@{$self->{wbuf}}, $next_cb) > 1 and + confess 'BUG: attempted read w/ wbuf size='. + scalar(@{$self->{wbuf}}); + $self->{res_left} = $len if defined $len; + } elsif (defined $len) { + die "W: upstream terminated while reading response ($len)"; + } else { + die 'W: upstream terminated while reading response'; + } + undef; +} + +# when proxy_buffering is disabled +sub h1rr_pull { + my ($http) = @_; # PublicInbox::HTTP + my $self = delete $http->{forward} or return; # backend aborted + $self->{env}->{'pi-httpd.client'} = $http; # no circular ref here + delete($http->{h1rr_cb})->($self); +}; + +# returns true if we can continue looping +sub pass_refill ($$$$) { + my ($self, $n, $cb, $len) = @_; + my $http = $self->{env}->{'pi-httpd.client'}; + + # don't read from backend if remote client is blocked + if ($http->{wbuf} && $http->{wbuf}->[0] && + !$self->{rproxy}->{proxy_buffering}) { + delete $self->{env}->{'pi-httpd.client'}; # avoid circular ref + $self->{res_left} = $len if defined $len; + $http->{forward} = $self; + $http->{h1rr_cb} = $cb; + push @{$http->{wbuf}}, \&h1rr_pull; + undef; + } else { + my $rbuf = $self->{rbuf}; + my $r = $self->do_read($rbuf, $n, length($$rbuf)); + (!defined($r) || ($r == 0 && defined($len))) ? + read_err($self, $cb, $len) : $r; + } +} + +# pass a response body block of $len bytes (both chunk and identity) +sub _pass_res_block ($$) { + my ($self, $len) = @_; + my $rbuf = $self->{rbuf} //= \(my $x = ''); + my $cur = length($$rbuf); + if ($cur > $len) { # CRLF, chunk header or trailer follows in rbuf: + $self->{http_out}->write(substr($$rbuf, 0, $len, '')) or + return _pass_done $self; + 0; + } else { # $cur <= $len done with current rbuf + $self->{http_out}->write($$rbuf) or return _pass_done $self; + $$rbuf = ''; + $len - $cur; + } +} + +sub pass_trailers ($$) { + my ($self, $tlr_buf) = @_; + my $exp_tlr = delete $self->{tlr}; # TODO validate trailers + $self->{http_out}->write($tlr_buf); # $tlr_buf includes final CRLF + _pass_done $self; +} + +sub pass_res_chunked ($) { + my ($self) = @_; + my $rbuf = $self->{rbuf} //= \(my $x = ''); + my $len = delete $self->{res_left}; + while (1) { # chunk start + if ($len == CHUNK_TLR_END) { + # $1: all trailers minus final CRLF + if ($$rbuf =~ s/\A((?: + (?:[a-z][a-z0-9\-]*:[ \t]* # key: LWS: + | [ \t]+ # continuation LWS + )[^\n]* # trailer value + \n)* \r\n)//ismx) { + return pass_trailers $self, $1; + } + die 'chunk not terminated' if length($$rbuf) > 0x4000; + } + if ($len == CHUNK_END) { + if ($$rbuf =~ s/\A\r\n//s) { + $self->{http_out}->write("\r\n"); + $len = CHUNK_START; # fall-through + } elsif (length($$rbuf) > 2) { + die 'CHUNK_END too long'; + } + } + if ($len == CHUNK_START) { + if ($$rbuf =~ s/\A([a-f0-9]+)(.*?)\r\n//i) { + die "chunk 0x$1 too large" if length($1) > 8; + $len = hex $1; + $self->{http_out}->write("$1$2\r\n"); + } elsif (length($$rbuf) > CHUNK_MAX_HDR) { + die 'rbuf too large w/o CHUNK_START'; + } # else break from loop since $len >= 0 + } + if ($len < 0) { + pass_refill($self, 0x4000, \&pass_res_chunked, $len) or + return; + # (implicit) goto chunk_start if $r > 0; + } + $len = CHUNK_TLR_END if $len == 0; + + # pass the current chunk to client + while ($len > 0) { + if ($$rbuf ne '') { + $len = _pass_res_block($self, $len) // return; + if ($len == 0) { + # we may have leftover data to parse + # in chunk + $len = CHUNK_END; + } elsif ($len < 0) { + die "BUG: len < 0: $len"; + } # len > 0: keep passing current chunk + } + if ($$rbuf eq '') { + # read more of current chunk + pass_refill($self, 0x4000, + \&pass_res_chunked, $len) or return; + } + } + } +} + +sub pass_res_identity ($) { + my ($self) = @_; + my $rbuf = $self->{rbuf} //= \(my $x = ''); + my $len = delete $self->{res_left}; + while ($len > 0) { + if ($$rbuf ne '') { # may clear $rbuf: + $len = _pass_res_block($self, $len) // return; + } + if ($$rbuf eq '' && $len) { + my $n = $len > 0x4000 ? 0x4000 : $len; + pass_refill($self, $n, \&pass_res_identity, $len) or + return; + } + } + _pass_done $self; +} + +sub pass_res_until_eof ($) { # HTTP/1.0-only + my ($self) = @_; + my $rbuf = $self->{rbuf} //= \(my $x = ''); + while (1) { + if ($$rbuf ne '') { + $self->{http_out}->write($$rbuf) or + return _pass_done $self; + $$rbuf = ''; + } + if ($$rbuf eq '') { + my $r = pass_refill($self, 0x4000, + \&pass_res_until_eof, undef) // return; + last if $r == 0; # done + } + } + _pass_done $self; +} + +sub pass_res_hdr ($) { # called by flush_write + my ($self) = @_; + my ($rbuf, $r, $code, $phdr); + $rbuf = $self->{rbuf} // do { + $self->do_read(\(my $buf = ''), 0x4000) or + return read_err $self, \&pass_res_hdr; + $self->{rbuf} = \$buf; + }; + while (1) { + ($r, undef, $code, undef, $phdr) = + parse_http_response($$rbuf, HEADERS_AS_ARRAYREF); + last if $r > 0; + if ($r == -2) { # incomplete + length($$rbuf) > 0x4000 and + die 'upstream response headers too large'; + $self->do_read($rbuf, 8192, length($$rbuf)) or return + read_err $self, \&pass_res_hdr; + } else { + die "upstream sent bad response headers (r=$r)"; + } + } + substr $$rbuf, 0, $r, ''; # sv_chop off the header + my (@clen, @tlr, $k, $v, @hdr); + my $chunked = 0; + my $res_hdr_excl = $self->{rproxy}->{res_hdr_excl}; + push @$phdr, @{$self->{rproxy}->{res_hdr_add} // []}; + while (@$phdr) { + ($k, $v) = splice @$phdr, 0, 2; + next if $res_hdr_excl && $k =~ /$res_hdr_excl/; + # parse_http_response strips CR from embedded CRLF, + # HTTP::Server::PSGI and PublicInbox::HTTP will both + # pass all whitespace in $v straight through + $v =~ s/(? 1 and + die 'upstream set Content-Length '.scalar(@clen).' times'; + $chunked > 1 and + die "upstream set Transfer-Encoding: chunked $chunked times"; + @tlr && !$chunked and + die 'upstream sent Trailer w/o chunked response'; + my $wcb = delete $self->{wcb} // die 'BUG: no {wcb}'; + if ($self->{env}->{REQUEST_METHOD} eq 'HEAD') { + $wcb->([ $code, \@hdr, [] ]); + $self->close; + } elsif ($chunked) { + $self->{tlr} = join ',', @tlr; + $self->{res_left} = CHUNK_START; + $self->{http_out} = $wcb->([ $code, \@hdr ]); + pass_res_chunked $self; + } elsif ($clen[0]) { # non-zero Content-Length + $clen[0] =~ /\A[0-9]+\z/ or + die 'upstream sent invalid Content-Length: ', + cstring($clen[0]); + $self->{res_left} = $clen[0] + 0; + $self->{http_out} = $wcb->([ $code, \@hdr ]); + pass_res_identity $self; + } elsif (defined $clen[0]) { # no body in response + $wcb->([ $code, \@hdr, [] ]); + $self->close; + } else { # HTTP/1.0-only + $self->{http_out} = $wcb->([ $code, \@hdr ]); + pass_res_until_eof $self; + } +} + +sub send_req_body { # called by flush_write + my ($self) = @_; + # n.b. PublicInbox::HTTP always reads the entire request body + # before dispatching the PSGI app + my $r = $self->{req_left}; + $r = 0x4000 if $r > 0x4000; + $r = $self->{env}->{'psgi.input'}->read(my $buf, $r) // + die "input->read: $! ($self->{req_left} bytes left)"; + die "input->read: EOF ($self->{req_left} bytes left)" if $r == 0; + (($self->{req_left} -= $r) < 0) and + die "BUG: req_left=$self->{req_left} is negative"; + $self->write(\$buf); # may add to $self->{wbuf} + if ($self->{req_left}) { + $self->requeue if push(@{$self->{wbuf}}, \&send_req_body) == 1; + } else { + delete $self->{req_left}; + pass_res_hdr $self; + } +} + +sub event_step { + my ($self) = @_; + local $SIG{__WARN__} = $self->{env}->{'pi-httpd.warn_cb'}; + eval { return unless $self->flush_write && $self->{sock} }; + if ($@) { + warn $@; + $self->{env}->{'pi-httpd.client'}->close; + $self->close; + } +} + +sub close { + my ($self) = @_; + $self->SUPER::close; + my $wcb = delete $self->{wcb}; + $wcb->([502, [], []]) if $wcb; +} + +1; diff --git a/lib/PublicInbox/PsgiRproxy.pm b/lib/PublicInbox/PsgiRproxy.pm new file mode 100644 index 000000000..b9a8600c9 --- /dev/null +++ b/lib/PublicInbox/PsgiRproxy.pm @@ -0,0 +1,98 @@ +# Copyright (C) all contributors +# License: AGPL-3.0+ +# +# HTTP reverse proxy for HTTP(S) termination to varnish, not +# tied to PublicInbox::WWW but uses public-inbox-{httpd,netd} features +package PublicInbox::PsgiRproxy; +use v5.12; +use Socket (); +use Errno qw(EAGAIN EINPROGRESS); +use parent qw(Plack::Component); # for ->to_app +require PublicInbox::H1ReqRes; +use constant NB_STREAM => do { + Socket::SOCK_STREAM | (eval { Socket::SOCK_NONBLOCK() } // 0); +}; + +sub new { + my ($cls, $dest, %opt) = @_; + my $response_headers = delete $opt{response_headers}; + $response_headers->{server} //= undef; # don't lie, don't advertise + my ($res_hdr_excl, $res_hdr_add); + while (my ($k, $v) = each %$response_headers) { + if (defined $v) { + push @$res_hdr_add, [ $k, $v ]; + } else { + push @$res_hdr_excl, $k; + } + } + $opt{proxy_buffering} = 1 unless + (exists $opt{proxy_buffering} && !$opt{proxy_buffering}); + my $self = bless { %opt }, $cls; + if ($res_hdr_excl) { + $res_hdr_excl = join '|', map quotemeta, @$res_hdr_excl; + $self->{res_hdr_excl} = qr/\A(?:$res_hdr_excl)\z/i; + } + $self->{res_hdr_add} = $res_hdr_add if $res_hdr_add; + my $path; + if ($dest =~ m{\Aunix:([^:]+)(?::(/.*))?\z}) { + $path = $2; + # XXX pack_sockaddr_un can see $1 as undef for some reason, + # so we copy it: + my $addr = $1; + $addr = Socket::pack_sockaddr_un($addr); + @{$self->{conninfo}} = (Socket::AF_UNIX, $addr, $dest); + } elsif ($dest =~ m{\Ahttp://(?:\[([a-f0-9:]+)\]|([0-9\.]+)) + (?::([0-9]+))?(/.*)?\z}xi) { + $path = $4; + my ($host, $port) = ($1 // $2, $3 // 8080); + + # don't support DNS lookup for now, otherwise we'll need to + # add a timer to track DNS changes or expect users to reload + my ($err, @addr) = Socket::getaddrinfo($host, $port, { + hints => Socket::AI_NUMERICHOST, + socktype => Socket::SOCK_STREAM, + protocol => Socket::IPPROTO_TCP + }); + die "E: cannot resolve `$dest': $err\n" if $err || !@addr; + @{$self->{conninfo}} = map { + (@$_{qw(family addr)}, $dest) + } @addr; + } else { + die <{path} = $path; + $self; +} + +# ->to_app makes a sub which calls this +sub call { + my ($self, $env) = @_; + my @try = @{$self->{conninfo}}; + my ($sock, $family, $addr, $dest); + while (@try) { + ($family, $addr, $dest) = splice @try, 0, 3; + if (socket $sock, $family, NB_STREAM, 0) { + $sock->blocking(0) if NB_STREAM == Socket::SOCK_STREAM; + last if connect($sock, $addr) || + $! == EINPROGRESS || $! == EAGAIN; + warn "E: connect($dest): $!"; + } else { + warn "E: socket: $! ($dest)"; + } + undef $sock; + } + $sock ? sub { + my ($wcb) = @_; # PSGI server gives us this + PublicInbox::H1ReqRes->new($sock, $env, $self, $wcb); + } : [ 502, [], [] ]; +} + +1; diff --git a/t/httpd-corner.psgi b/t/httpd-corner.psgi index 0e668cc98..29f66be9f 100644 --- a/t/httpd-corner.psgi +++ b/t/httpd-corner.psgi @@ -2,6 +2,7 @@ # License: AGPL-3.0+ # corner case tests for the generic PSGI server # Usage: plackup [OPTIONS] /path/to/this/file +# used by httpd-{corner,https,unix}.t and psgi_rproxy.t use v5.12; use Plack::Builder; require PublicInbox::SHA; @@ -23,6 +24,7 @@ END { my $pi_config = $ENV{PI_CONFIG} // 'unset'; # capture ASAP my $app = sub { my ($env) = @_; + use Data::Dumper; warn Dumper($env); my $path = $env->{PATH_INFO}; my $in = $env->{'psgi.input'}; my $actual = -s $in; @@ -93,6 +95,14 @@ my $app = sub { $fh->write($buf); $fh->close; } + } elsif ($path eq '/callback-truncated') { + return sub { + my ($res) = @_; + push @$h, 'Transfer-Encoding', 'chunked'; + my $fh = $res->([200, $h]); + $fh->write("9\r\ntoo ort\r\n"); + $fh->close; + } } elsif ($path eq '/empty') { $code = 200; } elsif ($path eq '/getline-die') { @@ -149,6 +159,10 @@ my $app = sub { } elsif ($path eq '/url_scheme') { $code = 200; push @$body, $env->{'psgi.url_scheme'} + } elsif ($path eq '/server') { + $code = 200; + push @$h, 'Server', 'none-of-your-business'; + push @$body, 'trying to advertise server behind rproxy'; } elsif ($path eq '/PI_CONFIG') { $code = 200; push @$body, $pi_config; # show value at ->refresh_groups diff --git a/t/psgi_rproxy.t b/t/psgi_rproxy.t new file mode 100644 index 000000000..06b996c0c --- /dev/null +++ b/t/psgi_rproxy.t @@ -0,0 +1,133 @@ +#!perl -w +# Copyright (C) all contributors +# License: AGPL-3.0+ +use v5.12; use PublicInbox::TestCommon; use autodie; +use Socket (); +use POSIX (); +use PublicInbox::Spawn qw(popen_rd); +use PublicInbox::IO qw(write_file); +my $curl = require_cmd 'curl'; +require_mods qw(-httpd Plack::Builder HTTP::Parser::XS); +my $psgi = "./t/httpd-corner.psgi"; +my $tmpdir = tmpdir; +my $fifo = "$tmpdir/fifo"; +POSIX::mkfifo($fifo, 0777) // xbail "mkfifo: $!"; +my $unix_dest = "$tmpdir/u.sock"; +my ($back_out, $back_err) = ("$tmpdir/back.out", "$tmpdir/back.err"); +my ($front_out, $front_err) = ("$tmpdir/front.out", "$tmpdir/front.err"); +my $back_unix = IO::Socket::UNIX->new(Local => $unix_dest, + Listen => 4096, Type => Socket::SOCK_STREAM) or + xbail "bind+listen $unix_dest: $!"; +my $back_tcp = tcp_server(); +my $back_tcp_host_port = tcp_host_port($back_tcp); +$back_unix->blocking(0); +my $front_tcp = tcp_server(); +my $front_url = 'http://'.tcp_host_port($front_tcp); +my $front_psgi = "$tmpdir/u.psgi"; +write_file '>>', $front_psgi, < + PublicInbox::PsgiRproxy->new( + "http://$back_tcp_host_port", + proxy_buffering => 0)->to_app; + mount '/' => PublicInbox::PsgiRproxy->new("unix:$unix_dest")->to_app; +}; +EOM +my $back_cmd = [ '-httpd', '-W0', + "--stdout=$back_out", "--stderr=$back_err", $psgi ]; +my $back_td = start_script($back_cmd, {}, { 3 => $back_unix, 4 => $back_tcp }); + +my $front_cmd = [ '-httpd', '-W0', + "--stdout=$front_out", "--stderr=$front_err", $front_psgi]; +my $front_td = start_script($front_cmd, {}, { 3 => $front_tcp }); + +for my $opt (map { (['-0', @$_], $_) } (['-HHost:nobuffer.example'], [])) { + my $cmd = [ $curl, @$opt, "-HX-Check-Fifo:$fifo", + qw(-NsSf), "$front_url/slow-header" ]; + my $rd = popen_rd $cmd; + open my $f, '>', $fifo; + $f->autoflush(1); + print $f "hello\n" or xbail "print $fifo: $!"; + close $f; + my $buf = do { local $/; <$rd>; }; + $rd->close or xbail "curl failed: $?"; + is $buf, "hello\n", "got expected response w/ (@$opt)"; + + $cmd = [ $curl, "-HX-Check-Fifo:$fifo", @$opt, + qw(-NsSf), "$front_url/slow-body" ]; + $rd = popen_rd $cmd; + open $f, '>', $fifo; + $f->autoflush(1); + for my $c ('a'..'c') { + $c .= "\n"; + print $f $c or xbail "print to FIFO: $!"; + $buf = <$rd>; + is $buf, $c, "got trickle for reading (@$opt)"; + } + print $f "world\n" or xbail "print final line to FIFO: $!"; + close $f; + $buf = <$rd>; + is $buf, "world\n", "read expected body from curl (@$opt)"; + $rd->close or xbail "curl failed: $? (@$opt)"; +} + +{ + open my $fh, '<', 'COPYING'; + my $csum = '78e50e186b04c8fe1defaa098f1c192181b3d837'; + for my $exp (map { (['-HExpect:', @$_], $_) } ( + ['-HHost:nobuffer.example'], [])) { + my $cmd = [ $curl, @$exp, qw(--tcp-nodelay -NsSf), + "$front_url/sha1", '-T-' ]; + pipe(my $r, my $w); + my $rd = popen_rd $cmd, undef, { 0 => $r }; + close $r; + $w->autoflush(1); + my $n; + do { + $n = read($fh, my $buf, 8192) // + xbail "read(COPYING): $!"; + if ($n) { + print $w $buf or xbail "print: $!"; + } + } while ($n); + close $w; + my $sha = do { local $/; <$rd> }; + is $sha, $csum, "largish chunked upload accepted (@$exp)"; + seek $fh, 0, 0; + pop(@$cmd) eq '-T-' or xbail "BUG `-T-' not popped"; + push @$cmd, '-T', 'COPYING'; + $sha = xqx $cmd; + is $sha, $csum, "largish identity upload accepted (@$exp)"; + } +} + +# HTTP/1.1-only +for my $host (['-HHost:nobuffer.example'], []) { + my $cmd = [ $curl, @$host, qw(-NsSf), "$front_url/getline-die" ]; + xsys $cmd, undef, { 2 => \(my $cerr = '') }; + is($? >> 8, 18, "curl @$host saw partial response on getline-die") or + diag $cerr; + + $cmd = [ $curl, @$host, qw(-NsSf), "$front_url/close-die" ]; + xsys $cmd, undef, { 2 => \($cerr = '') }; + is($? >> 8, 18, "curl @$host saw partial response on close-die") or + diag $cerr; + + $cmd = [ $curl, @$host, qw(-NsSf), "$front_url/callback-truncated" ]; + xsys $cmd, undef, { 1 => \(my $cout = ''), 2 => \($cerr = '') }; + is($? >> 8, 18, + "curl @$host saw partial response on truncated response") or + diag $cerr; +} +{ + my $c = tcp_connect $front_tcp; + print $c "GET /server HTTP/1.0\r\n\r\n"; + my $buf = do { local $/; <$c> }; + unlike $buf, qr/^server:/smi, 'Server: tag filtered out by default'; + like $buf, qr!^trying to advertise!sm, + 'actually made correct request to test with'; +} + +done_testing; -- 2.47.2