port t0100-rack-input-tests.sh to Perl 5

Yet another socat dependency gone \o/

6 files changed, 124 insertions, 184 deletions

diff --git a/t/bin/content-md5-put b/t/bin/content-md5-put
deleted file mode 100755
index 01da0bb..0000000
--- a/t/bin/content-md5-put
+++ /dev/null
@@ -1,36 +0,0 @@
-#!/usr/bin/env ruby
-# -*- encoding: binary -*-
-# simple chunked HTTP PUT request generator (and just that),
-# it reads stdin and writes to stdout so socat can write to a
-# UNIX or TCP socket (or to another filter or file) along with
-# a Content-MD5 trailer.
-require 'digest/md5'
-$stdout.sync = $stderr.sync = true
-$stdout.binmode
-$stdin.binmode
-
-bs = ENV['bs'] ? ENV['bs'].to_i : 4096
-
-if ARGV.grep("--no-headers").empty?
-  $stdout.write(
-      "PUT / HTTP/1.1\r\n" \
-      "Host: example.com\r\n" \
-      "Transfer-Encoding: chunked\r\n" \
-      "Trailer: Content-MD5\r\n" \
-      "\r\n"
-    )
-end
-
-digest = Digest::MD5.new
-if buf = $stdin.readpartial(bs)
-  begin
-    digest.update(buf)
-    $stdout.write("%x\r\n" % [ buf.size ])
-    $stdout.write(buf)
-    $stdout.write("\r\n")
-  end while $stdin.read(bs, buf)
-end
-
-digest = [ digest.digest ].pack('m').strip
-$stdout.write("0\r\n")
-$stdout.write("Content-MD5: #{digest}\r\n\r\n")
diff --git a/t/integration.ru b/t/integration.ru
index 21f5449..98528f6 100644
--- a/t/integration.ru
+++ b/t/integration.ru
@@ -47,6 +47,29 @@ def env_dump(env)
   h.to_json
 end
 
+def rack_input_tests(env)
+  return [ 100, {}, [] ] if /\A100-continue\z/i =~ env['HTTP_EXPECT']
+  cap = 16384
+  require 'digest/sha1'
+  digest = Digest::SHA1.new
+  input = env['rack.input']
+  case env['PATH_INFO']
+  when '/rack_input/size_first'; input.size
+  when '/rack_input/rewind_first'; input.rewind
+  when '/rack_input'; # OK
+  else
+    abort "bad path: #{env['PATH_INFO']}"
+  end
+  if buf = input.read(rand(cap))
+    begin
+      raise "#{buf.size} > #{cap}" if buf.size > cap
+      digest.update(buf)
+    end while input.read(rand(cap), buf)
+  end
+  [ 200, {'content-length' => '40', 'content-type' => 'text/plain'},
+    [ digest.hexdigest ] ]
+end
+
 run(lambda do |env|
   case env['REQUEST_METHOD']
   when 'GET'
@@ -66,6 +89,8 @@ run(lambda do |env|
     end # case PATH_INFO (POST)
     # ...
   when 'PUT'
-    # ...
+    case env['PATH_INFO']
+    when %r{\A/rack_input}; rack_input_tests(env)
+    end
   end # case REQUEST_METHOD
 end) # run
diff --git a/t/integration.t b/t/integration.t
index b7ba1fb..8cef561 100644
--- a/t/integration.t
+++ b/t/integration.t
@@ -1,13 +1,16 @@
 #!perl -w
 # Copyright (C) unicorn hackers <unicorn-public@yhbt.net>
 # License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+# this is the main integration test for things which don't require
+# restarting or signals
 
 use v5.14; BEGIN { require './t/lib.perl' };
 my $srv = tcp_server();
 my $host_port = tcp_host_port($srv);
 my $t0 = time;
 my $ar = unicorn(qw(-E none t/integration.ru), { 3 => $srv });
-
+my $curl = which('curl');
+END { diag slurp("$tmpdir/err.log") if $tmpdir };
 sub slurp_hdr {
         my ($c) = @_;
         local $/ = "\r\n\r\n"; # affects both readline+chomp
@@ -17,6 +20,48 @@ sub slurp_hdr {
         ($status, \@hdr);
 }
 
+my %PUT = (
+        chunked_md5 => sub {
+                my ($in, $out, $path, %opt) = @_;
+                my $bs = $opt{bs} // 16384;
+                require Digest::MD5;
+                my $dig = Digest::MD5->new;
+                print $out <<EOM;
+PUT $path HTTP/1.1\r
+Transfer-Encoding: chunked\r
+Trailer: Content-MD5\r
+\r
+EOM
+                my ($buf, $r);
+                while (1) {
+                        $r = read($in, $buf, $bs) // die "read: $!";
+                        last if $r == 0;
+                        printf $out "%x\r\n", length($buf);
+                        print $out $buf, "\r\n";
+                        $dig->add($buf);
+                }
+                print $out "0\r\nContent-MD5: ", $dig->b64digest, "\r\n\r\n";
+        },
+        identity => sub {
+                my ($in, $out, $path, %opt) = @_;
+                my $bs = $opt{bs} // 16384;
+                my $clen = $opt{-s} // -s $in;
+                print $out <<EOM;
+PUT $path HTTP/1.0\r
+Content-Length: $clen\r
+\r
+EOM
+                my ($buf, $r, $len);
+                while ($clen) {
+                        $len = $clen > $bs ? $bs : $clen;
+                        $r = read($in, $buf, $len) // die "read: $!";
+                        die 'premature EOF' if $r == 0;
+                        print $out $buf;
+                        $clen -= $r;
+                }
+        },
+);
+
 my ($c, $status, $hdr);
 
 # response header tests
@@ -111,6 +156,55 @@ if ('bad requests') {
         like($status, qr!\AHTTP/1\.[01] 414 \b!, '414 on FRAGMENT > (1024)');
 }
 
+# input tests
+my ($blob_size, $blob_hash);
+SKIP: {
+        open(my $rh, '<', 't/random_blob') or
+                skip "t/random_blob not generated $!", 1;
+        $blob_size = -s $rh;
+        require Digest::SHA;
+        $blob_hash = Digest::SHA->new(1)->addfile($rh)->hexdigest;
+
+        my $ck_hash = sub {
+                my ($sub, $path, %opt) = @_;
+                seek($rh, 0, SEEK_SET) // die "seek: $!";
+                $c = tcp_connect($srv);
+                $c->autoflush(0);
+                $PUT{$sub}->($rh, $c, $path, %opt);
+                $c->flush or die "flush: $!";
+                ($status, $hdr) = slurp_hdr($c);
+                is(readline($c), $blob_hash, "$sub $path");
+        };
+        $ck_hash->('identity', '/rack_input', -s => $blob_size);
+        $ck_hash->('chunked_md5', '/rack_input');
+        $ck_hash->('identity', '/rack_input/size_first', -s => $blob_size);
+        $ck_hash->('identity', '/rack_input/rewind_first', -s => $blob_size);
+        $ck_hash->('chunked_md5', '/rack_input/size_first');
+        $ck_hash->('chunked_md5', '/rack_input/rewind_first');
+
+
+        $curl // skip 'no curl found in PATH', 1;
+
+        my ($copt, $cout);
+        my $url = "http://$host_port/rack_input";
+        my $do_curl = sub {
+                my (@arg) = @_;
+                pipe(my $cout, $copt->{1}) or die "pipe: $!";
+                open $copt->{2}, '>', "$tmpdir/curl.err" or die $!;
+                my $cpid = spawn($curl, '-sSf', @arg, $url, $copt);
+                close(delete $copt->{1}) or die "close: $!";
+                is(readline($cout), $blob_hash, "curl @arg response");
+                is(waitpid($cpid, 0), $cpid, "curl @arg exited");
+                is($?, 0, "no error from curl @arg");
+                is(slurp("$tmpdir/curl.err"), '', "no stderr from curl @arg");
+        };
+
+        $do_curl->(qw(-T t/random_blob));
+
+        seek($rh, 0, SEEK_SET) // die "seek: $!";
+        $copt->{0} = $rh;
+        $do_curl->('-T-');
+}
 
 # ... more stuff here
 undef $ar;
@@ -120,4 +214,5 @@ my @err = grep(!/NameError.*Unicorn::Waiter/, grep(/error/i, @log));
 is_deeply(\@err, [], 'no unexpected errors in stderr');
 is_deeply([grep(/SIGKILL/, @log)], [], 'no SIGKILL in stderr');
 
+undef $tmpdir;
 done_testing;
diff --git a/t/lib.perl b/t/lib.perl
index 7d712b5..ae9f197 100644
--- a/t/lib.perl
+++ b/t/lib.perl
@@ -10,7 +10,7 @@ use POSIX qw(dup2 _exit setpgid :signal_h SEEK_SET F_SETFD);
 use File::Temp 0.19 (); # 0.19 for ->newdir
 our ($tmpdir, $errfh);
 our @EXPORT = qw(unicorn slurp tcp_server tcp_connect unicorn $tmpdir $errfh
-        SEEK_SET tcp_host_port start_req);
+        SEEK_SET tcp_host_port start_req which spawn);
 
 my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
 $tmpdir = File::Temp->newdir("unicorn-$base-XXXX", TMPDIR => 1);
@@ -193,4 +193,5 @@ Test::More->import;
 # try to ensure ->DESTROY fires:
 $SIG{TERM} = sub { exit(15 + 128) };
 $SIG{INT} = sub { exit(2 + 128) };
+$SIG{PIPE} = sub { exit(13 + 128) };
 1;
diff --git a/t/rack-input-tests.ru b/t/rack-input-tests.ru
deleted file mode 100644
index 5459e85..0000000
--- a/t/rack-input-tests.ru
+++ /dev/null
@@ -1,21 +0,0 @@
-# SHA1 checksum generator
-require 'digest/sha1'
-use Rack::ContentLength
-cap = 16384
-app = lambda do |env|
-  /\A100-continue\z/i =~ env['HTTP_EXPECT'] and
-    return [ 100, {}, [] ]
-  digest = Digest::SHA1.new
-  input = env['rack.input']
-  input.size if env["PATH_INFO"] == "/size_first"
-  input.rewind if env["PATH_INFO"] == "/rewind_first"
-  if buf = input.read(rand(cap))
-    begin
-      raise "#{buf.size} > #{cap}" if buf.size > cap
-      digest.update(buf)
-    end while input.read(rand(cap), buf)
-  end
-
-  [ 200, {'content-type' => 'text/plain'}, [ digest.hexdigest << "\n" ] ]
-end
-run app
diff --git a/t/t0100-rack-input-tests.sh b/t/t0100-rack-input-tests.sh
deleted file mode 100755
index ee7a437..0000000
--- a/t/t0100-rack-input-tests.sh
+++ /dev/null
@@ -1,124 +0,0 @@
-#!/bin/sh
-. ./test-lib.sh
-test -r random_blob || die "random_blob required, run with 'make $0'"
-
-t_plan 10 "rack.input read tests"
-
-t_begin "setup and startup" && {
-        rtmpfiles curl_out curl_err
-        unicorn_setup
-        unicorn -E none -D rack-input-tests.ru -c $unicorn_config
-        blob_sha1=$(rsha1 < random_blob)
-        blob_size=$(count_bytes < random_blob)
-        t_info "blob_sha1=$blob_sha1"
-        unicorn_wait_start
-}
-
-t_begin "corked identity request" && {
-        rm -f $tmp
-        (
-                cat $fifo > $tmp &
-                printf 'PUT / HTTP/1.0\r\n'
-                printf 'Content-Length: %d\r\n\r\n' $blob_size
-                cat random_blob
-                wait
-                echo ok > $ok
-        ) | ( sleep 1 && socat - TCP4:$listen > $fifo )
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test x"$(cat $ok)" = xok
-}
-
-t_begin "corked chunked request" && {
-        rm -f $tmp
-        (
-                cat $fifo > $tmp &
-                content-md5-put < random_blob
-                wait
-                echo ok > $ok
-        ) | ( sleep 1 && socat - TCP4:$listen > $fifo )
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test x"$(cat $ok)" = xok
-}
-
-t_begin "corked identity request (input#size first)" && {
-        rm -f $tmp
-        (
-                cat $fifo > $tmp &
-                printf 'PUT /size_first HTTP/1.0\r\n'
-                printf 'Content-Length: %d\r\n\r\n' $blob_size
-                cat random_blob
-                wait
-                echo ok > $ok
-        ) | ( sleep 1 && socat - TCP4:$listen > $fifo )
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test x"$(cat $ok)" = xok
-}
-
-t_begin "corked identity request (input#rewind first)" && {
-        rm -f $tmp
-        (
-                cat $fifo > $tmp &
-                printf 'PUT /rewind_first HTTP/1.0\r\n'
-                printf 'Content-Length: %d\r\n\r\n' $blob_size
-                cat random_blob
-                wait
-                echo ok > $ok
-        ) | ( sleep 1 && socat - TCP4:$listen > $fifo )
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test x"$(cat $ok)" = xok
-}
-
-t_begin "corked chunked request (input#size first)" && {
-        rm -f $tmp
-        (
-                cat $fifo > $tmp &
-                printf 'PUT /size_first HTTP/1.1\r\n'
-                printf 'Host: example.com\r\n'
-                printf 'Transfer-Encoding: chunked\r\n'
-                printf 'Trailer: Content-MD5\r\n'
-                printf '\r\n'
-                content-md5-put --no-headers < random_blob
-                wait
-                echo ok > $ok
-        ) | ( sleep 1 && socat - TCP4:$listen > $fifo )
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test x"$(cat $ok)" = xok
-}
-
-t_begin "corked chunked request (input#rewind first)" && {
-        rm -f $tmp
-        (
-                cat $fifo > $tmp &
-                printf 'PUT /rewind_first HTTP/1.1\r\n'
-                printf 'Host: example.com\r\n'
-                printf 'Transfer-Encoding: chunked\r\n'
-                printf 'Trailer: Content-MD5\r\n'
-                printf '\r\n'
-                content-md5-put --no-headers < random_blob
-                wait
-                echo ok > $ok
-        ) | ( sleep 1 && socat - TCP4:$listen > $fifo )
-        test 1 -eq $(grep $blob_sha1 $tmp |count_lines)
-        test x"$(cat $ok)" = xok
-}
-
-t_begin "regular request" && {
-        curl -sSf -T random_blob http://$listen/ > $curl_out 2> $curl_err
-        test x$blob_sha1 = x$(cat $curl_out)
-        test ! -s $curl_err
-}
-
-t_begin "chunked request" && {
-        curl -sSf -T- < random_blob http://$listen/ > $curl_out 2> $curl_err
-        test x$blob_sha1 = x$(cat $curl_out)
-        test ! -s $curl_err
-}
-
-dbgcat r_err
-
-t_begin "shutdown" && {
-        kill $unicorn_pid
-}
-
-t_done