Skip to content

Commit

Permalink
[perl #107000] Don’t leak if hh copying dies
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
Father Chrysostomos committed Sep 24, 2012
1 parent 518618a commit 0db511c
Show file tree
Hide file tree
Showing 3 changed files with 30 additions and 4 deletions.
6 changes: 6 additions & 0 deletions hv.c
Expand Up @@ -1462,6 +1462,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;
Expand All @@ -1483,6 +1486,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;
Expand Down
7 changes: 4 additions & 3 deletions sv.c
Expand Up @@ -8709,11 +8709,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;
}

Expand Down
21 changes: 20 additions & 1 deletion t/op/svleak.t
Expand Up @@ -15,7 +15,7 @@ BEGIN {

use Config;

plan tests => 31;
plan tests => 32;

# 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
Expand Down Expand Up @@ -217,3 +217,22 @@ leak(2, 0, sub {
eval {@a = ($x)};
}, 'array assignment 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');

0 comments on commit 0db511c

Please sign in to comment.