b8c914
From 3e6e57e89f298f450cbe14c61609f08fc01bf233 Mon Sep 17 00:00:00 2001
b8c914
From: Zefram <zefram@fysh.org>
b8c914
Date: Sat, 16 Dec 2017 05:33:20 +0000
b8c914
Subject: [PATCH] perform system() arg processing before fork
b8c914
MIME-Version: 1.0
b8c914
Content-Type: text/plain; charset=UTF-8
b8c914
Content-Transfer-Encoding: 8bit
b8c914
b8c914
A lot of things can happen when stringifying an argument list: side
b8c914
effects, warnings, exceptions.  In the case of system(), these effects
b8c914
should happen in the context of the parent process.  The stringification
b8c914
can also depend on which process it happens in, as in the case of
b8c914
$$, and in that case it should also happen in the parent process.
b8c914
Therefore reduce the argument scalars to strings first thing in pp_system.
b8c914
Fixes [perl #121105].
b8c914
b8c914
Petr Písař: Ported to 5.26.2-RC1 from
b8c914
64def2aeaeb63f92dadc6dfa33486c1d7b311963.
b8c914
b8c914
Signed-off-by: Petr Písař <ppisar@redhat.com>
b8c914
---
b8c914
 pp_sys.c    | 16 ++++++++++------
b8c914
 t/op/exec.t | 15 ++++++++++++++-
b8c914
 2 files changed, 24 insertions(+), 7 deletions(-)
b8c914
b8c914
diff --git a/pp_sys.c b/pp_sys.c
b8c914
index 87961f1..07e552a 100644
b8c914
--- a/pp_sys.c
b8c914
+++ b/pp_sys.c
b8c914
@@ -4375,14 +4375,18 @@ PP(pp_system)
b8c914
     int result;
b8c914
 # endif
b8c914
 
b8c914
+    while (++MARK <= SP) {
b8c914
+	SV *origsv = *MARK;
b8c914
+	STRLEN len;
b8c914
+	char *pv;
b8c914
+	pv = SvPV(origsv, len);
b8c914
+	*MARK = newSVpvn_flags(pv, len,
b8c914
+		    (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP);
b8c914
+    }
b8c914
+    MARK = ORIGMARK;
b8c914
+
b8c914
     if (TAINTING_get) {
b8c914
 	TAINT_ENV();
b8c914
-	while (++MARK <= SP) {
b8c914
-	    (void)SvPV_nolen_const(*MARK);      /* stringify for taint check */
b8c914
-	    if (TAINT_get)
b8c914
-		break;
b8c914
-	}
b8c914
-	MARK = ORIGMARK;
b8c914
 	TAINT_PROPER("system");
b8c914
     }
b8c914
     PERL_FLUSHALL_FOR_CHILD;
b8c914
diff --git a/t/op/exec.t b/t/op/exec.t
b8c914
index 237388b..e29de82 100644
b8c914
--- a/t/op/exec.t
b8c914
+++ b/t/op/exec.t
b8c914
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C';		# Ditto in GNU.
b8c914
 my $Is_VMS   = $^O eq 'VMS';
b8c914
 my $Is_Win32 = $^O eq 'MSWin32';
b8c914
 
b8c914
-plan(tests => 34);
b8c914
+plan(tests => 37);
b8c914
 
b8c914
 my $Perl = which_perl();
b8c914
 
b8c914
@@ -177,6 +177,19 @@ TODO: {
b8c914
         "exec failure doesn't terminate process");
b8c914
 }
b8c914
 
b8c914
+package CountRead {
b8c914
+    sub TIESCALAR { bless({ n => 0 }, $_[0]) }
b8c914
+    sub FETCH { ++$_[0]->{n} }
b8c914
+}
b8c914
+my $cr;
b8c914
+tie $cr, "CountRead";
b8c914
+is system($^X, "-e", "exit(\$ARGV[0] eq '1' ? 0 : 1)", $cr), 0,
b8c914
+    "system args have magic processed exactly once";
b8c914
+is tied($cr)->{n}, 1, "system args have magic processed before fork";
b8c914
+
b8c914
+is system($^X, "-e", "exit(\$ARGV[0] eq \$ARGV[1] ? 0 : 1)", "$$", $$), 0,
b8c914
+    "system args have magic processed before fork";
b8c914
+
b8c914
 my $test = curr_test();
b8c914
 exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
b8c914
 fail("This should never be reached if the exec() worked");
b8c914
-- 
b8c914
2.14.3
b8c914