292b33
From f5488561bdaab57380bf07e8e66778503a41aca3 Mon Sep 17 00:00:00 2001
292b33
From: Father Chrysostomos <sprout@cpan.org>
292b33
Date: Sun, 23 Sep 2012 12:42:15 -0700
292b33
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20if=20hh=20copying=20dies?=
292b33
MIME-Version: 1.0
292b33
Content-Type: text/plain; charset=UTF-8
292b33
Content-Transfer-Encoding: 8bit
292b33
292b33
When %^H is copied on entering a new scope, if it happens to have been
292b33
tied it can die.  This was resulting in leaks, because no protections
292b33
were added to handle that case.
292b33
292b33
The two things that were leaking were the new hash in hv_copy_hints_hv
292b33
and the new value (for an element) in newSVsv.
292b33
292b33
By fixing newSVsv itself, this also fixes any potential leaks when
292b33
other pieces of code call newSVsv on explosive values.
292b33
292b33
Petr Pisar: Ported to 5.16.3
292b33
---
292b33
 hv.c          |  6 ++++++
292b33
 sv.c          |  7 ++++---
292b33
 t/op/svleak.t | 22 +++++++++++++++++++++-
292b33
 3 files changed, 31 insertions(+), 4 deletions(-)
292b33
292b33
diff --git a/hv.c b/hv.c
292b33
index 3c35341..29d6352 100644
292b33
--- a/hv.c
292b33
+++ b/hv.c
292b33
@@ -1440,6 +1440,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
292b33
 	const I32 riter = HvRITER_get(ohv);
292b33
 	HE * const eiter = HvEITER_get(ohv);
292b33
 
292b33
+	ENTER;
292b33
+	SAVEFREESV(hv);
292b33
+
292b33
 	while (hv_max && hv_max + 1 >= hv_fill * 2)
292b33
 	    hv_max = hv_max / 2;
292b33
 	HvMAX(hv) = hv_max;
292b33
@@ -1461,6 +1464,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
292b33
 	}
292b33
 	HvRITER_set(ohv, riter);
292b33
 	HvEITER_set(ohv, eiter);
292b33
+
292b33
+	SvREFCNT_inc_simple_void_NN(hv);
292b33
+	LEAVE;
292b33
     }
292b33
     hv_magic(hv, NULL, PERL_MAGIC_hints);
292b33
     return hv;
292b33
diff --git a/sv.c b/sv.c
292b33
index a43feac..597d71b 100644
292b33
--- a/sv.c
292b33
+++ b/sv.c
292b33
@@ -8764,11 +8764,12 @@ Perl_newSVsv(pTHX_ register SV *const old)
292b33
 	Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
292b33
 	return NULL;
292b33
     }
292b33
+    /* Do this here, otherwise we leak the new SV if this croaks. */
292b33
+    SvGETMAGIC(old);
292b33
     new_SV(sv);
292b33
-    /* SV_GMAGIC is the default for sv_setv()
292b33
-       SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
292b33
+    /* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
292b33
        with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
292b33
-    sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL);
292b33
+    sv_setsv_flags(sv, old, SV_NOSTEAL);
292b33
     return sv;
292b33
 }
292b33
 
292b33
diff --git a/t/op/svleak.t b/t/op/svleak.t
292b33
index 2f09af3..011c184 100644
292b33
--- a/t/op/svleak.t
292b33
+++ b/t/op/svleak.t
292b33
@@ -13,7 +13,7 @@ BEGIN {
292b33
 	or skip_all("XS::APItest not available");
292b33
 }
292b33
 
292b33
-plan tests => 23;
292b33
+plan tests => 24;
292b33
 
292b33
 # run some code N times. If the number of SVs at the end of loop N is
292b33
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
292b33
@@ -176,3 +176,23 @@ leak(2, 0, sub {
292b33
     each %$h;
292b33
     undef $h;
292b33
 }, 'tied hash iteration does not leak');
292b33
+
292b33
+# [perl #107000]
292b33
+package hhtie {
292b33
+    sub TIEHASH { bless [] }
292b33
+    sub STORE    { $_[0][0]{$_[1]} = $_[2] }
292b33
+    sub FETCH    { die if $explosive; $_[0][0]{$_[1]} }
292b33
+    sub FIRSTKEY { keys %{$_[0][0]}; each %{$_[0][0]} }
292b33
+    sub NEXTKEY  { each %{$_[0][0]} }
292b33
+}
292b33
+leak(2,!!$Config{mad}, sub {
292b33
+    eval q`
292b33
+    	BEGIN {
292b33
+	    $hhtie::explosive = 0;
292b33
+	    tie %^H, hhtie;
292b33
+	    $^H{foo} = bar;
292b33
+	    $hhtie::explosive = 1;
292b33
+    	}
292b33
+	{ 1; }
292b33
+    `;
292b33
+}, 'hint-hash copying does not leak');
292b33
-- 
292b33
1.8.1.4
292b33