Fix a memory leak when a magic throws an exception

This commit is contained in:
Petr Písař 2020-08-20 12:27:02 +02:00
parent 86fcb5e476
commit 126ad9fb2f
4 changed files with 368 additions and 1 deletions

View File

@ -0,0 +1,243 @@
From 900c00b2ae29aa10b5cf0b3b5c55aff7501fc382 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 12 Aug 2020 16:20:16 +1000
Subject: [PATCH 3/3] Data::Dumper (XS): use mortals to prevent leaks if magic
throws
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
For example:
use Tie::Scalar;
use Data::Dumper;
sub T::TIESCALAR { bless {}, shift}
sub T::FETCH { die }
my $x;
tie $x, "T" or die;
while(1) {
eval { () = Dumper( [ \$x ] ) };
}
would leak various work SVs.
I start a new scope (ENTER/LEAVE) for most recursive DD_dump() calls
so that the work SVs don't accumulate on the temps stack, for example
if we're dumping a large array we'd end up with several SVs on the
temp stack for each member of the array.
The exceptions are where I don't expect a large number of unreleased
temps to accumulate, as with scalar or glob refs.
Petr Písař: Ported to Data-Dumper-2.173 from
815b4be4ab7ae210f796fc9d29754e55fc0d1f0e perl commit.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Dumper.xs | 52 ++++++++++++++++++++++++++++------------------------
1 file changed, 28 insertions(+), 24 deletions(-)
diff --git a/Dumper.xs b/Dumper.xs
index d4b34ad..65639ae 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -808,12 +808,13 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(retval, "( ");
if (style->indent >= 2) {
blesspad = apad;
- apad = newSVsv(apad);
+ apad = sv_2mortal(newSVsv(apad));
sv_x(aTHX_ apad, " ", 1, blesslen+2);
}
}
ipad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad), SvCUR(style->xpad), level+1);
+ sv_2mortal(ipad);
if (is_regex)
{
@@ -878,7 +879,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
realtype <= SVt_PVMG
#endif
) { /* scalar ref */
- SV * const namesv = newSVpvs("${");
+ SV * const namesv = sv_2mortal(newSVpvs("${"));
sv_catpvn(namesv, name, namelen);
sv_catpvs(namesv, "}");
if (realpack) { /* blessed */
@@ -892,7 +893,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
postav, level+1, apad, style);
}
- SvREFCNT_dec(namesv);
}
else if (realtype == SVt_PVGV) { /* glob ref */
SV * const namesv = newSVpvs("*{");
@@ -908,9 +908,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
SSize_t ix = 0;
const SSize_t ixmax = av_len((AV *)ival);
- SV * const ixsv = newSViv(0);
+ SV * const ixsv = sv_2mortal(newSViv(0));
/* allowing for a 24 char wide array index */
New(0, iname, namelen+28, char);
+ SAVEFREEPV(iname);
(void) strlcpy(iname, name, namelen+28);
inamelen = namelen;
if (name[0] == '@') {
@@ -940,7 +941,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
iname[inamelen++] = '-'; iname[inamelen++] = '>';
}
iname[inamelen++] = '['; iname[inamelen] = '\0';
- totpad = newSVsv(style->sep);
+ totpad = sv_2mortal(newSVsv(style->sep));
sv_catsv(totpad, style->pad);
sv_catsv(totpad, apad);
@@ -970,8 +971,12 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
sv_catsv(retval, totpad);
sv_catsv(retval, ipad);
+ ENTER;
+ SAVETMPS;
DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
level+1, apad, style);
+ FREETMPS;
+ LEAVE;
if (ix < ixmax || (style->trailingcomma && style->indent >= 1))
sv_catpvs(retval, ",");
}
@@ -985,9 +990,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(retval, ")");
else
sv_catpvs(retval, "]");
- SvREFCNT_dec(ixsv);
- SvREFCNT_dec(totpad);
- Safefree(iname);
}
else if (realtype == SVt_PVHV) {
SV *totpad, *newapad;
@@ -997,7 +999,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
SV *hval;
AV *keys = NULL;
- SV * const iname = newSVpvn(name, namelen);
+ SV * const iname = newSVpvn_flags(name, namelen, SVs_TEMP);
if (name[0] == '%') {
sv_catpvs(retval, "(");
(SvPVX(iname))[0] = '$';
@@ -1021,7 +1023,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(iname, "->");
}
sv_catpvs(iname, "{");
- totpad = newSVsv(style->sep);
+ totpad = sv_2mortal(newSVsv(style->sep));
sv_catsv(totpad, style->pad);
sv_catsv(totpad, apad);
@@ -1117,6 +1119,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catsv(retval, totpad);
sv_catsv(retval, ipad);
+
+ ENTER;
+ SAVETMPS;
+
/* The (very)
old logic was first to check utf8 flag, and if utf8 always
call esc_q_utf8. This caused test to break under -Mutf8,
@@ -1143,6 +1149,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
else {
nticks = num_q(key, klen);
New(0, nkey_buffer, klen+nticks+3, char);
+ SAVEFREEPV(nkey_buffer);
nkey = nkey_buffer;
nkey[0] = '\'';
if (nticks)
@@ -1160,7 +1167,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
nlen = klen;
sv_catpvn(retval, nkey, klen);
}
- sname = newSVsv(iname);
+
+ sname = sv_2mortal(newSVsv(iname));
sv_catpvn(sname, nkey, nlen);
sv_catpvs(sname, "}");
@@ -1168,7 +1176,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (style->indent >= 2) {
char *extra;
STRLEN elen = 0;
- newapad = newSVsv(apad);
+ newapad = sv_2mortal(newSVsv(apad));
New(0, extra, klen+4+1, char);
while (elen < (klen+4))
extra[elen++] = ' ';
@@ -1181,10 +1189,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
postav, level+1, newapad, style);
- SvREFCNT_dec(sname);
- Safefree(nkey_buffer);
- if (style->indent >= 2)
- SvREFCNT_dec(newapad);
+
+ FREETMPS;
+ LEAVE;
}
if (i) {
SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad),
@@ -1199,8 +1206,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(retval, ")");
else
sv_catpvs(retval, "}");
- SvREFCNT_dec(iname);
- SvREFCNT_dec(totpad);
}
else if (realtype == SVt_PVCV) {
if (style->deparse) {
@@ -1247,7 +1252,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
STRLEN plen, pticks;
if (style->indent >= 2) {
- SvREFCNT_dec(apad);
apad = blesspad;
}
sv_catpvs(retval, ", '");
@@ -1276,7 +1280,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(retval, "()");
}
}
- SvREFCNT_dec(ipad);
}
else {
STRLEN i;
@@ -1671,20 +1674,21 @@ Data_Dumper_Dumpxs(href, ...)
if (style.indent >= 2 && !terse) {
SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
- newapad = newSVsv(apad);
+ newapad = sv_2mortal(newSVsv(apad));
sv_catsv(newapad, tmpsv);
SvREFCNT_dec(tmpsv);
}
else
newapad = apad;
+ ENTER;
+ SAVETMPS;
PUTBACK;
DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
postav, 0, newapad, &style);
SPAGAIN;
-
- if (style.indent >= 2 && !terse)
- SvREFCNT_dec(newapad);
+ FREETMPS;
+ LEAVE;
postlen = av_len(postav);
if (postlen >= 0 || !terse) {
--
2.25.4

View File

@ -0,0 +1,56 @@
From 65ec73b1bc79648a2daeb494552ce0b0b90348d7 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 10 Aug 2020 16:26:30 +1000
Subject: [PATCH 1/3] Data::Dumper: don't leak the working retval
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
do this by mortalizing the SV on creation, rather than when we
push it on the stack
Petr Písař: Ported to Data-Dumper-2.173 from
41463160be4baa0d81d9d8297508a1b9bdcaa206 perl commit.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Dumper.xs | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/Dumper.xs b/Dumper.xs
index a324cb6..f91145a 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -1541,7 +1541,7 @@ Data_Dumper_Dumpxs(href, ...)
seenhv = NULL;
name = sv_newmortal();
- retval = newSVpvs("");
+ retval = newSVpvs_flags("", SVs_TEMP);
if (SvROK(href)
&& (hv = (HV*)SvRV((SV*)href))
&& SvTYPE(hv) == SVt_PVHV) {
@@ -1714,9 +1714,9 @@ Data_Dumper_Dumpxs(href, ...)
}
SvPVCLEAR(valstr);
if (gimme == G_ARRAY) {
- XPUSHs(sv_2mortal(retval));
+ XPUSHs(retval);
if (i < imax) /* not the last time thro ? */
- retval = newSVpvs("");
+ retval = newSVpvs_flags("", SVs_TEMP);
}
}
SvREFCNT_dec(postav);
@@ -1732,7 +1732,7 @@ Data_Dumper_Dumpxs(href, ...)
else
croak("Call to new() method failed to return HASH ref");
if (gimme != G_ARRAY)
- XPUSHs(sv_2mortal(retval));
+ XPUSHs(retval);
}
SV *
--
2.25.4

View File

@ -0,0 +1,53 @@
From 21e67795792e5e1d25bcbd3b167ed18d0d6dc7b4 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 11 Aug 2020 10:46:38 +1000
Subject: [PATCH 2/3] make postav and valstr mortal so they're freed soonish
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
these can leak if the value being dumped (or any part of it)
had get magic and that magic throws an exception.
Several other SVs can also leak in that case, but cleaning those up
is more complex.
Petr Písař: Ported to Data-Dumper-2.173 from
b98a3a6d08f681353d0b357fd1cce437c93656e7 perl commit.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Dumper.xs | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
diff --git a/Dumper.xs b/Dumper.xs
index f91145a..d4b34ad 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -1613,12 +1613,13 @@ Data_Dumper_Dumpxs(href, ...)
style.sortkeys = &PL_sv_yes;
}
postav = newAV();
+ sv_2mortal((SV*)postav);
if (todumpav)
imax = av_len(todumpav);
else
imax = -1;
- valstr = newSVpvs("");
+ valstr = newSVpvs_flags("", SVs_TEMP);
for (i = 0; i <= imax; ++i) {
SV *newapad;
@@ -1719,8 +1720,6 @@ Data_Dumper_Dumpxs(href, ...)
retval = newSVpvs_flags("", SVs_TEMP);
}
}
- SvREFCNT_dec(postav);
- SvREFCNT_dec(valstr);
/* we defer croaking until here so that temporary SVs and
* buffers won't be leaked */
--
2.25.4

View File

@ -2,7 +2,7 @@
Name: perl-Data-Dumper
Version: 2.174
Release: 458%{?dist}
Release: 459%{?dist}
Summary: Stringify perl data structures, suitable for printing and eval
License: GPL+ or Artistic
URL: https://metacpan.org/release/Data-Dumper
@ -10,6 +10,15 @@ Source0: https://cpan.metacpan.org/authors/id/X/XS/XSAWYERX/Data-Dumper-%
# Fix a memory leak when croaking about a too deep recursion,
# fixed in perl after 5.29.9
Patch0: Data-Dumper-2.173-Data-Dumper-avoid-leak-on-croak.patch
# 1/3 Fix a memory leak when a magic throws an exception,
# fixed in perl after 5.33.0
Patch1: Data-Dumper-2.173-Data-Dumper-don-t-leak-the-working-retval.patch
# 2/3 Fix a memory leak when a magic throws an exception,
# fixed in perl after 5.33.0
Patch2: Data-Dumper-2.173-make-postav-and-valstr-mortal-so-they-re-freed-sooni.patch
# 3/3 Fix a memory leak when a magic throws an exception,
# fixed in perl after 5.33.0
Patch3: Data-Dumper-2.173-Data-Dumper-XS-use-mortals-to-prevent-leaks-if-magic.patch
BuildRequires: findutils
BuildRequires: gcc
BuildRequires: make
@ -58,6 +67,9 @@ structures correctly.
%prep
%setup -q -n Data-Dumper-%{base_version}
%patch0 -p1
%patch1 -p1
%patch2 -p1
%patch3 -p1
%build
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS"
@ -80,6 +92,9 @@ make test
%{_mandir}/man3/*
%changelog
* Thu Aug 20 2020 Petr Pisar <ppisar@redhat.com> - 2.174-459
- Fix a memory leak when a magic throws an exception
* Tue Jul 28 2020 Fedora Release Engineering <releng@fedoraproject.org> - 2.174-458
- Rebuilt for https://fedoraproject.org/wiki/Fedora_33_Mass_Rebuild