tests: port back-out-of-upgrade to Perl 5

Another place where we can be faster without adding more
dependencies on Ruby maintaining stable behavior.

3 files changed, 102 insertions, 119 deletions

diff --git a/t/back-out-of-upgrade.t b/t/back-out-of-upgrade.t
new file mode 100644
index 0000000..cf3b09f
--- /dev/null
+++ b/t/back-out-of-upgrade.t
@@ -0,0 +1,44 @@
+#!perl -w
+# Copyright (C) unicorn hackers <unicorn-public@yhbt.net>
+# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
+# test backing out of USR2 upgrade
+use v5.14; BEGIN { require './t/lib.perl' };
+use autodie;
+my $srv = tcp_server();
+mkfifo_die $fifo;
+write_file '>', $u_conf, <<EOM;
+preload_app true
+stderr_path "$err_log"
+pid "$pid_file"
+after_fork { |s,w| File.open('$fifo', 'w') { |fp| fp.write "pid=#\$\$" } }
+EOM
+my $ar = unicorn(qw(-E none t/pid.ru -c), $u_conf, { 3 => $srv });
+
+like(my $wpid_orig_1 = slurp($fifo), qr/\Apid=\d+\z/a, 'got worker pid');
+
+ok $ar->do_kill('USR2'), 'USR2 to start upgrade';
+ok $ar->do_kill('WINCH'), 'drop old worker';
+
+like(my $wpid_new = slurp($fifo), qr/\Apid=\d+\z/a, 'got pid from new master');
+chomp(my $new_pid = slurp($pid_file));
+isnt $new_pid, $ar->{pid}, 'PID file changed';
+chomp(my $pid_oldbin = slurp("$pid_file.oldbin"));
+is $pid_oldbin, $ar->{pid}, '.oldbin PID valid';
+
+ok $ar->do_kill('HUP'), 'HUP old master';
+like(my $wpid_orig_2 = slurp($fifo), qr/\Apid=\d+\z/a, 'got worker new pid');
+ok kill('QUIT', $new_pid), 'abort old master';
+kill_until_dead $new_pid;
+
+my ($st, $hdr, $req_pid) = do_req $srv, 'GET /';
+chomp $req_pid;
+is $wpid_orig_2, "pid=$req_pid", 'new worker on old worker serves';
+
+ok !-f "$pid_file.oldbin", '.oldbin PID file gone';
+chomp(my $old_pid = slurp($pid_file));
+is $old_pid, $ar->{pid}, 'PID file restored';
+
+my @log = grep !/ERROR -- : reaped .*? exec\(\)-ed/, slurp($err_log);
+check_stderr @log;
+undef $tmpdir;
+done_testing;
diff --git a/t/lib.perl b/t/lib.perl
index 9254b23..b20a2c6 100644
--- a/t/lib.perl
+++ b/t/lib.perl
@@ -6,30 +6,58 @@ use v5.14;
 use parent qw(Exporter);
 use autodie;
 use Test::More;
+use Socket qw(SOMAXCONN);
 use Time::HiRes qw(sleep time);
 use IO::Socket::INET;
+use IO::Socket::UNIX;
+use Carp qw(croak);
 use POSIX qw(dup2 _exit setpgid :signal_h SEEK_SET F_SETFD);
 use File::Temp 0.19 (); # 0.19 for ->newdir
 our ($tmpdir, $errfh, $err_log, $u_sock, $u_conf, $daemon_pid,
-        $pid_file);
+        $pid_file, $wtest_sock, $fifo);
 our @EXPORT = qw(unicorn slurp tcp_server tcp_start unicorn
         $tmpdir $errfh $err_log $u_sock $u_conf $daemon_pid $pid_file
+        $wtest_sock $fifo
         SEEK_SET tcp_host_port which spawn check_stderr unix_start slurp_hdr
-        do_req stop_daemon sleep time);
+        do_req stop_daemon sleep time mkfifo_die kill_until_dead write_file);
 
 my ($base) = ($0 =~ m!\b([^/]+)\.[^\.]+\z!);
 $tmpdir = File::Temp->newdir("unicorn-$base-XXXX", TMPDIR => 1);
+
+$wtest_sock = "$tmpdir/wtest.sock";
 $err_log = "$tmpdir/err.log";
 $pid_file = "$tmpdir/pid";
+$fifo = "$tmpdir/fifo";
 $u_sock = "$tmpdir/u.sock";
 $u_conf = "$tmpdir/u.conf.rb";
 open($errfh, '>>', $err_log);
 
+if (my $t = $ENV{TAIL}) {
+        my @tail = $t =~ /tail/ ? split(/\s+/, $t) : (qw(tail -F));
+        push @tail, $err_log;
+        my $pid = fork;
+        if ($pid == 0) {
+                open STDOUT, '>&', \*STDERR;
+                exec @tail;
+                die "exec(@tail): $!";
+        }
+        say "# @tail";
+        sleep 0.2;
+        UnicornTest::AutoReap->new($pid);
+}
+
+sub kill_until_dead ($;%) {
+        my ($pid, %opt) = @_;
+        my $tries = $opt{tries} // 1000;
+        my $sig = $opt{sig} // 0;
+        while (CORE::kill($sig, $pid) && --$tries) { sleep(0.01) }
+        $tries or croak "PID: $pid died after signal ($sig)";
+}
+
 sub stop_daemon (;$) {
         my ($is_END) = @_;
         kill('TERM', $daemon_pid);
-        my $tries = 1000;
-        while (CORE::kill(0, $daemon_pid) && --$tries) { sleep(0.01) }
+        kill_until_dead $daemon_pid;
         if ($is_END && CORE::kill(0, $daemon_pid)) { # after done_testing
                 CORE::kill('KILL', $daemon_pid);
                 die "daemon_pid=$daemon_pid did not die";
@@ -44,8 +72,9 @@ END {
         stop_daemon(1) if defined $daemon_pid;
 };
 
-sub check_stderr () {
-        my @log = slurp($err_log);
+sub check_stderr (@) {
+        my @log = @_;
+        slurp($err_log) if !@log;
         diag("@log") if $ENV{V};
         my @err = grep(!/NameError.*Unicorn::Waiter/, grep(/error/i, @log));
         @err = grep(!/failed to set accept_filter=/, @err);
@@ -63,6 +92,16 @@ sub slurp_hdr {
         ($status, \@hdr);
 }
 
+sub unix_server (;$@) {
+        my $l = shift // $u_sock;
+        IO::Socket::UNIX->new(Listen => SOMAXCONN, Local => $l, Blocking => 0,
+                                Type => SOCK_STREAM, @_);
+}
+
+sub unix_connect ($) {
+        IO::Socket::UNIX->new(Peer => $_[0], Type => SOCK_STREAM);
+}
+
 sub tcp_server {
         my %opt = (
                 ReuseAddr => 1,
@@ -95,8 +134,7 @@ sub tcp_host_port {
 
 sub unix_start ($@) {
         my ($dst, @req) = @_;
-        my $s = IO::Socket::UNIX->new(Peer => $dst, Type => SOCK_STREAM) or
-                BAIL_OUT "unix connect $dst: $!";
+        my $s = unix_connect($dst) or BAIL_OUT "unix connect $dst: $!";
         $s->autoflush(1);
         print $s @req, "\r\n\r\n" if @req;
         $s;
@@ -201,7 +239,7 @@ sub unicorn {
         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');
+        state $exe = File::Spec->rel2abs("test/$eng-$ver/bin/unicorn");
         my $pid = spawn(\%env, $ruby, '-I', $lib, '-I', $ext, $exe, @args);
         UnicornTest::AutoReap->new($pid);
 }
@@ -219,6 +257,17 @@ sub do_req ($@) {
         ($status, $hdr, $bdy);
 }
 
+sub mkfifo_die ($;$) {
+        POSIX::mkfifo($_[0], $_[1] // 0600) or croak "mkfifo: $!";
+}
+
+sub write_file ($$@) { # mode, filename, LIST (for print)
+        open(my $fh, shift, shift);
+        print $fh @_;
+        # return $fh for futher writes if user wants it:
+        defined(wantarray) && !wantarray ? $fh : close $fh;
+}
+
 # automatically kill + reap children when this goes out-of-scope
 package UnicornTest::AutoReap;
 use v5.14;
diff --git a/t/t0008-back_out_of_upgrade.sh b/t/t0008-back_out_of_upgrade.sh
deleted file mode 100755
index 96d4057..0000000
--- a/t/t0008-back_out_of_upgrade.sh
+++ /dev/null
@@ -1,110 +0,0 @@
-#!/bin/sh
-. ./test-lib.sh
-t_plan 13 "backout of USR2 upgrade"
-
-worker_wait_start () {
-        test xSTART = x"$(cat $fifo)"
-        unicorn_pid=$(cat $pid)
-}
-
-t_begin "setup and start" && {
-        unicorn_setup
-        rm -f $pid.oldbin
-
-cat >> $unicorn_config <<EOF
-after_fork do |server, worker|
-  # test script will block while reading from $fifo,
-  # so notify the script on the first worker we spawn
-  # by opening the FIFO
-  if worker.nr == 0
-    File.open("$fifo", "wb") { |fp| fp.syswrite "START" }
-  end
-end
-EOF
-        unicorn -D -c $unicorn_config pid.ru
-        worker_wait_start
-        orig_master_pid=$unicorn_pid
-}
-
-t_begin "read original worker pid" && {
-        orig_worker_pid=$(curl -sSf http://$listen/)
-        test -n "$orig_worker_pid" && kill -0 $orig_worker_pid
-}
-
-t_begin "upgrade to new master" && {
-        kill -USR2 $orig_master_pid
-}
-
-t_begin "kill old worker" && {
-        kill -WINCH $orig_master_pid
-}
-
-t_begin "wait for new worker to start" && {
-        worker_wait_start
-        test $unicorn_pid -ne $orig_master_pid
-        new_master_pid=$unicorn_pid
-}
-
-t_begin "old master pid is stashed in $pid.oldbin" && {
-        test -s "$pid.oldbin"
-        test $orig_master_pid -eq $(cat $pid.oldbin)
-}
-
-t_begin "ensure old worker is no longer running" && {
-        i=0
-        while kill -0 $orig_worker_pid 2>/dev/null
-        do
-                i=$(( $i + 1 ))
-                test $i -lt 600 || die "timed out"
-                sleep 1
-        done
-}
-
-t_begin "capture pid of new worker" && {
-        new_worker_pid=$(curl -sSf http://$listen/)
-}
-
-t_begin "reload old master process" && {
-        kill -HUP $orig_master_pid
-        worker_wait_start
-}
-
-t_begin "gracefully kill new master and ensure it dies" && {
-        kill -QUIT $new_master_pid
-        i=0
-        while kill -0 $new_worker_pid 2>/dev/null
-        do
-                i=$(( $i + 1 ))
-                test $i -lt 600 || die "timed out"
-                sleep 1
-        done
-}
-
-t_begin "ensure $pid.oldbin does not exist" && {
-        i=0
-        while test -s $pid.oldbin
-        do
-                i=$(( $i + 1 ))
-                test $i -lt 600 || die "timed out"
-                sleep 1
-        done
-        while ! test -s $pid
-        do
-                i=$(( $i + 1 ))
-                test $i -lt 600 || die "timed out"
-                sleep 1
-        done
-}
-
-t_begin "ensure $pid is correct" && {
-        cur_master_pid=$(cat $pid)
-        test $orig_master_pid -eq $cur_master_pid
-}
-
-t_begin "killing succeeds" && {
-        kill $orig_master_pid
-}
-
-dbgcat r_err
-
-t_done