switch unit/test_response.rb to Perl 5 integration test

http_response_write may benefit from API changes for Rack 3
support.

Since there's no benefit I can see from using a unit test,
switch to an integration test to avoid having to maintain the
unit test if our internal http_response_write method changes.

Of course, I can't trust tests written in Ruby since I've had to
put up with a constant stream of incompatibilities over the past
two decades :<   Perl is more widely installed than socat[1], and
nearly all the Perl I wrote 20 years ago still works
unmodified today.

[1] the rarest dependency of the Bourne shell integration tests

6 files changed, 313 insertions, 118 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 0e08ef0..5cca189 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -86,7 +86,7 @@ $(tmp_bin)/%: bin/% | $(tmp_bin)
 bins: $(tmp_bins)
 
 t_log := $(T_log) $(T_n_log)
-test: $(T) $(T_n)
+test: $(T) $(T_n) test-prove
         @cat $(t_log) | $(MRI) test/aggregate.rb
         @$(RM) $(t_log)
 
@@ -141,6 +141,9 @@ t/random_blob:
 
 test-integration: $(T_sh)
 
+test-prove:
+        prove -vw
+
 check: test-require test test-integration
 test-all: check
 
diff --git a/t/README b/t/README
index 14de559..8a5243e 100644
--- a/t/README
+++ b/t/README
@@ -5,16 +5,24 @@ TCP ports or Unix domain sockets.  They're all designed to run
 concurrently with other tests to minimize test time, but tests may be
 run independently as well.
 
-We write our tests in Bourne shell because that's what we're
-comfortable writing integration tests with.
+New tests are written in Perl 5 because we need a stable language
+to test real-world behavior and Ruby introduces incompatibilities
+at a far faster rate than Perl 5.  Perl is Ruby's older cousin, so
+it should be easy-to-learn for Rubyists.
+
+Old tests are in Bourne shell, but the socat(1) dependency was probably
+too rare compared to Perl 5.
 
 == Requirements
 
-* {Ruby 2.0.0+}[https://www.ruby-lang.org/en/] (duh!)
+* {Ruby 2.0.0+}[https://www.ruby-lang.org/en/]
+* {Perl 5.14+}[https://www.perl.org/] # your distro should have it
 * {GNU make}[https://www.gnu.org/software/make/]
+
+The following requirements will eventually be dropped.
+
 * {socat}[http://www.dest-unreach.org/socat/]
 * {curl}[https://curl.haxx.se/]
-* standard UNIX shell utilities (Bourne sh, awk, sed, grep, ...)
 
 We do not use bashisms or any non-portable, non-POSIX constructs
 in our shell code.  We use the "pipefail" option if available and
@@ -26,9 +34,13 @@ with {dash}[http://gondor.apana.org.au/~herbert/dash/] and
 
 To run the entire test suite with 8 tests running at once:
 
-  make -j8
+  make -j8 && prove -vw
+
+To run one individual test (Perl5):
+
+  prove -vw t/integration.t
 
-To run one individual test:
+To run one individual test (shell):
 
   make t0000-simple-http.sh
 
diff --git a/t/integration.ru b/t/integration.ru
new file mode 100644
index 0000000..6ef873c
--- /dev/null
+++ b/t/integration.ru
@@ -0,0 +1,38 @@
+#!ruby
+# Copyright (C) unicorn hackers <unicorn-public@80x24.org>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+
+# this goes for t/integration.t  We'll try to put as many tests
+# in here as possible to avoid startup overhead of Ruby.
+
+$orig_rack_200 = nil
+def tweak_status_code
+  $orig_rack_200 = Rack::Utils::HTTP_STATUS_CODES[200]
+  Rack::Utils::HTTP_STATUS_CODES[200] = "HI"
+  [ 200, {}, [] ]
+end
+
+def restore_status_code
+  $orig_rack_200 or return [ 500, {}, [] ]
+  Rack::Utils::HTTP_STATUS_CODES[200] = $orig_rack_200
+  [ 200, {}, [] ]
+end
+
+run(lambda do |env|
+  case env['REQUEST_METHOD']
+  when 'GET'
+    case env['PATH_INFO']
+    when '/rack-2-newline-headers'; [ 200, { 'X-R2' => "a\nb\nc" }, [] ]
+    when '/nil-header-value'; [ 200, { 'X-Nil' => nil }, [] ]
+    when '/unknown-status-pass-through'; [ '666 I AM THE BEAST', {}, [] ]
+    end # case PATH_INFO (GET)
+  when 'POST'
+    case env['PATH_INFO']
+    when '/tweak-status-code'; tweak_status_code
+    when '/restore-status-code'; restore_status_code
+    end # case PATH_INFO (POST)
+    # ...
+  when 'PUT'
+    # ...
+  end # case REQUEST_METHOD
+end) # run
diff --git a/t/integration.t b/t/integration.t
new file mode 100644
index 0000000..5569155
--- /dev/null
+++ b/t/integration.t
@@ -0,0 +1,64 @@
+#!perl -w
+# Copyright (C) unicorn hackers <unicorn-public@yhbt.net>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+
+use v5.14; BEGIN { require './t/lib.perl' };
+my $srv = tcp_server();
+my $t0 = time;
+my $ar = unicorn(qw(-E none t/integration.ru), { 3 => $srv });
+
+sub slurp_hdr {
+        my ($c) = @_;
+        local $/ = "\r\n\r\n"; # affects both readline+chomp
+        chomp(my $hdr = readline($c));
+        my ($status, @hdr) = split(/\r\n/, $hdr);
+        diag explain([ $status, \@hdr ]) if $ENV{V};
+        ($status, \@hdr);
+}
+
+my ($c, $status, $hdr);
+
+# response header tests
+$c = tcp_connect($srv);
+print $c "GET /rack-2-newline-headers HTTP/1.0\r\n\r\n" or die $!;
+($status, $hdr) = slurp_hdr($c);
+like($status, qr!\AHTTP/1\.[01] 200\b!, 'status line valid');
+my $orig_200_status = $status;
+is_deeply([ grep(/^X-R2: /, @$hdr) ],
+        [ 'X-R2: a', 'X-R2: b', 'X-R2: c' ],
+        'rack 2 LF-delimited headers supported') or diag(explain($hdr));
+
+SKIP: { # Date header check
+        my @d = grep(/^Date: /i, @$hdr);
+        is(scalar(@d), 1, 'got one date header') or diag(explain(\@d));
+        eval { require HTTP::Date } or skip "HTTP::Date missing: $@", 1;
+        $d[0] =~ s/^Date: //i or die 'BUG: did not strip date: prefix';
+        my $t = HTTP::Date::str2time($d[0]);
+        ok($t >= $t0 && $t > 0 && $t <= time, 'valid date') or
+                diag(explain([$t, $!, \@d]));
+};
+
+# cf. <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
+$c = tcp_connect($srv);
+print $c "GET /nil-header-value HTTP/1.0\r\n\r\n" or die $!;
+($status, $hdr) = slurp_hdr($c);
+is_deeply([grep(/^X-Nil:/, @$hdr)], ['X-Nil: '],
+        'nil header value accepted for broken apps') or diag(explain($hdr));
+
+if ('TODO: ensure Rack::Utils::HTTP_STATUS_CODES is available') {
+        $c = tcp_connect($srv);
+        print $c "POST /tweak-status-code HTTP/1.0\r\n\r\n" or die $!;
+        ($status, $hdr) = slurp_hdr($c);
+        like($status, qr!\AHTTP/1\.[01] 200 HI\b!, 'status tweaked');
+
+        $c = tcp_connect($srv);
+        print $c "POST /restore-status-code HTTP/1.0\r\n\r\n" or die $!;
+        ($status, $hdr) = slurp_hdr($c);
+        is($status, $orig_200_status, 'original status restored');
+}
+
+
+# ... more stuff here
+undef $ar;
+diag slurp("$tmpdir/err.log") if $ENV{V};
+done_testing;
diff --git a/t/lib.perl b/t/lib.perl
new file mode 100644
index 0000000..dd9c6b7
--- /dev/null
+++ b/t/lib.perl
@@ -0,0 +1,189 @@
+#!perl -w
+# Copyright (C) unicorn hackers <unicorn-public@80x24.org>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+package UnicornTest;
+use v5.14;
+use parent qw(Exporter);
+use Test::More;
+use IO::Socket::INET;
+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);
+
+my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
+$tmpdir = File::Temp->newdir("unicorn-$base-XXXX", TMPDIR => 1);
+open($errfh, '>>', "$tmpdir/err.log") or die "open: $!";
+
+sub tcp_server {
+        my %opt = (
+                ReuseAddr => 1,
+                Proto => 'tcp',
+                Type => SOCK_STREAM,
+                Listen => SOMAXCONN,
+                Blocking => 0,
+                @_,
+        );
+        eval {
+                die 'IPv4-only' if $ENV{TEST_IPV4_ONLY};
+                require IO::Socket::INET6;
+                IO::Socket::INET6->new(%opt, LocalAddr => '[::1]')
+        } || eval {
+                die 'IPv6-only' if $ENV{TEST_IPV6_ONLY};
+                IO::Socket::INET->new(%opt, LocalAddr => '127.0.0.1')
+        } || BAIL_OUT "failed to create TCP server: $! ($@)";
+}
+
+sub tcp_host_port {
+        my ($s) = @_;
+        my ($h, $p) = ($s->sockhost, $s->sockport);
+        my $ipv4 = $s->sockdomain == AF_INET;
+        if (wantarray) {
+                $ipv4 ? ($h, $p) : ("[$h]", $p);
+        } else {
+                $ipv4 ? "$h:$p" : "[$h]:$p";
+        }
+}
+
+sub tcp_connect {
+        my ($dest, %opt) = @_;
+        my $addr = tcp_host_port($dest);
+        my $s = ref($dest)->new(
+                Proto => 'tcp',
+                Type => SOCK_STREAM,
+                PeerAddr => $addr,
+                %opt,
+        ) or BAIL_OUT "failed to connect to $addr: $!";
+        $s->autoflush(1);
+        $s;
+}
+
+sub slurp {
+        open my $fh, '<', $_[0] or die "open($_[0]): $!";
+        local $/;
+        <$fh>;
+}
+
+sub spawn {
+        my $env = ref($_[0]) eq 'HASH' ? shift : undef;
+        my $opt = ref($_[-1]) eq 'HASH' ? pop : {};
+        my @cmd = @_;
+        my $old = POSIX::SigSet->new;
+        my $set = POSIX::SigSet->new;
+        $set->fillset or die "sigfillset: $!";
+        sigprocmask(SIG_SETMASK, $set, $old) or die "SIG_SETMASK: $!";
+        pipe(my ($r, $w)) or die "pipe: $!";
+        my $pid = fork // die "fork: $!";
+        if ($pid == 0) {
+                close $r;
+                $SIG{__DIE__} = sub {
+                        warn(@_);
+                        syswrite($w, my $num = $! + 0);
+                        _exit(1);
+                };
+
+                # pretend to be systemd (cf. sd_listen_fds(3))
+                my $cfd;
+                for ($cfd = 0; ($cfd < 3) || defined($opt->{$cfd}); $cfd++) {
+                        my $io = $opt->{$cfd} // next;
+                        my $pfd = fileno($io) // die "fileno($io): $!";
+                        if ($pfd == $cfd) {
+                                fcntl($io, F_SETFD, 0) // die "F_SETFD: $!";
+                        } else {
+                                dup2($pfd, $cfd) // die "dup2($pfd, $cfd): $!";
+                        }
+                }
+                if (($cfd - 3) > 0) {
+                        $env->{LISTEN_PID} = $$;
+                        $env->{LISTEN_FDS} = $cfd - 3;
+                }
+
+                if (defined(my $pgid = $opt->{pgid})) {
+                        setpgid(0, $pgid) // die "setpgid(0, $pgid): $!";
+                }
+                $SIG{$_} = 'DEFAULT' for grep(!/^__/, keys %SIG);
+                if (defined(my $cd = $opt->{-C})) {
+                        chdir $cd // die "chdir($cd): $!";
+                }
+                $old->delset(POSIX::SIGCHLD) or die "sigdelset CHLD: $!";
+                sigprocmask(SIG_SETMASK, $old) or die "SIG_SETMASK: ~CHLD: $!";
+                @ENV{keys %$env} = values(%$env) if $env;
+                exec { $cmd[0] } @cmd;
+                die "exec @cmd: $!";
+        }
+        close $w;
+        sigprocmask(SIG_SETMASK, $old) or die "SIG_SETMASK(old): $!";
+        if (my $cerrnum = do { local $/, <$r> }) {
+                $! = $cerrnum;
+                die "@cmd PID=$pid died: $!";
+        }
+        $pid;
+}
+
+sub which {
+        my ($file) = @_;
+        return $file if index($file, '/') >= 0;
+        for my $p (split(/:/, $ENV{PATH})) {
+                $p .= "/$file";
+                return $p if -x $p;
+        }
+        undef;
+}
+
+# returns an AutoReap object
+sub unicorn {
+        my %env;
+        if (ref($_[0]) eq 'HASH') {
+                my $e = shift;
+                %env = %$e;
+        }
+        my @args = @_;
+        push(@args, {}) if ref($args[-1]) ne 'HASH';
+        $args[-1]->{2} //= $errfh; # stderr default
+
+        state $ruby = which($ENV{RUBY} // 'ruby');
+        state $lib = File::Spec->rel2abs('lib');
+        state $ver = $ENV{TEST_RUBY_VERSION} // `$ruby -e 'print RUBY_VERSION'`;
+        state $eng = $ENV{TEST_RUBY_ENGINE} // `$ruby -e 'print RUBY_ENGINE'`;
+        state $ext = File::Spec->rel2abs("test/$eng-$ver/ext/unicorn_http");
+        state $exe = File::Spec->rel2abs('bin/unicorn');
+        my $pid = spawn(\%env, $ruby, '-I', $lib, '-I', $ext, $exe, @args);
+        UnicornTest::AutoReap->new($pid);
+}
+
+# automatically kill + reap children when this goes out-of-scope
+package UnicornTest::AutoReap;
+use v5.14;
+
+sub new {
+        my (undef, $pid) = @_;
+        bless { pid => $pid, owner => $$ }, __PACKAGE__
+}
+
+sub kill {
+        my ($self, $sig) = @_;
+        CORE::kill($sig // 'TERM', $self->{pid});
+}
+
+sub join {
+        my ($self, $sig) = @_;
+        my $pid = delete $self->{pid} or return;
+        CORE::kill($sig, $pid) if defined $sig;
+        my $ret = waitpid($pid, 0) // die "waitpid($pid): $!";
+        $ret == $pid or die "BUG: waitpid($pid) != $ret";
+}
+
+sub DESTROY {
+        my ($self) = @_;
+        return if $self->{owner} != $$;
+        $self->join('TERM');
+}
+
+package main; # inject ourselves into the t/*.t script
+UnicornTest->import;
+Test::More->import;
+# try to ensure ->DESTROY fires:
+$SIG{TERM} = sub { exit(15 + 128) };
+$SIG{INT} = sub { exit(2 + 128) };
+1;
diff --git a/test/unit/test_response.rb b/test/unit/test_response.rb
deleted file mode 100644
index fbe433f..0000000
--- a/test/unit/test_response.rb
+++ /dev/null
@@ -1,111 +0,0 @@
-# -*- encoding: binary -*-
-
-# Copyright (c) 2005 Zed A. Shaw
-# You can redistribute it and/or modify it under the same terms as Ruby 1.8 or
-# the GPLv2+ (GPLv3+ preferred)
-#
-# Additional work donated by contributors.  See git history
-# for more information.
-
-require './test/test_helper'
-require 'time'
-
-include Unicorn
-
-class ResponseTest < Test::Unit::TestCase
-  include Unicorn::HttpResponse
-
-  def test_httpdate
-    before = Time.now.to_i - 1
-    str = httpdate
-    assert_kind_of(String, str)
-    middle = Time.parse(str).to_i
-    after = Time.now.to_i
-    assert before <= middle
-    assert middle <= after
-  end
-
-  def test_response_headers
-    out = StringIO.new
-    http_response_write(out, 200, {"X-Whatever" => "stuff"}, ["cool"])
-    assert ! out.closed?
-
-    assert out.length > 0, "output didn't have data"
-  end
-
-  # ref: <CAO47=rJa=zRcLn_Xm4v2cHPr6c0UswaFC_omYFEH+baSxHOWKQ@mail.gmail.com>
-  def test_response_header_broken_nil
-    out = StringIO.new
-    http_response_write(out, 200, {"Nil" => nil}, %w(hysterical raisin))
-    assert ! out.closed?
-
-    assert_match %r{^Nil: \r\n}sm, out.string, 'nil accepted'
-  end
-
-  def test_response_string_status
-    out = StringIO.new
-    http_response_write(out,'200', {}, [])
-    assert ! out.closed?
-    assert out.length > 0, "output didn't have data"
-  end
-
-  def test_response_200
-    io = StringIO.new
-    http_response_write(io, 200, {}, [])
-    assert ! io.closed?
-    assert io.length > 0, "output didn't have data"
-  end
-
-  def test_response_with_default_reason
-    code = 400
-    io = StringIO.new
-    http_response_write(io, code, {}, [])
-    assert ! io.closed?
-    lines = io.string.split(/\r\n/)
-    assert_match(/.* Bad Request$/, lines.first,
-                 "wrong default reason phrase")
-  end
-
-  def test_rack_multivalue_headers
-    out = StringIO.new
-    http_response_write(out,200, {"X-Whatever" => "stuff\nbleh"}, [])
-    assert ! out.closed?
-    assert_match(/^X-Whatever: stuff\r\nX-Whatever: bleh\r\n/, out.string)
-  end
-
-  # Even though Rack explicitly forbids "Status" in the header hash,
-  # some broken clients still rely on it
-  def test_status_header_added
-    out = StringIO.new
-    http_response_write(out,200, {"X-Whatever" => "stuff"}, [])
-    assert ! out.closed?
-  end
-
-  def test_unknown_status_pass_through
-    out = StringIO.new
-    http_response_write(out,"666 I AM THE BEAST", {}, [] )
-    assert ! out.closed?
-    headers = out.string.split(/\r\n\r\n/).first.split(/\r\n/)
-    assert %r{\AHTTP/\d\.\d 666 I AM THE BEAST\z}.match(headers[0])
-  end
-
-  def test_modified_rack_http_status_codes_late
-    r, w = IO.pipe
-    pid = fork do
-      r.close
-      # Users may want to globally override the status text associated
-      # with an HTTP status code in their app.
-      Rack::Utils::HTTP_STATUS_CODES[200] = "HI"
-      http_response_write(w, 200, {}, [])
-      w.close
-    end
-    w.close
-    assert_equal "HTTP/1.1 200 HI\r\n", r.gets
-    r.read # just drain the pipe
-    pid, status = Process.waitpid2(pid)
-    assert status.success?, status.inspect
-  ensure
-    r.close
-    w.close unless w.closed?
-  end
-end