Skip to content

Commit 0e21945

Browse files
Max MaischeinFather Chrysostomos
Max Maischein
authored and
Father Chrysostomos
committed
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.
1 parent 369fb44 commit 0e21945

File tree

6 files changed

+7
-24
lines changed

6 files changed

+7
-24
lines changed

gv.c

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1469,6 +1469,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
14691469
#endif
14701470
goto magicalize;
14711471

1472+
case '$': /* $$ */
1473+
SvREADONLY_on(GvSVn(gv));
1474+
goto magicalize;
14721475
case '!': /* $! */
14731476
GvMULTI_on(gv);
14741477
/* If %! has been used, automatically load Errno.pm. */

mg.c

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1114,6 +1114,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
11141114
if (PL_ors_sv)
11151115
sv_copypv(sv, PL_ors_sv);
11161116
break;
1117+
case '$': /* $$ */
1118+
sv_setiv(sv, (IV)PerlProc_getpid());
1119+
break;
1120+
11171121
case '!':
11181122
{
11191123
dSAVE_ERRNO;

perl.c

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4155,11 +4155,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
41554155
#endif /* !PERL_MICRO */
41564156
}
41574157
TAINT_NOT;
4158-
if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
4159-
SvREADONLY_off(GvSV(tmpgv));
4160-
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
4161-
SvREADONLY_on(GvSV(tmpgv));
4162-
}
41634158
#ifdef THREADS_HAVE_PIDS
41644159
PL_ppid = (IV)getppid();
41654160
#endif

pp_sys.c

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4017,12 +4017,6 @@ PP(pp_fork)
40174017
if (childpid < 0)
40184018
RETSETUNDEF;
40194019
if (!childpid) {
4020-
GV * const tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV);
4021-
if (tmpgv) {
4022-
SvREADONLY_off(GvSV(tmpgv));
4023-
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
4024-
SvREADONLY_on(GvSV(tmpgv));
4025-
}
40264020
#ifdef THREADS_HAVE_PIDS
40274021
PL_ppid = (IV)getppid();
40284022
#endif

util.c

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2759,12 +2759,6 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
27592759
default, binary, low-level mode; see PerlIOBuf_open(). */
27602760
PerlLIO_setmode((*mode == 'r'), O_BINARY);
27612761
#endif
2762-
2763-
if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
2764-
SvREADONLY_off(GvSV(tmpgv));
2765-
sv_setiv(GvSV(tmpgv), PerlProc_getpid());
2766-
SvREADONLY_on(GvSV(tmpgv));
2767-
}
27682762
#ifdef THREADS_HAVE_PIDS
27692763
PL_ppid = (IV)getppid();
27702764
#endif

win32/perlhost.h

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1722,18 +1722,11 @@ win32_start_child(LPVOID arg)
17221722
PERL_SET_THX(my_perl);
17231723
win32_checkTLS(my_perl);
17241724

1725-
/* set $$ to pseudo id */
17261725
#ifdef PERL_SYNC_FORK
17271726
w32_pseudo_id = id;
17281727
#else
17291728
w32_pseudo_id = GetCurrentThreadId();
17301729
#endif
1731-
if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
1732-
SV *sv = GvSV(tmpgv);
1733-
SvREADONLY_off(sv);
1734-
sv_setiv(sv, -(IV)w32_pseudo_id);
1735-
SvREADONLY_on(sv);
1736-
}
17371730
#ifdef PERL_USES_PL_PIDSTATUS
17381731
hv_clear(PL_pidstatus);
17391732
#endif

0 commit comments

Comments
 (0)