From 724fb631c76f09964ec289ee8e144886ba15d380 Mon Sep 17 00:00:00 2001
From: Eric Wong <BOFH@YHBT.net>
Date: Mon, 6 Nov 2023 05:45:29 +0000
Subject: [PATCH 2/4] 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.
---
 t/back-out-of-upgrade.t        |  44 +++++++++++++
 t/lib.perl                     |  67 +++++++++++++++++---
 t/t0008-back_out_of_upgrade.sh | 110 ---------------------------------
 3 files changed, 102 insertions(+), 119 deletions(-)
 create mode 100644 t/back-out-of-upgrade.t
 delete mode 100755 t/t0008-back_out_of_upgrade.sh

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