From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <e@80x24.org>
X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on dcvr.yhbt.net
X-Spam-Level: 
X-Spam-ASN:  
X-Spam-Status: No, score=-4.2 required=3.0 tests=ALL_TRUSTED,BAYES_00,
	DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF shortcircuit=no
	autolearn=ham autolearn_force=no version=3.4.6
Received: from localhost (dcvr.yhbt.net [127.0.0.1])
	by dcvr.yhbt.net (Postfix) with ESMTP id D629E1F63E
	for <meta@public-inbox.org>; Sun, 29 Jan 2023 09:45:11 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=80x24.org;
	s=selector1; t=1674985511;
	bh=cFEEo565vG6RIXiD78pLCk/znznPKYkbWGLoBVf28/Y=;
	h=From:To:Subject:Date:From;
	b=i4kdtjD2zA0qWy6NRW4HI7vdC/7YN/Xm6QG2ETklHTF+RYDKreU0CW5si8m07OGc7
	 VkSgMQPca9ETkXdZZ5tvOwAEg5gwwUW3YG5hCSz0QK+GDAjYXy5P9ZR1ZZZ9W+v0Gh
	 u7GWpiWBEf7x6hnCo2b5vva4PiWBOqcp672IGauQ=
From: Eric Wong <e@80x24.org>
To: meta@public-inbox.org
Subject: [PATCH] spawn_pp: use `which()' properly for pure-Perl spawn
Date: Sun, 29 Jan 2023 09:45:11 +0000
Message-Id: <20230129094511.3218368-1-e@80x24.org>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
List-Id: <meta.public-inbox.org>

I have no idea if mod_perl/mod_perl2 is used nowadays, but
we're stuck supporting it as long as mod_perl exists.  So
add some tests and make minor updates to existing ones to
ensure it stays working.
---
 lib/PublicInbox/SpawnPP.pm |  5 ++++-
 t/spawn.t                  | 42 ++++++++++++++++++++++++++++++--------
 2 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/lib/PublicInbox/SpawnPP.pm b/lib/PublicInbox/SpawnPP.pm
index 7a5793f6..73859e9b 100644
--- a/lib/PublicInbox/SpawnPP.pm
+++ b/lib/PublicInbox/SpawnPP.pm
@@ -3,9 +3,11 @@
 
 # Pure-Perl implementation of "spawn".  This can't take advantage
 # of vfork, so no speedups under Linux for spawning from large processes.
+# Do not require this directly, only use from PublicInbox::Spawn
 package PublicInbox::SpawnPP;
 use v5.12;
 use POSIX qw(dup2 _exit setpgid :signal_h);
+use PublicInbox::Spawn qw(which);
 
 # Pure Perl implementation for folks that do not use Inline::C
 sub pi_fork_exec ($$$$$$$) {
@@ -46,7 +48,8 @@ sub pi_fork_exec ($$$$$$$) {
 		sigprocmask(SIG_SETMASK, $old) or die "SIG_SETMASK ~CHLD: $!";
 		$cmd->[0] = $f;
 		if ($ENV{MOD_PERL}) {
-			@$cmd = (which('env'), '-i', @$env, @$cmd);
+			$f = which('env');
+			@$cmd = ('env', '-i', @$env, @$cmd);
 		} else {
 			%ENV = map { split(/=/, $_, 2) } @$env;
 		}
diff --git a/t/spawn.t b/t/spawn.t
index c22cfcfc..ff95ae8e 100644
--- a/t/spawn.t
+++ b/t/spawn.t
@@ -1,10 +1,11 @@
-# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org>
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-use strict;
-use warnings;
+use v5.12;
 use Test::More;
 use PublicInbox::Spawn qw(which spawn popen_rd);
-use PublicInbox::Sigfd;
+require PublicInbox::Sigfd;
+require PublicInbox::DS;
 
 {
 	my $true = which('true');
@@ -38,9 +39,8 @@ SKIP: {
 	$pid = eval { spawn(['true'], undef, { pgid => $wrong_pgid, 2 => $w }) };
 	close $w;
 	my $err = do { local $/; <$r> };
-	# diag "$err ($@)";
 	if (defined $pid) {
-		waitpid($pid, 0) if defined $pid;
+		waitpid($pid, 0);
 		isnt($?, 0, 'child error (pure-Perl)');
 	} else {
 		ok($@, 'exception raised');
@@ -65,7 +65,7 @@ EOF
 	my $rd = popen_rd([$^X, '-e', $script]);
 	diag 'waiting for child to reap grandchild...';
 	chomp(my $line = readline($rd));
-	my ($rdy, $pid) = split(' ', $line);
+	my ($rdy, $pid) = split(/ /, $line);
 	is($rdy, 'RDY', 'got ready signal, waitpid(-1) works in child');
 	ok(kill('CHLD', $pid), 'sent SIGCHLD to child');
 	is(readline($rd), "HI\n", '$SIG{CHLD} works in child');
@@ -199,6 +199,30 @@ SKIP: {
 	isnt($?, 0, 'non-zero exit status');
 }
 
-done_testing();
+SKIP: {
+	require PublicInbox::SpawnPP;
+	require File::Temp;
+	my $tmp = File::Temp->newdir('spawnpp-XXXX', TMPDIR => 1);
+	my $cmd = [ qw(/bin/sh -c), 'echo $HI >foo' ];
+	my $env = [ 'HI=hihi' ];
+	my $rlim = [];
+	my $pgid = -1;
+	my $pid = PublicInbox::SpawnPP::pi_fork_exec([], '/bin/sh', $cmd, $env,
+						$rlim, "$tmp", $pgid);
+	is(waitpid($pid, 0), $pid, 'spawned process exited');
+	is($?, 0, 'no error');
+	open my $fh, '<', "$tmp/foo" or die "open: $!";
+	is(readline($fh), "hihi\n", 'env+chdir worked for SpawnPP');
+	close $fh;
+	unlink("$tmp/foo") or die "unlink: $!";
+	{
+		local $ENV{MOD_PERL} = 1;
+		$pid = PublicInbox::SpawnPP::pi_fork_exec([],
+				'/bin/sh', $cmd, $env, $rlim, "$tmp", $pgid);
+	}
+	is(waitpid($pid, 0), $pid, 'spawned process exited');
+	open $fh, '<', "$tmp/foo" or die "open: $!";
+	is(readline($fh), "hihi\n", 'env+chdir SpawnPP under (faked) MOD_PERL');
+}
 
-1;
+done_testing();