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 14, 2015 00:46
Subject:
Re: [perl #123775] Args to 'system' not evaluated before forking,making $$ wrong
Message ID:
CAHhgV8j+wbiV6WULvFCv_u7ij_yUH_=TDFGpcU12kiCQP7Tvkg@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