Lock PL_fdpid against race conditions, based on:

Subject: [PATCH 5.6.0]subprocess fixup for threads
To: perl5-porters@perl.org
Message-Id: <4.3.0.20000411170218.01d2f580@24.8.96.48>

p4raw-id: //depot/cfgperl@6209

7 files changed, 33 insertions, 1 deletions

diff --git a/doio.c b/doio.c
index 0121633c84..c3d6f50715 100644
--- a/doio.c
+++ b/doio.c
@@ -476,11 +476,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    SV *sv;
 
 	    PerlLIO_dup2(PerlIO_fileno(fp), fd);
+	    FDPID_LOCK();
 	    sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    pid = SvIVX(sv);
 	    SvIVX(sv) = 0;
 	    sv = *av_fetch(PL_fdpid,fd,TRUE);
+	    FDPID_UNLOCK();
 	    (void)SvUPGRADE(sv, SVt_IV);
 	    SvIVX(sv) = pid;
 	    if (!was_fdopen)
diff --git a/intrpvar.h b/intrpvar.h
index 0540d2e50b..5ef3d66c41 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -140,6 +140,10 @@ PERLVAR(Iforkprocess,	int)		/* so do_open |- can return proc# */
 /* subprocess state */
 PERLVAR(Ifdpid,		AV *)		/* keep fd-to-pid mappings for my_popen */
 
+#ifdef USE_THREADS
+PERLVAR(Ifdpid_mutex,	perl_mutex)	/* mutex for fdpid array */
+#endif
+
 /* internal state */
 PERLVAR(Itainting,	bool)		/* doing taint checks */
 PERLVARI(Iop_mask,	char *,	NULL)	/* masked operations for safe evals */
diff --git a/perl.c b/perl.c
index b36eb89b46..cbe966cca0 100644
--- a/perl.c
+++ b/perl.c
@@ -181,6 +181,7 @@ perl_construct(pTHXx)
 	
 	MUTEX_INIT(&PL_cred_mutex);
 	MUTEX_INIT(&PL_sv_lock_mutex);
+	MUTEX_INIT(&PL_fdpid_mutex);
 
 	thr = init_main_thread();
 #endif /* USE_THREADS */
@@ -726,6 +727,7 @@ perl_destruct(pTHXx)
     MUTEX_DESTROY(&PL_sv_mutex);
     MUTEX_DESTROY(&PL_eval_mutex);
     MUTEX_DESTROY(&PL_cred_mutex);
+    MUTEX_DESTROY(&PL_fdpid_mutex);
     COND_DESTROY(&PL_eval_cond);
 #ifdef EMULATE_ATOMIC_REFCOUNTS
     MUTEX_DESTROY(&PL_svref_mutex);
diff --git a/sv.h b/sv.h
index 4251fe451c..10ea0afd61 100644
--- a/sv.h
+++ b/sv.h
@@ -1065,3 +1065,11 @@ Release the internal mutex for an SV.
 
 #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
 #define Sv_Grow sv_grow
+
+#ifdef USE_THREADS
+#   define FDPID_LOCK()		MUTEX_LOCK(&PL_fdpid_mutex)
+#   define FDPID_UNLOCK()	MUTEX_UNLOCK(&PL_fdpid_mutex)
+#else
+#   define FDPID_LOCK()
+#   define FDPID_UNLOCK()
+#endif
diff --git a/util.c b/util.c
index dd8c842b03..4f55376209 100644
--- a/util.c
+++ b/util.c
@@ -2402,7 +2402,9 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 	PerlLIO_close(p[This]);
 	p[This] = p[that];
     }
+    FDPID_LOCK();
     sv = *av_fetch(PL_fdpid,p[This],TRUE);
+    FDPID_UNLOCK();
     (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = pid;
     PL_forkprocess = pid;
@@ -2620,7 +2622,9 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     int saved_win32_errno;
 #endif
 
+    FDPID_LOCK();
     svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
+    FDPID_UNLOCK();
     pid = SvIVX(*svp);
     SvREFCNT_dec(*svp);
     *svp = &PL_sv_undef;
diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c
index 0e7894aeb9..77f2149597 100644
--- a/vmesa/vmesa.c
+++ b/vmesa/vmesa.c
@@ -182,11 +182,13 @@ do_aspawn(SV* really, SV **mark, SV **sp)
              /* be used by my_pclose                        */
              /*---------------------------------------------*/
              close(fd);
+             FDPID_LOCK();
              p_sv  = av_fetch(PL_fdpid,fd,TRUE);
              fd    = (int) SvIVX(*p_sv);
              SvREFCNT_dec(*p_sv);
              *p_sv = &PL_sv_undef;
              sv    = *av_fetch(PL_fdpid,fd,TRUE);
+             FDPID_UNLOCK();
              (void) SvUPGRADE(sv, SVt_IV);
              SvIVX(sv) = pid;
              status    = 0;
@@ -408,11 +410,13 @@ my_popen(char *cmd, char *mode)
          Perl_stdin_fd = pFd[that];
       if (strNE(cmd,"-"))
       {
-	 PERL_FLUSHALL_FOR_CHILD;
+         PERL_FLUSHALL_FOR_CHILD;
          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
          if (pid >= 0)
          {
+            FDPID_LOCK();
             sv = *av_fetch(PL_fdpid,pFd[this],TRUE);
+            FDPID_UNLOCK();
             (void) SvUPGRADE(sv, SVt_IV);
             SvIVX(sv) = pid;
             fd = PerlIO_fdopen(pFd[this], mode);
@@ -423,7 +427,9 @@ my_popen(char *cmd, char *mode)
       }
       else
       {
+         FDPID_LOCK();
          sv = *av_fetch(PL_fdpid,pFd[that],TRUE);
+         FDPID_UNLOCK();
          (void) SvUPGRADE(sv, SVt_IV);
          SvIVX(sv) = pFd[this];
          fd = PerlIO_fdopen(pFd[this], mode);
@@ -460,7 +466,9 @@ my_pclose(FILE *fp)
  SV   **sv;
  FILE *other;
 
+   FDPID_LOCK();
    sv        = av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
+   FDPID_UNLOCK();
    pid       = (int) SvIVX(*sv);
    SvREFCNT_dec(*sv);
    *sv       = &PL_sv_undef;
diff --git a/win32/win32.c b/win32/win32.c
index 8ee573262c..01dd5d22e7 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2390,7 +2390,9 @@ win32_popen(const char *command, const char *mode)
 	/* close saved handle */
 	win32_close(oldfd);
 
+	FDPID_LOCK();
 	sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
+	FDPID_UNLOCK();
 
 	/* set process id so that it can be returned by perl's open() */
 	PL_forkprocess = childpid;
@@ -2426,7 +2428,9 @@ win32_pclose(FILE *pf)
     int childpid, status;
     SV *sv;
 
+    FDPID_LOCK();
     sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+    FDPID_UNLOCK();
     if (SvIOK(sv))
 	childpid = SvIVX(sv);
     else