Fix leaking tied hashes
This commit is contained in:
Petr Písař
parent
b177230d9a
commit
c367bfcf00
@ -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
|
||||
|
||||
109
perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch
Normal file
109
perl-5.16.3-Don-t-leak-if-hh-copying-dies.patch
Normal file
@ -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
|
||||
|
||||
78
perl-5.16.3-Free-iterator-when-freeing-tied-hash.patch
Normal file
78
perl-5.16.3-Free-iterator-when-freeing-tied-hash.patch
Normal file
@ -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
|
||||
|
||||
16
perl.spec
16
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)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user