In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/207cc8dfc710475ee7d8b4dd64a522bd1cf442d3?hp=dc88277553b8a9ac3a811430ac94cdcd73f44e69>
- Log -----------------------------------------------------------------
commit 207cc8dfc710475ee7d8b4dd64a522bd1cf442d3
Author: David Mitchell <da...@iabyn.com>
Date: Tue Apr 16 16:49:47 2019 +0100
fix leak when $LANG unset
The following leaked:
LANG= perl -e1
because in S_emulate_setlocale(), it was
1) making a copy of $ENV{"LANG"};
2) throwing that copy away and replacing it with "C" when it discovered
that the string was empty.
A little judicious reordering of that chunk of code makes the issue go
away.
Showed up as failures of lib/locale_threads.t under valgrind / ASan.
commit 2bfe2a2773c59588ac2bf11b5d9439c92d86fb62
Author: David Mitchell <da...@iabyn.com>
Date: Tue Apr 16 15:48:39 2019 +0100
fix locale leaks on utf8 strings
For example the following leaked:
require POSIX; import POSIX ':locale_h';
setlocale(&POSIX::LC_ALL, 'aa_DJ.iso88591') or die;
use locale;
my $ok = 'A' lt chr 0x100;
Some code in Perl__mem_collxfrm() does a couple of
for (j = 1; j < 256; j++) { ... }
loops where for each chr(j) character it recursively calls itself, and
records the index of the 'smallest' / 'largest' result. However, when
updating cur_min_x / cur_max_x, it wasn't freeing the previous value.
The symptoms were that valgrind / Address Sanitizer found fault with
lib/locale.t
commit 44955e7de88913c476b06c9046ed65775b693da7
Author: David Mitchell <da...@iabyn.com>
Date: Tue Apr 16 15:28:16 2019 +0100
fix locale leak on zero-length strings
For example the following leaked:
use locale;
my $le = "" le "";
When a comparison is done within locale scope, PERL_MAGIC_collxfrm
magic is added to the SV. However, the value set for mg_len is the length
of the collated string, not the malloced size of the buffer. This means
that mg_len can be set to zero, which by convention, means that mg_ptr
shouldn't be freed.
For now, fix by putting special-cased code in S_mg_free_struct. After
5.30.0 is out, I'll probably add a PERL_MAGIC_collxfrm-specific svt_free
vtable method.
The symptoms were that valgrind / Address Sanitizer found fault with
lib/locale.t
-----------------------------------------------------------------------
Summary of changes:
locale.c | 21 ++++++++++-----------
mg.c | 8 +++++++-
2 files changed, 17 insertions(+), 12 deletions(-)
diff --git a/locale.c b/locale.c
index 81aa00e33f..c3ce587981 100644
--- a/locale.c
+++ b/locale.c
@@ -769,22 +769,19 @@ S_emulate_setlocale(const int category,
const char * default_name;
- /* To minimize other threads messing with the environment, we copy
- * the variable, making it a temporary. But this doesn't work upon
- * program initialization before any scopes are created, and at
- * this time, there's nothing else going on that would interfere.
- * So skip the copy in that case */
- if (PL_scopestack_ix == 0) {
- default_name = PerlEnv_getenv("LANG");
- }
- else {
- default_name = savepv(PerlEnv_getenv("LANG"));
- }
+ default_name = PerlEnv_getenv("LANG");
if (! default_name || strEQ(default_name, "")) {
default_name = "C";
}
else if (PL_scopestack_ix != 0) {
+ /* To minimize other threads messing with the environment,
+ * we copy the variable, making it a temporary. But this
+ * doesn't work upon program initialization before any
+ * scopes are created, and at this time, there's nothing
+ * else going on that would interfere. So skip the copy
+ * in that case */
+ default_name = savepv(default_name);
SAVEFREEPV(default_name);
}
@@ -3951,6 +3948,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
cur_min_x + COLLXFRM_HDR_LEN))
{
PL_strxfrm_NUL_replacement = j;
+ safefree(cur_min_x);
cur_min_x = x;
}
else {
@@ -4106,6 +4104,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
cur_max_x + COLLXFRM_HDR_LEN))
{
PL_strxfrm_max_cp = j;
+ safefree(cur_max_x);
cur_max_x = x;
}
else {
diff --git a/mg.c b/mg.c
index 320e2d39bb..afe452fc5d 100644
--- a/mg.c
+++ b/mg.c
@@ -556,12 +556,18 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
const MGVTBL* const vtbl = mg->mg_virtual;
if (vtbl && vtbl->svt_free)
vtbl->svt_free(aTHX_ sv, mg);
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
+
+ if (mg->mg_type == PERL_MAGIC_collxfrm && mg->mg_len >= 0)
+ /* collate magic uses string len not buffer len, so
+ * free even with mg_len == 0 */
+ Safefree(mg->mg_ptr);
+ else if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8)
Safefree(mg->mg_ptr);
else if (mg->mg_len == HEf_SVKEY)
SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
}
+
if (mg->mg_flags & MGf_REFCOUNTED)
SvREFCNT_dec(mg->mg_obj);
Safefree(mg);
--
Perl5 Master Repository
