commit c367bfcf005b8eba873800a0a3a8c7e983a1bc30
Author: Petr Písař <ppisar@xxxxxxxxxx>
Date: Wed Apr 10 14:55:00 2013 +0200
Fix leaking tied hashes
...n-t-leak-deleted-iterator-when-tying-hash.patch | 60 +++++++++++
perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch | 109 ++++++++++++++++++++
...16.3-Free-iterator-when-freeing-tied-hash.patch | 78 ++++++++++++++
perl.spec | 16 +++-
4 files changed, 262 insertions(+), 1 deletions(-)
---
diff --git a/perl-5.16.3-Don-t-leak-deleted-iterator-when-tying-hash.patch b/perl-5.16.3-Don-t-leak-deleted-iterator-when-tying-hash.patch
new file mode 100644
index 0000000..7280612
--- /dev/null
+++ b/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@xxxxxxxx>
+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
+
diff --git a/perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch b/perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch
new file mode 100644
index 0000000..eb350b6
--- /dev/null
+++ b/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@xxxxxxxx>
+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
+
diff --git a/perl-5.16.3-Free-iterator-when-freeing-tied-hash.patch b/perl-5.16.3-Free-iterator-when-freeing-tied-hash.patch
new file mode 100644
index 0000000..947fbcd
--- /dev/null
+++ b/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@xxxxxxxx>
+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
+
diff --git a/perl.spec b/perl.spec
index 896c4e7..4c22355 100644
--- a/perl.spec
+++ b/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@xxxxxxxxxx> - 4:5.16.3-270
+- Fix leaking tied hashes (bug #859910)
+
* Tue Apr 09 2013 Petr Pisar <ppisar@xxxxxxxxxx> - 4:5.16.3-269
- Sub-package Sys-Syslog (bug #950057)
--
Fedora Extras Perl SIG
http://www.fedoraproject.org/wiki/Extras/SIGs/Perl
perl-devel mailing list
perl-devel@xxxxxxxxxxxxxxxxxxxxxxx
https://admin.fedoraproject.org/mailman/listinfo/perl-devel
