Fix leaking tied hashes

perl-5.16.3-Don-t-leak-deleted-iterator-when-tying-hash.patch

@@ -0,0 +1,60 @@
+From 677ffc8fe97148750054b11e7fbd21c98f860ee1 Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <sprout@cpan.org>
+Date: Fri, 21 Sep 2012 18:23:20 -0700
+Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20leak=20deleted=20iterator=20whe?=
+ =?UTF-8?q?n=20tying=20hash?=
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Petr Pisar: ported to 5.16.3
+---
+ pp_sys.c   |  7 +++++++
+ t/op/tie.t | 13 +++++++++++++
+ 2 files changed, 20 insertions(+)
+
+diff --git a/pp_sys.c b/pp_sys.c
+index 034a2d0..0e35d59 100644
+--- a/pp_sys.c
++++ b/pp_sys.c
+@@ -852,9 +852,16 @@ PP(pp_tie)
+ 
+     switch(SvTYPE(varsv)) {
+ 	case SVt_PVHV:
++	{
++	    HE *entry;
+ 	    methname = "TIEHASH";
++	    if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) {
++		HvLAZYDEL_off(varsv);
++		hv_free_ent((HV *)varsv, entry);
++	    }
+ 	    HvEITER_set(MUTABLE_HV(varsv), 0);
+ 	    break;
++	}
+ 	case SVt_PVAV:
+ 	    methname = "TIEARRAY";
+ 	    if (!AvREAL(varsv)) {
+diff --git a/t/op/tie.t b/t/op/tie.t
+index 9301bb3..5a536b8 100644
+--- a/t/op/tie.t
++++ b/t/op/tie.t
+@@ -1259,3 +1259,16 @@ $h{i}{j} = 'k';
+ print $h{i}{j}, "\n";
+ EXPECT
+ k
++########
++
++# NAME Test that tying a hash does not leak a deleted iterator
++# This produced unbalanced string table warnings under
++# PERL_DESTRUCT_LEVEL=2.
++package l {
++    sub TIEHASH{bless[]}
++}
++$h = {foo=>0};
++each %$h;
++delete $$h{foo};
++tie %$h, 'l';
++EXPECT
+-- 
+1.8.1.4
+

perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch

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

perl-5.16.3-Free-iterator-when-freeing-tied-hash.patch

@@ -0,0 +1,78 @@
+From 316518b545904d368d703005f1622fde03349567 Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <sprout@cpan.org>
+Date: Fri, 21 Sep 2012 22:01:19 -0700
+Subject: [PATCH] Free iterator when freeing tied hash
+
+The current iterator was leaking when a tied hash was freed or
+undefined.
+
+Since we already have a mechanism, namely HvLAZYDEL, for freeing
+HvEITER when not referenced elsewhere, we can use that.
+
+Petr Pisar: Ported to 5.16.3.
+---
+ hv.c          |  3 +++
+ t/op/svleak.t | 15 ++++++++++++++-
+ 2 files changed, 17 insertions(+), 1 deletion(-)
+
+diff --git a/hv.c b/hv.c
+index a031703..3c35341 100644
+--- a/hv.c
++++ b/hv.c
+@@ -2346,6 +2346,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
+             if (entry) {
+                 sv_setsv(key, HeSVKEY_force(entry));
+                 SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
++		HeSVKEY_set(entry, NULL);
+             }
+             else {
+                 char *k;
+@@ -2353,6 +2354,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
+ 
+                 /* one HE per MAGICAL hash */
+                 iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
++		HvLAZYDEL_on(hv); /* make sure entry gets freed */
+                 Zero(entry, 1, HE);
+                 Newxz(k, HEK_BASESIZE + sizeof(const SV *), char);
+                 hek = (HEK*)k;
+@@ -2369,6 +2371,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
+             Safefree(HeKEY_hek(entry));
+             del_HE(entry);
+             iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
++	    HvLAZYDEL_off(hv);
+             return NULL;
+         }
+     }
+diff --git a/t/op/svleak.t b/t/op/svleak.t
+index 6cfee2e..2f09af3 100644
+--- a/t/op/svleak.t
++++ b/t/op/svleak.t
+@@ -13,7 +13,7 @@ BEGIN {
+ 	or skip_all("XS::APItest not available");
+ }
+ 
+-plan tests => 22;
++plan tests => 23;
+ 
+ # 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
+@@ -163,3 +163,16 @@ leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
+ 
+ # [perl #114764] Attributes leak scalars
+ leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak');
++
++# Tied hash iteration was leaking if the hash was freed before itera-
++# tion was over.
++package t {
++    sub TIEHASH { bless [] }
++    sub FIRSTKEY { 0 }
++}
++leak(2, 0, sub {
++    my $h = {};
++    tie %$h, t;
++    each %$h;
++    undef $h;
++}, 'tied hash iteration does not leak');
+-- 
+1.8.1.4
+

perl.spec

@@ -31,7 +31,7 @@
 Name:           perl
 Version:        %{perl_version}
 # release number must be even higher, because dual-lived modules will be broken otherwise
-Release:        269%{?dist}
+Release:        270%{?dist}
 Epoch:          %{perl_epoch}
 Summary:        Practical Extraction and Report Language
 Group:          Development/Languages
@@ -114,6 +114,11 @@ Patch20:        perl-5.17.6-Fix-misparsing-of-maketext-strings.patch
 # Add NAME heading into CPAN PODs, rhbz#908113, CPANRT#73396
 Patch21:        perl-5.16.2-cpan-CPAN-add-NAME-headings-in-modules-with-POD.patch
 
+# Fix leaking tied hashes, rhbz#859910, RT#107000, fixed after 5.17.4
+Patch22:        perl-5.16.3-Don-t-leak-deleted-iterator-when-tying-hash.patch
+Patch23:        perl-5.16.3-Free-iterator-when-freeing-tied-hash.patch
+Patch24:        perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch
+
 # Update some of the bundled modules
 # see http://fedoraproject.org/wiki/Perl/perl.spec for instructions
 
@@ -1822,6 +1827,9 @@ tarball from perl.org.
 %patch19 -p1
 %patch20 -p1
 %patch21 -p1
+%patch22 -p1
+%patch23 -p1
+%patch24 -p1
 
 #copy the example script
 cp -a %{SOURCE5} .
@@ -2033,6 +2041,9 @@ pushd %{build_archlib}/CORE/
     'Fedora Patch19: Do not crash when vivifying $|' \
     'Fedora Patch20: Fix misparsing of maketext strings (CVE-2012-6329)' \
     'Fedora Patch21: Add NAME headings to CPAN modules (CPANRT#73396)' \
+    'Fedora Patch22: Fix leaking tied hashes (RT#107000) [1]' \
+    'Fedora Patch23: Fix leaking tied hashes (RT#107000) [2]' \
+    'Fedora Patch24: Fix leaking tied hashes (RT#107000) [3]' \
     %{nil}
 
 rm patchlevel.bak
@@ -3472,6 +3483,9 @@ sed \
 
 # Old changelog entries are preserved in CVS.
 %changelog
+* Wed Apr 10 2013 Petr Pisar <ppisar@redhat.com> - 4:5.16.3-270
+- Fix leaking tied hashes (bug #859910)
+
 * Tue Apr 09 2013 Petr Pisar <ppisar@redhat.com> - 4:5.16.3-269
 - Sub-package Sys-Syslog (bug #950057)