Skip Menu |
 
Report information
Id: 85520
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: corion [at] cpan.org
Cc:
AdminCc:

Operating System: mswin32
PatchStatus: HasPatch
Severity: low
Type:
  • core
  • Patch
Perl Version: 5.13.10
Fixed In: (no value)



Subject: [patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it
Date: Sun, 06 Mar 2011 19:19:37 +0100
To: perlbug [...] perl.org
From: Max Maischein <corion [...] cpan.org>
Download (untitled) / with headers
text/plain 6.6k
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: 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)
CC: Max Maischein <perlbug-followup [...] perl.org>, bugs-bitbucket [...] rt.perl.org
Subject: Re: [perl #85520] [patch] [resend] Turn $$ into a magical readonly variable that always fetches getpid() instead of caching it
Date: Mon, 7 Mar 2011 08:55:53 -0800
To: perl5-porters [...] perl.org
From: Chad Granum <exodist7 [...] gmail.com>
Download (untitled) / with headers
text/plain 8.5k
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: Show quoted text
> # 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: 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) > >
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 905b
On Sun Mar 06 10:20:12 2011, corion@cpan.org wrote: Show quoted text
> 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?
Download (untitled) / with headers
text/plain 624b
Another message that RT didn’t pick up, from nntp://nntp.perl.org/4DD979EB.3090206@cpan.org: Hello, Show quoted text
> 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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 877b
On Sun May 22 18:07:52 2011, sprout wrote: Show quoted text
> 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!


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org