5.10.x 5.12.x segfault on &Internals::SvREADONLY(undef)

[p5pRT]

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

Searchable as RT77776$

[p5pRT]

From zzgrim@gmail.com

]$ perl -e'&Internals​::SvREADONLY(undef)'
Segmentation fault

]$ /opt/p5122/bin/perl -e'&Internals​::SvREADONLY( undef )'
Segmentation fault

]$ gdb debugperl
GNU gdb (GDB) 7.2-debian
Copyright (C) 2010 Free Software Foundation, Inc.
License GPLv3+​: GNU GPL version 3 or later <http​://gnu.org/licenses/gpl.html>
This is free software​: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law. Type "show copying"
and "show warranty" for details.
This GDB was configured as "i486-linux-gnu".
For bug reporting instructions, please see​:
<http​://www.gnu.org/software/gdb/bugs/>...
Reading symbols from /usr/bin/debugperl...done.
(gdb) r -e'&Internals​::SvREADONLY(undef)'
Starting program​: /usr/bin/debugperl -e'&Internals​::SvREADONLY(undef)'
[Thread debugging using libthread_db enabled]
Assertion ((svtype)((_svrv)->sv_flags & 0xff)) >= SVt_RV failed​: file "universal.c", line 908 at -e line 1.

Program exited with code 0377.

ignited by Josh "evil code" ben Jore :)
http​://blogs.perl.org/users/josh_ben_jore/2010/08/ponies-are-the-truth.html

perls used​:
Debian's
  perl 5.10.1-14
  perl-debug 5.10.1-14

  custom 5.10.1 nothreads
  custom 5.12.2 nothreads

All output​: Segmentation fault
Expected output​: slap user^W^Werror

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.10.1:

Configured by Debian Project at Fri Aug  6 10:46:59 UTC 2010.

Summary of my perl5 (revision 5 version 10 subversion 1) configuration:
   
  Platform:
    osname=linux, osvers=2.6.32.17-dsa-ia32, archname=i486-linux-gnu-thread-multi
    uname='linux murphy 2.6.32.17-dsa-ia32 #1 smp tue aug 3 15:32:33 cest 2010 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.10.1 -Dsitearch=/usr/local/lib/perl/5.10.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.10.1 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    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='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.4.5 20100728 (prerelease)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /usr/lib64
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.11.2.so, so=so, useshrplib=true, libperl=libperl.so.5.10.1
    gnulibc_version='2.11.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fstack-protector'

Locally applied patches:
    DEBPKG:debian/arm_thread_stress_timeout - http://bugs.debian.org/501970 Raise the timeout of ext/threads/shared/t/stress.t to accommodate slower build hosts
    DEBPKG:debian/cpan_config_path - Set location of CPAN::Config to /etc/perl as /usr may not be writable.
    DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
    DEBPKG:debian/db_file_ver - http://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
    DEBPKG:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
    DEBPKG:debian/enc2xs_inc - http://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories.
    DEBPKG:debian/errno_ver - http://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
    DEBPKG:debian/extutils_hacks - Various debian-specific ExtUtils changes
    DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
    DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
    DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
    DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
    DEBPKG:debian/m68k_thread_stress - http://bugs.debian.org/495826 Disable some threads tests on m68k for now due to missing TLS.
    DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
    DEBPKG:debian/module_build_man_extensions - http://bugs.debian.org/479460 Adjust Module::Build manual page extensions for the Debian Perl policy
    DEBPKG:debian/perl_synopsis - http://bugs.debian.org/278323 Rearrange perl.pod
    DEBPKG:debian/prune_libs - http://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
    DEBPKG:debian/use_gdbm - Explicitly link against -lgdbm_compat in ODBM_File/NDBM_File. 
    DEBPKG:fixes/assorted_docs - http://bugs.debian.org/443733 [384f06a] Math::BigInt::CalcEmu documentation grammar fix
    DEBPKG:fixes/net_smtp_docs - http://bugs.debian.org/100195 [rt.cpan.org #36038] Document the Net::SMTP 'Port' option
    DEBPKG:fixes/processPL - http://bugs.debian.org/357264 [rt.cpan.org #17224] Always use PERLRUNINST when building perl modules.
    DEBPKG:debian/perlivp - http://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
    DEBPKG:fixes/pod2man-index-backslash - http://bugs.debian.org/521256 Escape backslashes in .IX entries
    DEBPKG:debian/disable-zlib-bundling - Disable zlib bundling in Compress::Raw::Zlib
    DEBPKG:fixes/kfreebsd_cppsymbols - http://bugs.debian.org/533098 [3b910a0] Add gcc predefined macros to $Config{cppsymbols} on GNU/kFreeBSD.
    DEBPKG:debian/cpanplus_definstalldirs - http://bugs.debian.org/533707 Configure CPANPLUS to use the site directories by default.
    DEBPKG:debian/cpanplus_config_path - Save local versions of CPANPLUS::Config::System into /etc/perl.
    DEBPKG:fixes/kfreebsd-filecopy-pipes - http://bugs.debian.org/537555 [16f708c] Fix File::Copy::copy with pipes on GNU/kFreeBSD
    DEBPKG:fixes/anon-tmpfile-dir - http://bugs.debian.org/528544 [perl #66452] Honor TMPDIR when open()ing an anonymous temporary file
    DEBPKG:fixes/abstract-sockets - http://bugs.debian.org/329291 [89904c0] Add support for Abstract namespace sockets.
    DEBPKG:fixes/hurd_cppsymbols - http://bugs.debian.org/544307 [eeb92b7] Add gcc predefined macros to $Config{cppsymbols} on GNU/Hurd.
    DEBPKG:fixes/autodie-flock - http://bugs.debian.org/543731 Allow for flock returning EAGAIN instead of EWOULDBLOCK on linux/parisc
    DEBPKG:fixes/archive-tar-instance-error - http://bugs.debian.org/539355 [rt.cpan.org #48879] Separate Archive::Tar instance error strings from each other
    DEBPKG:fixes/positive-gpos - http://bugs.debian.org/545234 [perl #69056] [c584a96] Fix \\G crash on first match
    DEBPKG:debian/devel-ppport-ia64-optim - http://bugs.debian.org/548943 Work around an ICE on ia64
    DEBPKG:fixes/trie-logic-match - http://bugs.debian.org/552291 [perl #69973] [0abd0d7] Fix a DoS in Unicode processing [CVE-2009-3626]
    DEBPKG:fixes/hppa-thread-eagain - http://bugs.debian.org/554218 make the threads-shared test suite more robust, fixing failures on hppa
    DEBPKG:fixes/crash-on-undefined-destroy - http://bugs.debian.org/564074 [perl #71952] [1f15e67] Fix a NULL pointer dereference when looking for a DESTROY method
    DEBPKG:fixes/tainted-errno - http://bugs.debian.org/574129 [perl #61976] [be1cf43] fix an errno stringification bug in taint mode
    DEBPKG:fixes/safe-upgrade - http://bugs.debian.org/582978 Upgrade Safe.pm to 2.25, fixing CVE-2010-1974
    DEBPKG:fixes/tell-crash - http://bugs.debian.org/578577 [f4817f3] Fix a tell() crash on bad arguments.
    DEBPKG:fixes/format-write-crash - http://bugs.debian.org/579537 [perl #22977] [421f30e] Fix a crash in format/write
    DEBPKG:fixes/arm-alignment - http://bugs.debian.org/289884 [f1c7503] Prevent gcc from optimizing the alignment test away on armel
    DEBPKG:fixes/fcgi-test - Fix a failure in CGI/t/fast.t when FCGI is installed
    DEBPKG:fixes/hurd-ccflags - http://bugs.debian.org/587901 Make hints/gnu.sh append to $ccflags rather than overriding them
    DEBPKG:patchlevel - http://bugs.debian.org/567489 List packaged patches for 5.10.1-14 in patchlevel.h


@INC for perl 5.10.1:
    /etc/perl
    /usr/local/lib/perl/5.10.1
    /usr/local/share/perl/5.10.1
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.10
    /usr/share/perl/5.10
    /usr/local/lib/site_perl
    /usr/local/lib/perl/5.10.0
    /usr/local/share/perl/5.10.0
    .


Environment for perl 5.10.1:
    HOME=/home/zgrim
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_ALL=en_US.UTF-8
    LC_CTYPE=en_US.UTF-8
    LOGDIR (unset)
    PATH=/home/zgrim/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/bash

[p5pRT]

From @avar

On Fri, Sep 10, 2010 at 15​:49, zgrim <perlbug-followup@​perl.org> wrote​:

This is a bug report generated with the help of perlbug 1.39 running under perl 5.10.1.

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

]$ perl -e'&Internals​::SvREADONLY(undef)'
Segmentation fault

]$ /opt/p5122/bin/perl -e'&Internals​::SvREADONLY( undef )'
Segmentation fault

Thanks for the report. I've fixed this with the attached patch
(contains perldelta entry). The patch is also at​:

  http​://github.com/avar/perl/compare/mirrors​:blead...perl-77776
  http​://github.com/avar/perl/compare/mirrors​:blead...perl-77776.patch

All of these functions could segfault due to this bug​:

  &Internals​::SvREADONLY($arg);
  &Internals​::SvREFCNT($arg);
  &Internals​::hv_clear_placeholders($arg);
  &Internals​::HvREHASH($arg);

The fix was just to call SvROK() before doing SvRV().

This patch is a canditate for backporting down to 5.10, 5.12, and
maybe 5.8 if anyone still cares.

[p5pRT]

From @avar

0001-perl-77776-segfault-on-Internals-due-to-missing-SvRO.patch

From 8ef38feeefce1971f6b75cc3077cf127c640bea4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avar@cpan.org>
Date: Sat, 11 Sep 2010 09:58:02 +0000
Subject: [PATCH] [perl #77776] segfault on &Internals::* due to missing SvROK()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Change the &Internals::* functions that use references in their
prototypes to check if the argument is SvROK() before calling SvRV().

If the function is called as Internals::FOO() perl does this check for
us, but prototypes are bypassed on &Internals::FOO() so we still have
to check this manually.

This fixes [perl #77776], this bug was present in 5.10.x, 5.12.x, and
probably all earlier perl versions that had these functions, but I
haven't tested that.

I'm adding a new test file (t/lib/universal.t) to test universal.c
functions as part of this patch. The testing for Internal::* in t/ was
and is very sparse, but before universal.t there was no obvious place
to put these tests.

Signed-off-by: Ævar Arnfjörð Bjarmason <avar@cpan.org>
---
 MANIFEST          |    1 +
 pod/perldelta.pod |   10 ++++++++++
 t/lib/universal.t |   25 +++++++++++++++++++++++++
 universal.c       |   20 +++++++++++++++++---
 4 files changed, 53 insertions(+), 3 deletions(-)
 create mode 100644 t/lib/universal.t

diff --git a/MANIFEST b/MANIFEST
index 7900589..e05d019 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4412,6 +4412,7 @@ t/lib/strict/vars		Tests of "use strict 'vars'" for strict.t
 t/lib/subs/subs			Tests of "use subs"
 t/lib/test_use_14937.pm		A test pragma for t/comp/use.t
 t/lib/test_use.pm		A test pragma for t/comp/use.t
+t/lib/universal.t		Tests for functions in universal.c
 t/lib/warnings/1global		Tests of global warnings for warnings.t
 t/lib/warnings/2use		Tests for "use warnings" for warnings.t
 t/lib/warnings/3both		Tests for interaction of $^W and "use warnings"
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 4c34514..cb83c8c 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -543,6 +543,16 @@ fixed [perl #21469]. This means the following code will no longer crash:
         *x = *y;
     }
 
+=item *
+
+Perl would segfault if the undocumented C<Internals> functions that
+used reference prototypes were called with the C<&foo()> syntax,
+e.g. C<&Internals::SvREADONLY(undef)> [perl #77776].
+
+These functions now call C<SvROK> on their arguments before
+dereferencing them with C<SvRV>, and we test for this case in
+F<t/lib/universal.t>.
+
 =back
 
 =head1 Known Problems
diff --git a/t/lib/universal.t b/t/lib/universal.t
new file mode 100644
index 0000000..d8c0889
--- /dev/null
+++ b/t/lib/universal.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# Test the Internal::* functions and other tibits in universal.c
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+    plan( tests => 4 );
+}
+
+for my $arg ('', 'q[]', qw( 1 undef )) {
+    fresh_perl_is(<<"----", <<'====', "Internals::* functions check their argument under func() AND &func() [perl #77776]");
+sub tryit { eval shift or warn \$@ }
+tryit "&Internals::SvREADONLY($arg)";
+tryit "&Internals::SvREFCNT($arg)";
+tryit "&Internals::hv_clear_placeholders($arg)";
+tryit "&Internals::HvREHASH($arg)";
+----
+Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1.
+Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1.
+Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
+Internals::HvREHASH $hashref at (eval 4) line 1.
+====
+}
diff --git a/universal.c b/universal.c
index 6593501..6df104e 100644
--- a/universal.c
+++ b/universal.c
@@ -794,9 +794,16 @@ XS(XS_Internals_SvREADONLY)	/* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
-    SV * const sv = SvRV(ST(0));
+    SV * const svz = ST(0);
+    SV * sv;
     PERL_UNUSED_ARG(cv);
 
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz))
+        croak_xs_usage(cv, "SCALAR[, ON]");
+
+    sv = SvRV(svz);
+
     if (items == 1) {
 	 if (SvREADONLY(sv))
 	     XSRETURN_YES;
@@ -821,9 +828,16 @@ XS(XS_Internals_SvREFCNT)	/* This is dangerous stuff. */
 {
     dVAR;
     dXSARGS;
-    SV * const sv = SvRV(ST(0));
+    SV * const svz = ST(0);
+    SV * sv;
     PERL_UNUSED_ARG(cv);
 
+    /* [perl #77776] - called as &foo() not foo() */
+    if (!SvROK(svz))
+        croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
+
+    sv = SvRV(svz);
+
     if (items == 1)
 	 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
     else if (items == 2) {
@@ -839,7 +853,7 @@ XS(XS_Internals_hv_clear_placehold)
     dVAR;
     dXSARGS;
 
-    if (items != 1)
+    if (items != 1 || !SvROK(ST(0)))
 	croak_xs_usage(cv, "hv");
     else {
 	HV * const hv = MUTABLE_HV(SvRV(ST(0)));
-- 
1.7.2.3.313.gcd15

[p5pRT]

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

[p5pRT]

From @nwc10

On Sat, Sep 11, 2010 at 10​:50​:17AM +0000, Ævar Arnfjörð Bjarmason wrote​:

Thanks for the report. I've fixed this with the attached patch
(contains perldelta entry). The patch is also at​:

Thanks, applied as 80b6a94

This patch is a canditate for backporting down to 5.10, 5.12, and
maybe 5.8 if anyone still cares.

Realistically, I think that's "5.12, and if anyone cares 5.10 or earlier",
because I see no activity on a 5.10.2, and no-one looks like volunteering.

Nicholas Clark

[p5pRT]

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