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