goto refcount increased by one when using goto

[p5pRT]

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

Searchable as RT133660$

[p5pRT]

From @toddr

Created by @toddr

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.

Perl Info

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

[p5pRT]

From @toddr

I was able to automatically bisect this to 7bdb4ff which first showed up in v5.21.10.

commit 7bdb4ff (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 2c8ac47.

pp.c | 1 +
t/op/gv.t | 14 +++++++++++++-
2 files changed, 14 insertions(+), 1 deletion(-)

[p5pRT]

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

[p5pRT]

From @iabyn

On Thu, Nov 15, 2018 at 10​:38​:36AM -0800, Todd Rinaldo (via RT) wrote​:

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

[p5pRT]

From @toddr

Which means it was fixed in​:

commit db9848c (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(-)

[p5pRT]

From @toddr

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.

[p5pRT]

From @tonycoz

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?

Tony

[p5pRT]

From @tonycoz

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

[p5pRT]

From @toddr

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.

Thanks,
Todd

[p5pRT]

From @tonycoz

On Thu, 07 Feb 2019 06​:46​:10 -0800, todd.e.rinaldo@​gmail.com wrote​:

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 ac6d259.

Tony

[p5pRT]

@tonycoz - Status changed from 'open' to 'pending release'

[p5pRT]

From @khwilliamson

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.

[p5pRT]

@khwilliamson - Status changed from 'pending release' to 'resolved'