segfault on &Internals::* due to missing SvROK()
authorÆvar Arnfjörð Bjarmason <avar@cpan.org>
Sat, 11 Sep 2010 09:58:02 +0000 (09:58 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Sep 2010 11:23:45 +0000 (12:23 +0100)
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
pod/perldelta.pod
t/lib/universal.t [new file with mode: 0644]
universal.c

index 7900589..e05d019 100644 (file)
--- 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"
index 4c34514..cb83c8c 100644 (file)
@@ -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 (file)
index 0000000..d8c0889
--- /dev/null
@@ -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.
+====
+}
index 6593501..6df104e 100644 (file)
@@ -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)));