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

diff --git a/doio.c b/doio.c
index 0121633..c3d6f50 100644 (file)
--- 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 0540d2e..5ef3d66 100644 (file)
--- 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 b36eb89..cbe966c 100644 (file)
--- 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 4251fe4..10ea0af 100644 (file)
--- 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 dd8c842..4f55376 100644 (file)
--- 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 0e7894a..77f2149 100644 (file)
--- 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 8ee5732..01dd5d2 100644 (file)
--- 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