develooper Front page | perl.perl5.porters | Postings from February 2015

Re: [perl #123775] Args to 'system' not evaluated before forking,making $$ wrong

Thread Previous | Thread Next
From:
Leon Timmermans
Date:
February 13, 2015 23:40
Subject:
Re: [perl #123775] Args to 'system' not evaluated before forking,making $$ wrong
Message ID:
CAHhgV8jQfmt=1mj_hUdRasJVgAxbcfoR8wBVRjHQQxvo2ZRbnQ@mail.gmail.com
From 14e44794d6597318abed388a8614f5f28eb91389 Mon Sep 17 00:00:00 2001
From: Leon Timmermans <fawaka@gmail.com>
Date: Sat, 14 Feb 2015 00:37:18 +0100
Subject: [PATCH] Evaluate get magic in system and openpipe before the fork

---
 doio.c      |  2 +-
 mathoms.c   |  4 ++++
 pp_sys.c    |  6 ++++++
 t/op/exec.t | 20 +++++++++++++++++++-
 util.c      |  7 +++++++
 5 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/doio.c b/doio.c
index a63f2a2..dc4de86 100644
--- a/doio.c
+++ b/doio.c
@@ -1544,7 +1544,7 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
 
 	while (++mark <= sp) {
 	    if (*mark)
-		*a++ = SvPV_nolen_const(*mark);
+		*a++ = SvPV_nomg_nolen(*mark);
 	    else
 		*a++ = "";
 	}
diff --git a/mathoms.c b/mathoms.c
index 2a65fb4..6ad8eb3 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -713,8 +713,12 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 bool
 Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp)
 {
+    SV** current;
     PERL_ARGS_ASSERT_DO_AEXEC;
 
+    for (current = mark + 1; current <= SP; current++) {
+	SvGETMAGIC(*current);
+    }
     return do_aexec5(really, mark, sp, 0, 0);
 }
 #endif
diff --git a/pp_sys.c b/pp_sys.c
index e2f8edf..7e4ff61 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4259,6 +4259,12 @@ PP(pp_system)
 	MARK = ORIGMARK;
 	TAINT_PROPER("system");
     }
+    else {
+	while (++MARK <= SP) {
+	    (void)SvGETMAGIC(*MARK);      /* For get magic */
+	}
+	MARK = ORIGMARK;
+    }
     PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
     {
diff --git a/t/op/exec.t b/t/op/exec.t
index 6ec3646..e7ef923 100644
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C';		# Ditto in GNU.
 my $Is_VMS   = $^O eq 'VMS';
 my $Is_Win32 = $^O eq 'MSWin32';
 
-plan(tests => 24);
+plan(tests => 26);
 
 my $Perl = which_perl();
 
@@ -153,6 +153,24 @@ TODO: {
         "exec failure doesn't terminate process");
 }
 
+SKIP: {
+    skip 'Doesn\'t work on Windows/VMS', 2 if $Is_VMS || $Is_Win32;
+    open my $fh, '-|', 'echo', $$;
+    my $pid = <$fh>;
+    chomp $pid;
+    is($pid, $$, 'Pid is as expected in openpipe');
+
+    skip 'Can\'t load POSIX' if not eval { require POSIX };
+    if (my $child = open my $fh, '-|') {
+	my $pid = <$fh>;
+	chomp $pid;
+	is($pid, $child, 'Pid is as expected in system');
+    } else {
+	system 'echo', $$;
+	POSIX::_exit(0);
+    }
+}
+
 my $test = curr_test();
 exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
 fail("This should never be reached if the exec() worked");
diff --git a/util.c b/util.c
index 9ffdbde..ebd3ab4 100644
--- a/util.c
+++ b/util.c
@@ -2349,6 +2349,13 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
     /* Try for another pipe pair for error return */
     if (PerlProc_pipe(pp) >= 0)
 	did_pipes = 1;
+
+    {
+	SV** current;
+	for (current = args; current <= args-1+n; current++) {
+	    SvGETMAGIC(*current);
+	}
+    }
     while ((pid = PerlProc_fork()) < 0) {
 	if (errno != EAGAIN) {
 	    PerlLIO_close(p[This]);
-- 
2.2.0-369-g3b010e3


Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About