This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[RT #129069] Perl_yylex: Fix two use-after-free bugs
authorDan Collins <dcollinsn@gmail.com>
Wed, 24 Aug 2016 18:19:09 +0000 (14:19 -0400)
committerTony Cook <tony@develop-help.com>
Mon, 29 Aug 2016 06:04:29 +0000 (16:04 +1000)
Perl_yylex maintains up to two pointers, `s` and `d`, into the parser
buffer at PL_bufptr. It can call skipspace(), which can potentially
grow (and realloc) its argument. This can leave the second pointer
pointing at the old buffer. Under most cases it isn't visible, because
the old buffer isn't reused or zeroed. However, under Valgrind or
libdislocator, this memory management error becomes visible.

This patch saves the location of the second pointer in two locations,
and restores it after the call to skipspace.

t/op/lex.t
toke.c

index e68fab4..a667183 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
 
-plan(tests => 28);
+plan(tests => 30);
 
 {
     no warnings 'deprecated';
@@ -227,3 +227,17 @@ fresh_perl_is(
 
 like runperl(prog => 'sub ub(){0} ub ub', stderr=>1), qr/Bareword found/,
  '[perl #126482] Assert failure when mentioning a constant twice in a row';
+
+fresh_perl_is(
+    "do\0"."000000",
+    "",
+    {},
+    '[perl #129069] - no output and valgrind clean'
+);
+
+fresh_perl_is(
+    "00my sub\0",
+    "Missing name in \"my sub\" at - line 1.\n",
+    {},
+    '[perl #129069] - "Missing name" warning and valgrind clean'
+);
diff --git a/toke.c b/toke.c
index 2da8366..dbeecd1 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7509,7 +7509,9 @@ Perl_yylex(pTHX)
                              1, &len);
                if (len && (len != 4 || strNE(PL_tokenbuf+1, "CORE"))
                 && !keyword(PL_tokenbuf + 1, len, 0)) {
+                    SSize_t off = s-SvPVX(PL_linestr);
                    d = skipspace(d);
+                    s = SvPVX(PL_linestr)+off;
                    if (*d == '(') {
                        force_ident_maybe_lex('&');
                        s = d;
@@ -8285,8 +8287,9 @@ Perl_yylex(pTHX)
                const int key = tmp;
                 SV *format_name = NULL;
 
-               d = s;
+                SSize_t off = s-SvPVX(PL_linestr);
                s = skipspace(s);
+                d = SvPVX(PL_linestr)+off;
 
                if (isIDFIRST_lazy_if(s,UTF)
                     || *s == '\''