diff options
author | Eric Wong <e@80x24.org> | 2023-01-29 09:45:11 +0000 |
---|---|---|
committer | Eric Wong <e@80x24.org> | 2023-01-30 06:42:26 +0000 |
commit | 9eb8baf199cd148b7ebf8e6e130fb832f4e1ef00 (patch) | |
tree | b89b0cc4e444c2f673902aa3b9605940b04380bc | |
parent | 4a2e1f38e75ef3ce8bffc8f2b59b18b32420c0fc (diff) | |
download | public-inbox-9eb8baf199cd148b7ebf8e6e130fb832f4e1ef00.tar.gz |
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.
-rw-r--r-- | lib/PublicInbox/SpawnPP.pm | 5 | ||||
-rw-r--r-- | 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; } @@ -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(); |