--- /dev/null
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# 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 = <<EOM;
+$env->{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/(?<!\r)\n/\r\n/sg;
+
+ # not relying on \%special arg for parse_http_response since
+ # it doesn't handle multi-value (bugs or malicious behavior)
+ if ($k =~ /\AContent-Length\z/i) {
+ push @clen, $v;
+ } elsif ($k =~ /\ATransfer-Encoding\z/i) {
+ ++$chunked if $v =~ /\bchunked\b/i;
+ # let client deal with stacked encodings
+ } elsif ($k =~ /\ATrailer\z/i) {
+ push @tlr, $v;
+ } elsif ($k =~ /\A(?:Connection|Date|Keep-Alive|Upgrade)\z/i) {
+ next;
+ }
+ push @hdr, $k, $v;
+ }
+ scalar(@clen) > 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;
--- /dev/null
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+#
+# 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 <<EOM;
+E: `$dest' must be an HTTP IP address URL or unix: path
+EOM
+ }
+ $path //= '$fullpath'; # PublicInbox::H1ReqRes::fullpath
+ my @vars = ($path =~ m/\$(\w+)/g);
+ my @bad = grep !/\A(?:fullpath|host)\z/, @vars; # TODO: more vars
+ die "E: bad vars in `$path': @bad\n" if @bad;
+ # no leading slash iff using a path
+ $path =~ s!\A/(\$(?:fullpath|path))!!;
+ $self->{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;
--- /dev/null
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+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, <<EOM;
+use PublicInbox::PsgiRproxy;
+use Plack::Builder;
+builder {
+ mount 'http://nobuffer.example/' =>
+ 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;
projects / thirdparty / public-inbox.git / commitdiff
