From 1b8840d8d13491eecd2fa92e06f73c65eadd33ba Mon Sep 17 00:00:00 2001
From: Eric Wong <BOFH@YHBT.net>
Date: Mon, 5 Jun 2023 10:12:44 +0000
Subject: [PATCH 15/23] port t9000-preread-input.sh to Perl 5

Stuffing it into t/integration.t for now so we can save on
startup costs.
---
 t/integration.t          | 32 ++++++++++++++++++++++++---
 t/lib.perl               |  2 +-
 t/preread_input.ru       |  4 +---
 t/t9000-preread-input.sh | 48 ----------------------------------------
 4 files changed, 31 insertions(+), 55 deletions(-)
 delete mode 100755 t/t9000-preread-input.sh

diff --git a/t/integration.t b/t/integration.t
index b33e3c3..f5afd5d 100644
--- a/t/integration.t
+++ b/t/integration.t
@@ -7,8 +7,8 @@
 
 use v5.14; BEGIN { require './t/lib.perl' };
 use autodie;
-my $srv = tcp_server();
-my $host_port = tcp_host_port($srv);
+our $srv = tcp_server();
+our $host_port = tcp_host_port($srv);
 my $t0 = time;
 my $conf = "$tmpdir/u.conf.rb";
 open my $conf_fh, '>', $conf;
@@ -209,8 +209,34 @@ SKIP: {
 	seek($rh, 0, SEEK_SET);
 	$copt->{0} = $rh;
 	$do_curl->('-T-');
-}
 
+	diag 'testing Unicorn::PrereadInput...';
+	local $srv = tcp_server();
+	local $host_port = tcp_host_port($srv);
+	check_stderr;
+	truncate($errfh, 0);
+
+	my $pri = unicorn(qw(-E none t/preread_input.ru), { 3 => $srv });
+	$url = "http://$host_port/";
+
+	$do_curl->(qw(-T t/random_blob));
+	seek($rh, 0, SEEK_SET);
+	$copt->{0} = $rh;
+	$do_curl->('-T-');
+
+	my @pr_err = slurp("$tmpdir/err.log");
+	is(scalar(grep(/app dispatch:/, @pr_err)), 2, 'app dispatched twice');
+
+	# abort a chunked request by blocking curl on a FIFO:
+	$c = tcp_start($srv, "PUT / HTTP/1.1\r\nTransfer-Encoding: chunked");
+	close $c;
+	@pr_err = slurp("$tmpdir/err.log");
+	is(scalar(grep(/app dispatch:/, @pr_err)), 2,
+			'app did not dispatch on aborted request');
+	undef $pri;
+	check_stderr;
+	diag 'Unicorn::PrereadInput middleware tests done';
+}
 
 # ... more stuff here
 
diff --git a/t/lib.perl b/t/lib.perl
index 1d6e78d..b6148cf 100644
--- a/t/lib.perl
+++ b/t/lib.perl
@@ -79,7 +79,7 @@ sub tcp_start ($@) {
 
 sub slurp {
 	open my $fh, '<', $_[0];
-	local $/;
+	local $/ if !wantarray;
 	readline($fh);
 }
 
diff --git a/t/preread_input.ru b/t/preread_input.ru
index 79685c4..f0a1748 100644
--- a/t/preread_input.ru
+++ b/t/preread_input.ru
@@ -1,8 +1,6 @@
 #\-E none
 require 'digest/sha1'
 require 'unicorn/preread_input'
-use Rack::ContentLength
-use Rack::ContentType, "text/plain"
 use Unicorn::PrereadInput
 nr = 0
 run lambda { |env|
@@ -13,5 +11,5 @@
     dig.update(buf)
   end
 
-  [ 200, {}, [ "#{dig.hexdigest}\n" ] ]
+  [ 200, {}, [ dig.hexdigest ] ]
 }
diff --git a/t/t9000-preread-input.sh b/t/t9000-preread-input.sh
deleted file mode 100755
index d6c73ab..0000000
--- a/t/t9000-preread-input.sh
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/bin/sh
-. ./test-lib.sh
-t_plan 9 "PrereadInput middleware tests"
-
-t_begin "setup and start" && {
-	random_blob_sha1=$(rsha1 < random_blob)
-	unicorn_setup
-	unicorn  -D -c $unicorn_config preread_input.ru
-	unicorn_wait_start
-}
-
-t_begin "single identity request" && {
-	curl -sSf -T random_blob http://$listen/ > $tmp
-}
-
-t_begin "sha1 matches" && {
-	test x"$(cat $tmp)" = x"$random_blob_sha1"
-}
-
-t_begin "single chunked request" && {
-	curl -sSf -T- < random_blob http://$listen/ > $tmp
-}
-
-t_begin "sha1 matches" && {
-	test x"$(cat $tmp)" = x"$random_blob_sha1"
-}
-
-t_begin "app only dispatched twice" && {
-	test 2 -eq "$(grep 'app dispatch:' < $r_err | count_lines )"
-}
-
-t_begin "aborted chunked request" && {
-	rm -f $tmp
-	curl -sSf -T- < $fifo http://$listen/ > $tmp &
-	curl_pid=$!
-	kill -9 $curl_pid
-	wait
-}
-
-t_begin "app only dispatched twice" && {
-	test 2 -eq "$(grep 'app dispatch:' < $r_err | count_lines )"
-}
-
-t_begin "killing succeeds" && {
-	kill -QUIT $unicorn_pid
-}
-
-t_done