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

Owner: Nobody
Requestors: TODDR <toddr [at] cpan.org>
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: medium
Type: core
Perl Version: 5.26.0
Fixed In: (no value)

Attachments
0001-perl-133660-add-test-for-goto-sub-in-overload-leakin.patch



To: perlbug [...] perl.org
From: Todd Rinaldo <toddr [...] cpan.org>
Subject: goto refcount increased by one when using goto
Date: Thu, 15 Nov 2018 12:37:59 -0600
Download (untitled) / with headers
text/plain 9.3k
Download (untitled) / with headers
text/html 12.4k
This is a bug report for perl from toddr@cpan.org,
generated with the help of perlbug 1.40 running under perl 5.26.0.


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

While developing Test::MockFile across perls betwen 5.10.1 and 5.28, I've discovered a discrepancy on how perl sometimes bumps refcount for of args passed into CORE::GLOBAL:: subroutines.

This showed up primarily when overriding CORE::GLOBAL::open and discovering that the file handle wasn't autoclosing when the file handle went out of scope.

The simplest example of this problem is:

---
#!perl

use B ();
BEGIN {
    *CORE::GLOBAL::open = sub (*;$@) {
goto \&CORE::open;  
    };
}

my $refcount;
{
    open(my $fh, '<', '/etc/passwd');
    my $sv = B::svref_2object($fh);
    $refcount = $sv->REFCNT;
}
print "REF=$refcount\n";
exit($refcount == 1 ? 0 : $refcount);

---

On 5.28, the refcount for $fh is 2. But in 5.20, the refcount is 1.

I can make the problem go away by doing this instead of goto: return CORE::open($_[0], ...);

I also notice the problem doesn't manifest on 5.28 if I do this instead:

---
#!/usr/local/cpanel/3rdparty/bin/perl

use B ();

BEGIN {
    *CORE::GLOBAL::open = sub (*;$@) {
goto \&CORE::open;
    };
}

my $count = 1;
trynow();
trynow();
trynow();
trynow();

sub trynow {
    open(my $fh, '<', '/etc/passwd');
    my $sv = B::svref_2object($fh);
    $refcount = $sv->REFCNT;
    print "REFCNT for run " . $count++ . " is $refcount\n";
}
---

So this doesn't seem to be a global problem.

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

Configured by cPanel at Wed Aug 15 07:57:55 CDT 2018.

Summary of my perl5 (revision 5 version 26 subversion 0) configuration:
   
  Platform:
    osname=linux
    osvers=3.10.0-123.20.1.el7.x86_64
    archname=x86_64-linux-64int
    uname='linux rpmbuild-64-centos-7.dev.cpanel.net 3.10.0-123.20.1.el7.x86_64 #1 smp thu jan 29 18:05:33 utc 2015 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Dusedevel -Darchname=x86_64-linux-64int -Dcc=/usr/bin/gcc -Dcpp=/usr/bin/cpp -Dusemymalloc=n -DDEBUGGING=none -Doptimize=-Os -Accflags=-m64 -Dccflags=-DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -Duseshrplib -Duselargefiles=yes -Duseposix=true -Dhint=recommended -Duseperlio=yes -Dcppflags=-I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -Dldflags=-L/usr/local/cpanel/3rdparty/lib64 -Dprefix=/usr/local/cpanel/3rdparty/perl/526 -Dsiteprefix=/opt/cpanel/perl5/526 -Dsitebin=/opt/cpanel/perl5/526/bin -Dsitelib=/opt/cpanel/perl5/526/site_lib -Dusevendorprefix=true -Dvendorbin=/usr/local/cpanel/3rdparty/perl/526/bin -Dvendorprefix=/usr/local/cpanel/3rdparty/perl/526/lib64/perl5
-Dvendorlib=/usr/local/cpanel/3rdparty/perl/526/lib64/perl5/cpanel_lib -Dprivlib=/usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0 -Dman1dir=none -Dman3dir=none -Dscriptdir=/usr/local/cpanel/3rdparty/perl/526/bin -Dscriptdirexp=/usr/local/cpanel/3rdparty/perl/526/bin -Dsiteman1dir=none -Dsiteman3dir=none -Dinstallman1dir=none -Dversiononly=no -Dinstallusrbinperl=no -Dcf_by=cPanel -Dmyhostname=localhost -Dperladmin=root@localhost -Dcf_email=support@cpanel.net -Di_dbm=/usr/local/cpanel/3rdparty/include -Di_gdbm=/usr/local/cpanel/3rdparty/include -Di_ndbm=/usr/local/cpanel/3rdparty/include -DDB_File=true -Ud_dosuid -Uuserelocatableinc -Umad -Uusethreads -Uusemultiplicity -Uusesocks -Uuselongdouble -Aldflags=-L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -lgdbm -Dlocincpth=/usr/local/cpanel/3rdparty/perl/526/include /usr/local/cpanel/3rdparty/include /usr/local/include 
-Duse64bitint -Uuse64bitall -Dlibpth=/usr/local/cpanel/3rdparty/lib64 /usr/local/lib64 /usr/local/lib /lib64 /usr/lib64 '
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=undef
    usemultiplicity=undef
    use64bitint=define
    use64bitall=undef
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
    bincompat5005=undef
  Compiler:
    cc='/usr/bin/gcc'
    ccflags ='-DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -m64 -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
    optimize='-Os'
    cppflags='-I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -m64 -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='4.8.2 20140120 (Red Hat 4.8.2-16)'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='/usr/bin/gcc'
    ldflags ='-L/usr/local/cpanel/3rdparty/lib64 -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -lgdbm -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/cpanel/3rdparty/lib64 /usr/local/lib64 /usr/local/lib /lib64 /usr/lib64 /usr/local/lib /usr/lib /lib/../lib64 /usr/lib/../lib64 /lib
    libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.17.so
    so=so
    useshrplib=true
    libperl=libperl.so
    gnulibc_version='2.17'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E -Wl,-rpath,/usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0/x86_64-linux-64int/CORE'
    cccdlflags='-fPIC'
    lddlflags='-shared -Os -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    cPanel - disable man installs
    cPanel - cPanel INC PATH
    cPanel - cPanel Storable don't bless security
    cPanel - Assume Storable CAN_FLOCK
    cPanel - Avoid importing symbols unless requested
    cPanel - Disable termcap warning when TERM is unset
    cPanel - Do not warn when close fails because the file handle is
    cPanel - Ignore customized.dat inconsistencies since we modify
    cPanel - COW Static support
    cPanel - Do not init PL_strtab if it's already setup
    cPanel - Use dup2 from Cpanel::POSIX::Tiny
    cPanel - Disable 14fileno.t tests since Cpanel::POSIX::Tiny is
    cPanel - Try to avoid a segfault when untie an object
    cPanel - Net::FTP: treat MLSD type facts case-insensitively
    cPanel - Avoid use vars when our will do in Core Perl
    cPanel - Update File::Path to 2.13 for CVE-2017-6512
    cPanel - Fix B logic to not add unnecessary deps
    cPanel - add Perl_DeclareStaticMemory
    cPanel - Disable xs handshake
    cPanel - Provide a way to clear swash invlists for B::C
    cPanel - disable t/porting/podcheck.t for distro packaging
    cPanel - Switch several CPAN modules to XSLoader
    cPanel - BC Static shared memory for single malloc
    cPanel - BC extra protection in Perl_sv_vcatpvfn_flags
    cPanel - Adjust optree_specials.t after B removal from O
    cPanel - Speed up Carp.pm when backtrace arguments are
    cPanel - Fix for 2 arg opens of STDERR in Term::ReadLine
    cPanel - Hard code frequent Config checks so it's not needed
    cPanel - Avoid unique REGCOMP in dynaloader
    cPanel - Avoid waiting on a single test for output
    cPanel - Heap buffer overflow
    cPanel - 5.26.1: fix TRIE_READ_CHAR and DECL_TRIE_TYPE to
    cPanel - perl #132063) we should no longer warn for this code
    cPanel - utf8.c: Don't dump malformation past first NUL
    cPanel - (perl #132227) restart a node if we change to uni rules
    cPanel - Storable do not load Fcntl
    cPanel - Optimize File::Find performance for backup metadata
    cPanel - (perl #131844) fix various space calculation issues in
    cPanel - Reduce Scalar::Utils regex overhead
    cPanel - pp_require: return earlier when module is already
    cPanel - Reduce malloc&free for S_parse_gv_stash_name
    cPanel - add a small buffer to gv_stash_name
    cPanel - skip shadow call when euid > 0 on linux
    cPanel - Fix warning from Memoize::Expire
    cPanel - =?UTF-8?q?Allow=20=E2=80=9Cpeer=E2=80=9D=20to=20be?=
    cPanel - Remove use vars from Digest::
    cPanel - Remove launcher regex in Config.pm

---
@INC for perl 5.26.0:
    /usr/local/cpanel
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/cpanel_lib/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/cpanel_lib
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0
    /opt/cpanel/perl5/526/site_lib/x86_64-linux-64int
    /opt/cpanel/perl5/526/site_lib

---
Environment for perl 5.26.0:
    HOME=/root
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/bin
    PERL_BADLANG (unset)
    PERL_USE_UNSAFE_INC=0
    SHELL=/bin/zsh
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.1k
I was able to automatically bisect this to 7bdb4ff0943cf93297712faf504cdd425426e57f which first showed up in v5.21.10. commit 7bdb4ff0943cf93297712faf504cdd425426e57f (refs/bisect/bad) Author: Father Chrysostomos <sprout@cpan.org> Date: Tue Sep 2 22:11:08 2014 -0700 Fix refcounting in rv2gv when it calls newGVgen When the compiler (op.c) can’t figure out the name of a vivified file- handle based on the variable name, then pp.c:S_rv2gv (which vivifies the handle at run time) calls newGVgen, which generates something named _GEN_0 or suchlike. When it does that, the reference counting is wrong, because the stash gets a *_GEN_0 typeglob and the reference stored in open’s argument points to it, too; but the reference count is nevertheless 1. So if both sources shed their pointers to the GV, then you get a double free. Because usually the typeglob sits in the stash until program exit, this bug has gone unnoticed for a long time. This bug appears to have been present ever since rv2gv started call- ing newGVgen, in 2c8ac474a0. pp.c | 1 + t/op/gv.t | 14 +++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-)
Subject: Re: [perl #133660] goto refcount increased by one when using goto
Date: Mon, 19 Nov 2018 14:28:57 +0000
From: Dave Mitchell <davem [...] iabyn.com>
To: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.4k
On Thu, Nov 15, 2018 at 10:38:36AM -0800, Todd Rinaldo (via RT) wrote: Show quoted text
> While developing Test::MockFile across perls betwen 5.10.1 and 5.28, I've > discovered a discrepancy on how perl sometimes bumps refcount for of args > passed into CORE::GLOBAL:: subroutines. > > This showed up primarily when overriding CORE::GLOBAL::open and discovering > that the file handle wasn't autoclosing when the file handle went out of > scope. > > The simplest example of this problem is: > > --- > #!perl > > use B (); > BEGIN { > *CORE::GLOBAL::open = sub (*;$@) { > goto \&CORE::open; > }; > } > > my $refcount; > { > open(my $fh, '<', '/etc/passwd'); > my $sv = B::svref_2object($fh); > $refcount = $sv->REFCNT; > } > print "REF=$refcount\n"; > exit($refcount == 1 ? 0 : $refcount); > > --- > > On 5.28, the refcount for $fh is 2. But in 5.20, the refcount is 1.
Running the above I don't see that in 5.27.7 and above: $ perl5200 ~/tmp/p REF=1 $ perl5220 ~/tmp/p REF=2 $ perl5240 ~/tmp/p REF=2 $ perl5260 ~/tmp/p REF=2 $ perl5275 ~/tmp/p REF=2 $ perl5276 ~/tmp/p REF=2 $ perl5277 ~/tmp/p REF=1 $ perl5278 ~/tmp/p REF=1 $ perl5280 ~/tmp/p REF=1 $ perl5294 ~/tmp/p REF=1 -- 31 December 1661: "I have newly taken a solemne oath about abstaining from plays". 1 January 1662: "And after ... we went by coach to the play". -- The Diary of Samuel Pepys
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.4k
Which means it was fixed in: commit db9848c8d3fb321d27f38c1bd7992005a77ccfbc (refs/bisect/bad) Author: Zefram <zefram@fysh.org> Date: Sun Dec 10 01:34:04 2017 +0000 stop gensyming when vivifying IO handles When open() is given as a handle a scalar with undef value, the rv2gv op creates a new glob for the I/O handle, and mutates the scalar to contain an RV referencing the glob. This is documented behaviour. The question arises of what GvNAME the glob should have. There's some compile-time logic that spots that this might happen, and if the handle expression is simple enough it stores in the pad a name representing that expression, and rv2gv uses that for the GvNAME. But if no name was supplied by that route then rv2gv was using newGVgen() to generate the glob. That succeeds in giving it some kind of name, but has the unwanted side effect of interning the glob in the stash under that name. From the user's point of view, that creates a phantom reference to the glob, which means that killing the RV doesn't remove the last reference to the glob and so doesn't close the handle. Instead of gensyming, just create an uninterned glob and give it a fixed GvNAME. Fixes [perl #115814]. pp.c | 12 +++++------- t/io/open.t | 29 ++++++++++++++++++++++++++--- t/op/coreamp.t | 2 +- 3 files changed, 32 insertions(+), 11 deletions(-)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 282b
The only other action I can see here is to make sure we have a test for this. I need to look into the tests some more. The tests added in that commit are a skip and I'm not clear if we'll detect the refcount issue the next time this happens. I'll try to check them later this week.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 399b
On Tue, 20 Nov 2018 08:14:16 -0800, todd.e.rinaldo@gmail.com wrote: Show quoted text
> The only other action I can see here is to make sure we have a test > for this. I need to look into the tests some more. The tests added in > that commit are a skip and I'm not clear if we'll detect the refcount > issue the next time this happens. > > I'll try to check them later this week.
Something like the attached? Tony
Subject: 0001-perl-133660-add-test-for-goto-sub-in-overload-leakin.patch
From 88f17ff8910eefba68388fbf055d9d31f822c641 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 6 Feb 2019 15:42:10 +1100 Subject: (perl #133660) add test for goto &sub in overload leaking The bug in this case was fixed in db9848c8d. --- t/op/svleak.t | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/t/op/svleak.t b/t/op/svleak.t index 3283c95cbf..bfa6747a02 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -15,7 +15,7 @@ BEGIN { use Config; -plan tests => 149; +plan tests => 150; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -625,3 +625,23 @@ SKIP: { sub Regex_Key_Leak { my ($r)= keys %rh; "foo"=~$r; } leak 2, 0, \&Regex_Key_Leak,"RT #132892 - regex patterns should not leak"; } + +{ + # perl #133660 + fresh_perl_is(<<'PERL', "ok", {}, "check goto core sub doesn't leak"); +# done this way to avoid overloads for all of svleak.t +use B; +BEGIN { + *CORE::GLOBAL::open = sub (*;$@) { + goto \&CORE::open; + }; +} + +my $refcount; +{ + open(my $fh, '<', 'TEST'); + my $sv = B::svref_2object($fh); + print $sv->REFCNT == 1 ? "ok" : "not ok"; +} +PERL +} -- 2.11.0
RT-Send-CC: perl5-porters [...] perl.org
On Tue, 05 Feb 2019 20:42:46 -0800, tonyc wrote: Show quoted text
> On Tue, 20 Nov 2018 08:14:16 -0800, todd.e.rinaldo@gmail.com wrote:
> > The only other action I can see here is to make sure we have a test > > for this. I need to look into the tests some more. The tests added in > > that commit are a skip and I'm not clear if we'll detect the refcount > > issue the next time this happens. > > > > I'll try to check them later this week.
> > Something like the attached? >
That's it! Fails on maint-5.26 as expected: # Failed test 142 - check goto core sub doesn't leak at ./test.pl line 1059 # got "not ok" # expected "ok" # PROG: # # # done this way to avoid overloads for all of svleak.t # use B; # BEGIN { # *CORE::GLOBAL::open = sub (*;$@) { # goto \&CORE::open; # }; # } # # my $refcount; # { # open(my $fh, '<', 'TEST'); # my $sv = B::svref_2object($fh); # print $sv->REFCNT == 1 ? "ok" : "not ok"; # } # STATUS: 0 And passes on maint-5.28 ok 150 - check goto core sub doesn't leak I'll let you do the honors. Thanks, Todd
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.2k
On Thu, 07 Feb 2019 06:46:10 -0800, todd.e.rinaldo@gmail.com wrote: Show quoted text
> On Tue, 05 Feb 2019 20:42:46 -0800, tonyc wrote:
> > On Tue, 20 Nov 2018 08:14:16 -0800, todd.e.rinaldo@gmail.com wrote:
> > > The only other action I can see here is to make sure we have a test > > > for this. I need to look into the tests some more. The tests added in > > > that commit are a skip and I'm not clear if we'll detect the refcount > > > issue the next time this happens. > > > > > > I'll try to check them later this week.
> > > > Something like the attached? > >
> > That's it! > > Fails on maint-5.26 as expected: > > # Failed test 142 - check goto core sub doesn't leak at ./test.pl line 1059 > # got "not ok" > # expected "ok" > # PROG: > # > # # done this way to avoid overloads for all of svleak.t > # use B; > # BEGIN { > # *CORE::GLOBAL::open = sub (*;$@) { > # goto \&CORE::open; > # }; > # } > # > # my $refcount; > # { > # open(my $fh, '<', 'TEST'); > # my $sv = B::svref_2object($fh); > # print $sv->REFCNT == 1 ? "ok" : "not ok"; > # } > # STATUS: 0 > > And passes on maint-5.28 > > ok 150 - check goto core sub doesn't leak > > I'll let you do the honors.
Applied as ac6d2595875ea2813009c120fd54eb70c9ed2b0a. Tony
Download (untitled) / with headers
text/plain 313b
Thank you for filing this report. You have helped make Perl better. With the release today of Perl 5.30.0, this and 160 other issues have been resolved. Perl 5.30.0 may be downloaded via: https://metacpan.org/release/XSAWYERX/perl-5.30.0 If you find that the problem persists, feel free to reopen this ticket.


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