[patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it #11179

p5pRT · 2011-03-06T18:20:11Z

Migrated from rt.perl.org#85520 (status was 'resolved')

Searchable as RT85520$

p5pRT · 2011-03-06T18:20:12Z

From @Corion

Created by @Corion

To get a Perlbug number, I'm resending the patch appended
to this mail.

commit df1cd6761ac9224f4aea7139509f9cacbf0b9ea0
Author: Max Maischein <corion@corion.net>
Date: Wed Dec 29 16:35:08 2010 +0100

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.

Inline Patch

diff --git a/gv.c b/gv.c
index 4e79171..f11f0cc 100644
--- a/gv.c
+++ b/gv.c
@@ -1457,6 +1457,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg,

STRLEN full_len, I32 flags, \#endif goto magicalize;

+ case '$': /* $$ */
+ goto magicalize;
case '!': /* $! */
GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */

Inline Patch

diff --git a/mg.c b/mg.c
index 8053bf1..89c22c6 100644
--- a/mg.c
+++ b/mg.c
@@ -1115,6 +1115,12 @@ 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());
+	/* If you want another number, pull one at the entrance */
+	SvREADONLY_on(sv);
+	break;
+
      case '!':
  	{
  	dSAVE_ERRNO;
diff --git a/perl.c b/perl.c
index d2571a8..ab2e079 100644
--- a/perl.c
+++ b/perl.c
@@ -4125,11 +4125,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

Inline Patch

diff --git a/pp_sys.c b/pp_sys.c
index 2845266..c4998bb 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4084,12 +4084,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 ac7dd57..b175c31 100644
--- a/util.c
+++ b/util.c
@@ -2770,12 +2770,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

Inline Patch

diff --git a/win32/perlhost.h b/win32/perlhost.h
index 70a2f65..8103ee7 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

Perl Info


Flags:
     category=core
     severity=low

Site configuration information for perl 5.13.10:

Configured by corion at Fri Mar  4 21:37:02 2011.

Summary of my perl5 (revision 5 version 13 subversion 10) configuration:
   Local Commit: de43a757c8705e286fca2f426d49cc107b810fd8
   Ancestor: 4d56cd4f546df82c1cabd288669bd8227d6847b4
   Platform:
     osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
     uname=''
     config_args='undef'
     hint=recommended, useposix=true, d_sigaction=undef
     useithreads=define, usemultiplicity=define
     useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
     use64bitint=undef, use64bitall=undef, uselongdouble=undef
     usemymalloc=n, bincompat5005=undef
   Compiler:
     cc='gcc', ccflags =' -s -O2 -DWIN32  -DPERL_IMPLICIT_CONTEXT 
-DPERL_IMPLICIT_SYS -fno-strict-aliasing -mms-bitfields',
     optimize='-s -O2',
     cppflags='-DWIN32'
     ccversion='', gccversion='4.4.3', gccosandvers=''
     intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
     d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=12
     ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='long 
long', lseeksize=8
     alignbytes=8, prototype=define
   Linker and Libraries:
     ld='g++', ldflags ='-s -L"c:\perl\lib\CORE" -L"C:\MinGW\lib"'
     libpth=C:\MinGW\lib
     libs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr 
-lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
     perllibs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool 
-lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid 
-lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
     libc=, so=dll, useshrplib=true, libperl=libperl513.a
     gnulibc_version=''
   Dynamic Linking:
     dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
     cccdlflags=' ', lddlflags='-mdll -s -L"c:\perl\lib\CORE" 
-L"C:\MinGW\lib"'

Locally applied patches:



@INC for perl 5.13.10:
     C:/Projekte/bleadperl-git/lib
     .


Environment for perl 5.13.10:
     HOME (unset)
     LANG (unset)
     LANGUAGE (unset)
     LD_LIBRARY_PATH (unset)
     LOGDIR (unset)
 
PATH=C:\strawberry\perl\bin;C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\Programme\Microsoft 
IntelliType Pro\;C:\PROGRA~1\MATROX~1\System32;C:\Programme\MiKTeX 
2.7\miktex\bin;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem;C:\Programme\Haufe\iDesk\iDeskService\;C:\Programme\Git\cmd;C:\Programme\GNU\GnuPG\pub;C:\Programme\sK1 
Project\UniConvertor-1.1.5\;C:\Programme\sK1 
Project\UniConvertor-1.1.5\DLLs;C:\Programme\Gemeinsame Dateien\GTK\2.0\bin
     PERL_BADLANG (unset)
     SHELL (unset)

p5pRT · 2011-03-07T16:56:25Z

From @exodist

I am indifferent about this patch, but I want to point out that use of
$$ is not limited to temp file creation. In current times
parallelization of tasks is important when possible, specially with
multi-core systems. Currently there are several cpan modules which
allow you to run tasks in parallel. When you do parallelization you
are almost always talking forked processes. You need to determine if
you are the parent or a child, if other forks have happened, etc. In
some of these systems such as Child and Parallel::Runner $$ may be
called many times. In the parallel testing framework Fennec forking
within tests is allowed, but in order to accomplish this $$ must be
checked frequently.

Once again I am indifferent to the patch, I doubt the performance hit
will be meaningful anywhere, but I wanted to point out that the
ramifications extend beyond temp file creation.

-Chad 'Exodist' Granum

On Sun, Mar 6, 2011 at 10:20 AM, Max Maischein
<perlbug-followup@perl.org> wrote:

# New Ticket Created by Max Maischein
# Please include the string: [perl #85520]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=85520 >

This is a bug report for perl from corion@cpan.org,
generated with the help of perlbug 1.39 running under perl 5.13.10.

-----------------------------------------------------------------
[Please describe your issue here]

To get a Perlbug number, I'm resending the patch appended
to this mail.

commit df1cd6761ac9224f4aea7139509f9cacbf0b9ea0
Author: Max Maischein <corion@corion.net>
Date: Wed Dec 29 16:35:08 2010 +0100

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.

diff --git a/gv.c b/gv.c
index 4e79171..f11f0cc 100644
--- a/gv.c
+++ b/gv.c
@@ -1457,6 +1457,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg,
STRLEN full_len, I32 flags,
#endif
goto magicalize;

+ case '$': /* $$ */
+ goto magicalize;
case '!': /* $! */
GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */
diff --git a/mg.c b/mg.c
index 8053bf1..89c22c6 100644
--- a/mg.c
+++ b/mg.c
@@ -1115,6 +1115,12 @@ 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());
+ /* If you want another number, pull one at the entrance */
+ SvREADONLY_on(sv);
+ break;
+
case '!':
{
dSAVE_ERRNO;
diff --git a/perl.c b/perl.c
index d2571a8..ab2e079 100644
--- a/perl.c
+++ b/perl.c
@@ -4125,11 +4125,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 2845266..c4998bb 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4084,12 +4084,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 ac7dd57..b175c31 100644
--- a/util.c
+++ b/util.c
@@ -2770,12 +2770,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 70a2f65..8103ee7 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

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=low
---
Site configuration information for perl 5.13.10:

Configured by corion at Fri Mar 4 21:37:02 2011.

Summary of my perl5 (revision 5 version 13 subversion 10) configuration:
Local Commit: de43a757c8705e286fca2f426d49cc107b810fd8
Ancestor: 4d56cd4
Platform:
osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
uname=''
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags =' -s -O2 -DWIN32 -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -fno-strict-aliasing -mms-bitfields',
optimize='-s -O2',
cppflags='-DWIN32'
ccversion='', gccversion='4.4.3', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='long
long', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='g++', ldflags ='-s -L"c:\perl\lib\CORE" -L"C:\MinGW\lib"'
libpth=C:\MinGW\lib
libs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr
-lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
perllibs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool
-lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid
-lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
libc=, so=dll, useshrplib=true, libperl=libperl513.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-mdll -s -L"c:\perl\lib\CORE"
-L"C:\MinGW\lib"'

Locally applied patches:

---
@INC for perl 5.13.10:
C:/Projekte/bleadperl-git/lib
.

---
Environment for perl 5.13.10:
HOME (unset)
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=C:\strawberry\perl\bin;C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\Programme\Microsoft
IntelliType Pro\;C:\PROGRA~~1\MATROX~~1\System32;C:\Programme\MiKTeX
2.7\miktex\bin;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem;C:\Programme\Haufe\iDesk\iDeskService\;C:\Programme\Git\cmd;C:\Programme\GNU\GnuPG\pub;C:\Programme\sK1
Project\UniConvertor-1.1.5\;C:\Programme\sK1
Project\UniConvertor-1.1.5\DLLs;C:\Programme\Gemeinsame Dateien\GTK\2.0\bin
PERL_BADLANG (unset)
SHELL (unset)

p5pRT · 2011-03-07T16:56:25Z

The RT System itself - Status changed from 'new' to 'open'

p5pRT · 2011-05-22T20:39:43Z

From @cpansprout

On Sun Mar 06 10:20:12 2011, corion@cpan.org wrote:

To get a Perlbug number, I'm resending the patch appended
to this mail.

commit df1cd6761ac9224f4aea7139509f9cacbf0b9ea0
Author: Max Maischein <corion@corion.net>
Date: Wed Dec 29 16:35:08 2010 +0100
 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.

Is there any reason I should not apply this?

p5pRT · 2011-05-23T01:07:52Z

From @cpansprout

Another message that RT didn’t pick up, from
nntp://nntp.perl.org/4DD979EB.3090206@cpan.org:

Hello,

On Sun Mar 06 10:20:12 2011, corion@cpan.org wrote:

To get a Perlbug number, I'm resending the patch appended
to this mail.
[...]

Is there any reason I should not apply this?

I'm unaware of any such reason. I couldn't get a reply either for or
against it from p5p at the time, and also unfortunately didn't get the
deprecation message into 5.14.

Still I think it should get applied, as the two CPAN modules affected by
it have patches, and I think it fixes more latent bugs than it causes.

-max

p5pRT · 2011-05-23T04:52:03Z

From @cpansprout

On Sun May 22 18:07:52 2011, sprout wrote:

Another message that RT didn’t pick up, from
nntp://nntp.perl.org/4DD979EB.3090206@cpan.org:

Hello,

On Sun Mar 06 10:20:12 2011, corion@cpan.org wrote:

To get a Perlbug number, I'm resending the patch appended
to this mail.
[...]

Is there any reason I should not apply this?

I'm unaware of any such reason. I couldn't get a reply either for or
against it from p5p at the time, and also unfortunately didn't get the
deprecation message into 5.14.

Still I think it should get applied, as the two CPAN modules affected by
it have patches, and I think it fixes more latent bugs than it causes.

I’ve just applied it as 0e21945. I tweaked it a bit, as your version was
allowing $$ assignment up until the first fetch (just moved the
SvREADONLY_on to gv.c).

Thank you!

p5pRT · 2011-05-23T04:52:04Z

@cpansprout - Status changed from 'open' to 'resolved'

p5pRT closed this as completed May 23, 2011

p5pRT added Severity Low distro-mswin32 hasPatch type-core labels Oct 19, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

[patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it #11179

[patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it #11179

p5pRT commented Mar 6, 2011

p5pRT commented Mar 6, 2011

p5pRT commented Mar 7, 2011

p5pRT commented Mar 7, 2011

p5pRT commented May 22, 2011

p5pRT commented May 23, 2011

p5pRT commented May 23, 2011

p5pRT commented May 23, 2011

[patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it #11179

[patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it #11179

Comments

p5pRT commented Mar 6, 2011

p5pRT commented Mar 6, 2011

From @Corion

Created by @Corion

p5pRT commented Mar 7, 2011

From @exodist

p5pRT commented Mar 7, 2011

p5pRT commented May 22, 2011

From @cpansprout

p5pRT commented May 23, 2011

From @cpansprout

p5pRT commented May 23, 2011

From @cpansprout

p5pRT commented May 23, 2011