X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=a849dbb82e35e9d2dd241205d4abe0139bcf64af;hb=ffb4593ce8673bf9b750cef7f50a426a002fff80;hp=c608ab5d052e1f0605c85d6e64b6419e501f4a7b;hpb=ad6a8a5216a3f231acabe7b88dfb2cd56b3b09c1;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index c608ab5..a849dbb 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -501,10 +501,16 @@ PP(pp_open)
     djSP; dTARGET;
     GV *gv;
     SV *sv;
+    SV *name;
+    I32 have_name = 0;
     char *tmps;
     STRLEN len;
     MAGIC *mg;
 
+    if (MAXARG > 2) {
+	name = POPs;
+	have_name = 1;
+    }
     if (MAXARG > 1)
 	sv = POPs;
     if (!isGV(TOPs))
@@ -537,6 +543,8 @@ PP(pp_open)
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	XPUSHs(sv);
+	if (have_name)
+	    XPUSHs(name);
 	PUTBACK;
 	ENTER;
 	call_method("OPEN", G_SCALAR);
@@ -546,7 +554,7 @@ PP(pp_open)
     }
 
     tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp))
+    if (do_open9(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, name, have_name))
 	PUSHi( (I32)PL_forkprocess );
     else if (PL_forkprocess == 0)		/* we are a new child */
 	PUSHi(0);
@@ -3577,6 +3585,8 @@ PP(pp_system)
     int status;
     Sigsave_t ihand,qhand;     /* place to save signals during system() */
     STRLEN n_a;
+    I32 did_pipes = 0;
+    int pp[2];
 
     if (SP - MARK == 1) {
 	if (PL_tainting) {
@@ -3587,16 +3597,24 @@ PP(pp_system)
     }
     PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
+    if (PerlProc_pipe(pp) >= 0)
+	did_pipes = 1;
     while ((childpid = vfork()) == -1) {
 	if (errno != EAGAIN) {
 	    value = -1;
 	    SP = ORIGMARK;
 	    PUSHi(value);
+	    if (did_pipes) {
+		PerlLIO_close(pp[0]);
+		PerlLIO_close(pp[1]);
+	    }
 	    RETURN;
 	}
 	sleep(5);
     }
     if (childpid > 0) {
+	if (did_pipes)
+	    PerlLIO_close(pp[1]);
 	rsignal_save(SIGINT, SIG_IGN, &ihand);
 	rsignal_save(SIGQUIT, SIG_IGN, &qhand);
 	do {
@@ -3607,28 +3625,54 @@ PP(pp_system)
 	STATUS_NATIVE_SET(result == -1 ? -1 : status);
 	do_execfree();	/* free any memory child malloced on vfork */
 	SP = ORIGMARK;
+	if (did_pipes) {
+	    int errkid;
+	    int n = 0, n1;
+
+	    while (n < sizeof(int)) {
+		n1 = PerlLIO_read(pp[0],
+				  (void*)(((char*)&errkid)+n),
+				  (sizeof(int)) - n);
+		if (n1 <= 0)
+		    break;
+		n += n1;
+	    }
+	    PerlLIO_close(pp[0]);
+	    if (n) {			/* Error */
+		if (n != sizeof(int))
+		    Perl_croak(aTHX_ "panic: kid popen errno read");
+		errno = errkid;		/* Propagate errno from kid */
+		STATUS_CURRENT = -1;
+	    }
+	}
 	PUSHi(STATUS_CURRENT);
 	RETURN;
     }
+    if (did_pipes) {
+	PerlLIO_close(pp[0]);
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+	fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+#endif
+    }
     if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
-	value = (I32)do_aexec(really, MARK, SP);
+	value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
     }
     else if (SP - MARK != 1)
-	value = (I32)do_aexec(Nullsv, MARK, SP);
+	value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
     else {
-	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+	value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
     }
     PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
     if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
-	value = (I32)do_aspawn(aTHX_ really, (void **)MARK, (void **)SP);
+	value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
     }
     else if (SP - MARK != 1)
-	value = (I32)do_aspawn(aTHX_ Nullsv, (void **)MARK, (void **)SP);
+	value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
     else {
-	value = (I32)do_spawn(aTHX_ SvPVx(sv_mortalcopy(*SP), n_a));
+	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
     }
     STATUS_NATIVE_SET(value);
     do_execfree();
@@ -3655,7 +3699,7 @@ PP(pp_exec)
 #else
 #  ifdef __OPEN_VM
 	{
-	   (void ) do_aspawn(aTHX_ Nullsv, MARK, SP);
+	   (void ) do_aspawn(Nullsv, MARK, SP);
 	   value = 0;
 	}
 #  else
@@ -3672,7 +3716,7 @@ PP(pp_exec)
 	value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
 #else
 #  ifdef __OPEN_VM
-	(void) do_spawn(aTHX_ SvPVx(sv_mortalcopy(*SP), n_a));
+	(void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
 	value = 0;
 #  else
 	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));