From 0e21945565eb4664d843bb819fb032cedee4d5a6 Mon Sep 17 00:00:00 2001
From: Max Maischein <corion@corion.net>
Date: Sun, 22 May 2011 21:36:57 -0700
Subject: [PATCH] Turn $$ into a magical readonly variable that always fetches
 getpid() instead of caching it

The intent is that by not caching $$, we eliminate one opportunity for bugs:
If one embeds Perl or uses XS and calls fork(3) from C, Perls notion of $$
may go out of sync with what getpid() returns. By always fetching the
value of $$ via getpid(), this bug opportunity is eliminated. The overhead
of always fetching $$ should be small and is likely only used for tempfile
creation, which should be dwarfed by file system accesses.
---
 gv.c             | 3 +++
 mg.c             | 4 ++++
 perl.c           | 5 -----
 pp_sys.c         | 6 ------
 util.c           | 6 ------
 win32/perlhost.h | 7 -------
 6 files changed, 7 insertions(+), 24 deletions(-)

diff --git a/gv.c b/gv.c
index 72cc9f6..a003adb 100644
--- a/gv.c
+++ b/gv.c
@@ -1469,6 +1469,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 #endif
 	    goto magicalize;
 
+	case '$':		/* $$ */
+	    SvREADONLY_on(GvSVn(gv));
+	    goto magicalize;
 	case '!':		/* $! */
 	    GvMULTI_on(gv);
 	    /* If %! has been used, automatically load Errno.pm. */
diff --git a/mg.c b/mg.c
index 85b5461..af2c647 100644
--- a/mg.c
+++ b/mg.c
@@ -1114,6 +1114,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	if (PL_ors_sv)
 	    sv_copypv(sv, PL_ors_sv);
 	break;
+    case '$': /* $$ */
+	sv_setiv(sv, (IV)PerlProc_getpid());
+	break;
+
     case '!':
 	{
 	dSAVE_ERRNO;
diff --git a/perl.c b/perl.c
index 4dc5bad..417b2fd 100644
--- a/perl.c
+++ b/perl.c
@@ -4155,11 +4155,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #endif /* !PERL_MICRO */
     }
     TAINT_NOT;
-    if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
-        SvREADONLY_off(GvSV(tmpgv));
-	sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
-        SvREADONLY_on(GvSV(tmpgv));
-    }
 #ifdef THREADS_HAVE_PIDS
     PL_ppid = (IV)getppid();
 #endif
diff --git a/pp_sys.c b/pp_sys.c
index 186465f..aa74cef 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4017,12 +4017,6 @@ PP(pp_fork)
     if (childpid < 0)
 	RETSETUNDEF;
     if (!childpid) {
-	GV * const tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV);
-	if (tmpgv) {
-            SvREADONLY_off(GvSV(tmpgv));
-	    sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
-            SvREADONLY_on(GvSV(tmpgv));
-        }
 #ifdef THREADS_HAVE_PIDS
 	PL_ppid = (IV)getppid();
 #endif
diff --git a/util.c b/util.c
index bd9010f..f6742e7 100644
--- a/util.c
+++ b/util.c
@@ -2759,12 +2759,6 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
       default, binary, low-level mode; see PerlIOBuf_open(). */
    PerlLIO_setmode((*mode == 'r'), O_BINARY);
 #endif 
-
-	if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
-	    SvREADONLY_off(GvSV(tmpgv));
-	    sv_setiv(GvSV(tmpgv), PerlProc_getpid());
-	    SvREADONLY_on(GvSV(tmpgv));
-	}
 #ifdef THREADS_HAVE_PIDS
 	PL_ppid = (IV)getppid();
 #endif
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 0240044..abe7296 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -1722,18 +1722,11 @@ win32_start_child(LPVOID arg)
     PERL_SET_THX(my_perl);
     win32_checkTLS(my_perl);
 
-    /* set $$ to pseudo id */
 #ifdef PERL_SYNC_FORK
     w32_pseudo_id = id;
 #else
     w32_pseudo_id = GetCurrentThreadId();
 #endif
-    if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
-	SV *sv = GvSV(tmpgv);
-	SvREADONLY_off(sv);
-	sv_setiv(sv, -(IV)w32_pseudo_id);
-	SvREADONLY_on(sv);
-    }
 #ifdef PERL_USES_PL_PIDSTATUS    
     hv_clear(PL_pidstatus);
 #endif    
-- 
2.7.4