Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fuzzer-detected use-after-free in Perl_yylex #15549

Closed
p5pRT opened this issue Aug 24, 2016 · 21 comments
Closed

Fuzzer-detected use-after-free in Perl_yylex #15549

p5pRT opened this issue Aug 24, 2016 · 21 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 24, 2016

Migrated from rt.perl.org#129069 (status was 'resolved')

Searchable as RT129069$

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @dcollinsn

First, the two testcases​:
Testcase 1​: perl -e 'print "do\0"."000000"' | valgrind perl
Testcase 2​: perl -e 'print "00my sub\0"' | valgrind perl

Detected using AFL with libdislocator, but reproducible using valgrind. The first one​:

==56912== Invalid read of size 1
==56912== at 0x5D62C8​: Perl_yylex (toke.c​:4880)
==56912== by 0x660E34​: Perl_yyparse (perly.c​:334)
==56912== by 0x530344​: S_parse_body (perl.c​:2373)
==56912== by 0x537586​: perl_parse (perl.c​:1689)
==56912== by 0x4297B7​: main (perlmain.c​:121)
==56912== Address 0x61b28f3 is 3 bytes inside a block of size 10 free'd
==56912== at 0x4C2AB5C​: realloc (vg_replace_malloc.c​:785)
==56912== by 0x7F6D24​: Perl_safesysrealloc (util.c​:274)
==56912== by 0x99605E​: Perl_sv_grow (sv.c​:1602)
==56912== by 0xA29845​: Perl_sv_gets (sv.c​:8528)
==56912== by 0x5A433B​: Perl_lex_next_chunk (toke.c​:1309)
==56912== by 0x5A62BD​: Perl_lex_read_space (toke.c​:1529)
==56912== by 0x5A6BB1​: S_skipspace_flags (toke.c​:1831)
==56912== by 0x6333E1​: Perl_yylex (toke.c​:7512)
==56912== by 0x660E34​: Perl_yyparse (perly.c​:334)
==56912== by 0x530344​: S_parse_body (perl.c​:2373)
==56912== by 0x537586​: perl_parse (perl.c​:1689)
==56912== by 0x4297B7​: main (perlmain.c​:121)
==56912== Block was alloc'd at
==56912== at 0x4C28C0F​: malloc (vg_replace_malloc.c​:299)
==56912== by 0x7EF59C​: Perl_safesysmalloc (util.c​:153)
==56912== by 0x99646F​: Perl_sv_grow (sv.c​:1605)
==56912== by 0x9CB173​: Perl_sv_setpvn (sv.c​:4898)
==56912== by 0x9D96D7​: Perl_newSVpvn (sv.c​:9240)
==56912== by 0x590F96​: Perl_lex_start (toke.c​:741)
==56912== by 0x5301D1​: S_parse_body (perl.c​:2362)
==56912== by 0x537586​: perl_parse (perl.c​:1689)
==56912== by 0x4297B7​: main (perlmain.c​:121)

The second is just a write instead of a read​:

==60617== Invalid write of size 1
==60617== at 0x4BF89F​: Perl_yylex (toke.c​:8323)
==60617== by 0x4D315B​: Perl_yyparse (perly.c​:334)
==60617== by 0x461DD0​: S_parse_body (perl.c​:2373)
==60617== by 0x4602AF​: perl_parse (perl.c​:1689)
==60617== by 0x41EEB5​: main (perlmain.c​:121)
==60617== Address 0x61b2748 is 8 bytes inside a block of size 10 free'd
==60617== at 0x4C2AB5C​: realloc (vg_replace_malloc.c​:785)
==60617== by 0x55A60A​: Perl_safesysrealloc (util.c​:274)
==60617== by 0x5C602A​: Perl_sv_grow (sv.c​:1602)
==60617== by 0x5FABD8​: Perl_sv_gets (sv.c​:8528)
==60617== by 0x4A3EB9​: S_filter_gets (toke.c​:4347)
==60617== by 0x4947A5​: Perl_lex_next_chunk (toke.c​:1309)
==60617== by 0x49525A​: Perl_lex_read_space (toke.c​:1529)
==60617== by 0x496BC1​: S_skipspace_flags (toke.c​:1831)
==60617== by 0x4BF47A​: Perl_yylex (toke.c​:8289)
==60617== by 0x4D315B​: Perl_yyparse (perly.c​:334)
==60617== by 0x461DD0​: S_parse_body (perl.c​:2373)
==60617== by 0x4602AF​: perl_parse (perl.c​:1689)
==60617== Block was alloc'd at
==60617== at 0x4C28C0F​: malloc (vg_replace_malloc.c​:299)
==60617== by 0x55A4DC​: Perl_safesysmalloc (util.c​:153)
==60617== by 0x5C6045​: Perl_sv_grow (sv.c​:1605)
==60617== by 0x5E5B82​: Perl_sv_setpvn (sv.c​:4898)
==60617== by 0x6007A9​: Perl_newSVpvn (sv.c​:9240)
==60617== by 0x491BD3​: Perl_lex_start (toke.c​:741)
==60617== by 0x461D76​: S_parse_body (perl.c​:2362)
==60617== by 0x4602AF​: perl_parse (perl.c​:1689)
==60617== by 0x41EEB5​: main (perlmain.c​:121)

The buffer in question is allocated by Perl_lex_start (in the else case of this conditional​:

  if (line) {
  STRLEN len;
  s = SvPV_const(line, len);
  parser->linestr = flags & LEX_START_COPIED
  ? SvREFCNT_inc_simple_NN(line)
  : newSVpvn_flags(s, len, SvUTF8(line));
  if (!rsfp)
  sv_catpvs(parser->linestr, "\n;");
  } else {
  parser->linestr = newSVpvn("\n;", rsfp ? 1 : 2); <<----toke.c​:741
  }

It is then reallocated in a grow here​:

  if (len && (len != 4 || strNE(PL_tokenbuf+1, "CORE"))
  && !keyword(PL_tokenbuf + 1, len, 0)) {
  d = skipspace(d); <<----toke.c​:7512
  if (*d == '(') {
  force_ident_maybe_lex('&');
  s = d;
  }

In the first case, we then hit this code​:

  retry​:
  switch (*s) { <<----toke.c​:4880
  default​:

In the second testcase, the error happens here​:

  else {
  if (key == KEY_my || key == KEY_our || key==KEY_state)
  {
  *d = '\0'; <<----toke.c​:8323
  /* diag_listed_as​: Missing name in "%s sub" */
  Perl_croak(aTHX_
  "Missing name in \"%s\"", PL_bufptr);
  }

When stepping through with libdislocator, which forces the realloc to return a new memory segment, I see the following change in Perl_sv_grow​:

(gdb)
1602 s = (char*)saferealloc(s, newlen);
(gdb)
1610 SvPV_set(sv, s);
(gdb) p s
$4 = 0x7ffff63a1fe8 "do"
(gdb) p *sv
$5 = {sv_any = 0x7ffff7fe2410, sv_refcnt = 1, sv_flags = 17411, sv_u = {
  svu_pv = 0x7ffff63acff6 "do", svu_iv = 140737324437494,
  svu_uv = 140737324437494, svu_rv = 0x7ffff63acff6,
  svu_rx = 0x7ffff63acff6, svu_array = 0x7ffff63acff6,
  svu_hash = 0x7ffff63acff6, svu_gp = 0x7ffff63acff6,
  svu_fp = 0x7ffff63acff6}}
(gdb) n
1617 SvLEN_set(sv, newlen);
(gdb) p *sv
$6 = {sv_any = 0x7ffff7fe2410, sv_refcnt = 1, sv_flags = 17411, sv_u = {
  svu_pv = 0x7ffff63a1fe8 "do", svu_iv = 140737324392424,
  svu_uv = 140737324392424, svu_rv = 0x7ffff63a1fe8,
  svu_rx = 0x7ffff63a1fe8, svu_array = 0x7ffff63a1fe8,
  svu_hash = 0x7ffff63a1fe8, svu_gp = 0x7ffff63a1fe8,
  svu_fp = 0x7ffff63a1fe8}}

(that is, ~cff6 is the old address, and ~1fe8 is the new address)

Stepping out, I get​:

(gdb) n
Perl_lex_next_chunk (flags=2) at toke.c​:1312
1312 } else if (flags & LEX_NO_TERM) {
(gdb) info locals
linestr = 0x7ffff6606a48
buf = 0x7ffff63acff6 "do" <<---- I hope we never use this, because it's invalid now
old_bufend_pos = 9
new_bufend_pos = 4294967296
bufptr_pos = 9
oldbufptr_pos = 0
oldoldbufptr_pos = 0
linestart_pos = 0
last_uni_pos = 0
last_lop_pos = 0
got_some_for_debugger = false
got_some = false
__PRETTY_FUNCTION__ = "Perl_lex_next_chunk"
...

1338 buf = SvPVX(linestr);
(gdb) n
1339 new_bufend_pos = SvCUR(linestr);
(gdb) p buf
$8 = 0x7ffff63a1fe8 "do" <<---- Good, we don't

Perl_lex_read_space (flags=2) at toke.c​:1530
1530 CopLINE_set(PL_curcop, l);
(gdb) info locals
got_more = true
l = 1
c = 0 '\000'
s = 0x7ffff63acfff "" <<----
bufend = 0x7ffff63acfff "" <<---- These are both offset from the bad pointer (s[9], currently)
can_incline = true
need_incline = false
...
(gdb) n
1531 s = PL_parser->bufptr;
(gdb) n
1532 bufend = PL_parser->bufend;
(gdb) n
1533 if (!got_more)
(gdb) p s
$9 = 0x7ffff63a1ff1 ";" <<----
(gdb) p bufend
$10 = 0x7ffff63a1ff2 "" <<---- Ok, this function is safe
...

S_skipspace_flags (s=0x7ffff63acfff "", flags=0) at toke.c​:1834
1834 s = PL_bufptr;
(gdb) p s
$11 = 0x7ffff63acfff ""
(gdb) n
1835 PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
(gdb) p s
$12 = 0x7ffff63a1ff1 ";" <<---- Ok, safe here too...

(gdb) info locals
lex = false
tmp = 44
off = 0
anydelim = false
sv = 0x0
cv = 0x0
rv2cv_op = 0x0
s = 0x7ffff63acff9 "000000" <<---- offset s[3] from the bad pointer
d = 0x7ffff63a1ff1 ";" <<---- As a reminder, we just called d = skipspace(d)...safe
len = 6
bof = true
saw_infix_sigil = false
formbrack = 0 '\000'
fake_eof = 0
orig_keyword = 0
gv = 0x0
gvp = 0x0
__PRETTY_FUNCTION__ = "Perl_yylex"

More ideas to follow, perhaps.

--
Respectfully,
Dan Collins

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @geeknik

Reads like a dupe of #129021.

On Wed, Aug 24, 2016 at 12​:48 PM, Dan Collins <perlbug-followup@​perl.org>
wrote​:

# New Ticket Created by Dan Collins
# Please include the string​: [perl #129069]
# in the subject line of all future correspondence about this issue.
# <URL​: https://rt-archive.perl.org/perl5/Ticket/Display.html?id=129069 >

First, the two testcases​:
Testcase 1​: perl -e 'print "do\0"."000000"' | valgrind perl
Testcase 2​: perl -e 'print "00my sub\0"' | valgrind perl

Detected using AFL with libdislocator, but reproducible using valgrind.
The first one​:

==56912== Invalid read of size 1
==56912== at 0x5D62C8​: Perl_yylex (toke.c​:4880)
==56912== by 0x660E34​: Perl_yyparse (perly.c​:334)
==56912== by 0x530344​: S_parse_body (perl.c​:2373)
==56912== by 0x537586​: perl_parse (perl.c​:1689)
==56912== by 0x4297B7​: main (perlmain.c​:121)
==56912== Address 0x61b28f3 is 3 bytes inside a block of size 10 free'd
==56912== at 0x4C2AB5C​: realloc (vg_replace_malloc.c​:785)
==56912== by 0x7F6D24​: Perl_safesysrealloc (util.c​:274)
==56912== by 0x99605E​: Perl_sv_grow (sv.c​:1602)
==56912== by 0xA29845​: Perl_sv_gets (sv.c​:8528)
==56912== by 0x5A433B​: Perl_lex_next_chunk (toke.c​:1309)
==56912== by 0x5A62BD​: Perl_lex_read_space (toke.c​:1529)
==56912== by 0x5A6BB1​: S_skipspace_flags (toke.c​:1831)
==56912== by 0x6333E1​: Perl_yylex (toke.c​:7512)
==56912== by 0x660E34​: Perl_yyparse (perly.c​:334)
==56912== by 0x530344​: S_parse_body (perl.c​:2373)
==56912== by 0x537586​: perl_parse (perl.c​:1689)
==56912== by 0x4297B7​: main (perlmain.c​:121)
==56912== Block was alloc'd at
==56912== at 0x4C28C0F​: malloc (vg_replace_malloc.c​:299)
==56912== by 0x7EF59C​: Perl_safesysmalloc (util.c​:153)
==56912== by 0x99646F​: Perl_sv_grow (sv.c​:1605)
==56912== by 0x9CB173​: Perl_sv_setpvn (sv.c​:4898)
==56912== by 0x9D96D7​: Perl_newSVpvn (sv.c​:9240)
==56912== by 0x590F96​: Perl_lex_start (toke.c​:741)
==56912== by 0x5301D1​: S_parse_body (perl.c​:2362)
==56912== by 0x537586​: perl_parse (perl.c​:1689)
==56912== by 0x4297B7​: main (perlmain.c​:121)

The second is just a write instead of a read​:

==60617== Invalid write of size 1
==60617== at 0x4BF89F​: Perl_yylex (toke.c​:8323)
==60617== by 0x4D315B​: Perl_yyparse (perly.c​:334)
==60617== by 0x461DD0​: S_parse_body (perl.c​:2373)
==60617== by 0x4602AF​: perl_parse (perl.c​:1689)
==60617== by 0x41EEB5​: main (perlmain.c​:121)
==60617== Address 0x61b2748 is 8 bytes inside a block of size 10 free'd
==60617== at 0x4C2AB5C​: realloc (vg_replace_malloc.c​:785)
==60617== by 0x55A60A​: Perl_safesysrealloc (util.c​:274)
==60617== by 0x5C602A​: Perl_sv_grow (sv.c​:1602)
==60617== by 0x5FABD8​: Perl_sv_gets (sv.c​:8528)
==60617== by 0x4A3EB9​: S_filter_gets (toke.c​:4347)
==60617== by 0x4947A5​: Perl_lex_next_chunk (toke.c​:1309)
==60617== by 0x49525A​: Perl_lex_read_space (toke.c​:1529)
==60617== by 0x496BC1​: S_skipspace_flags (toke.c​:1831)
==60617== by 0x4BF47A​: Perl_yylex (toke.c​:8289)
==60617== by 0x4D315B​: Perl_yyparse (perly.c​:334)
==60617== by 0x461DD0​: S_parse_body (perl.c​:2373)
==60617== by 0x4602AF​: perl_parse (perl.c​:1689)
==60617== Block was alloc'd at
==60617== at 0x4C28C0F​: malloc (vg_replace_malloc.c​:299)
==60617== by 0x55A4DC​: Perl_safesysmalloc (util.c​:153)
==60617== by 0x5C6045​: Perl_sv_grow (sv.c​:1605)
==60617== by 0x5E5B82​: Perl_sv_setpvn (sv.c​:4898)
==60617== by 0x6007A9​: Perl_newSVpvn (sv.c​:9240)
==60617== by 0x491BD3​: Perl_lex_start (toke.c​:741)
==60617== by 0x461D76​: S_parse_body (perl.c​:2362)
==60617== by 0x4602AF​: perl_parse (perl.c​:1689)
==60617== by 0x41EEB5​: main (perlmain.c​:121)

The buffer in question is allocated by Perl_lex_start (in the else case of
this conditional​:

if \(line\) \{
    STRLEN len;
    s = SvPV\_const\(line\, len\);
    parser\->linestr = flags & LEX\_START\_COPIED
                        ? SvREFCNT\_inc\_simple\_NN\(line\)
                        : newSVpvn\_flags\(s\, len\, SvUTF8\(line\)\);
    if \(\!rsfp\)
        sv\_catpvs\(parser\->linestr\, "\\n;"\);
\} else \{
    parser\->linestr = newSVpvn\("\\n;"\, rsfp ? 1 : 2\); \<\<\-\-\-\-toke\.c&#8203;:741
\}

It is then reallocated in a grow here​:

if \(len && \(len \!= 4 || strNE\(PL\_tokenbuf\+1\, "CORE"\)\)
 && \!keyword\(PL\_tokenbuf \+ 1\, len\, 0\)\) \{
    d = skipspace\(d\); \<\<\-\-\-\-toke\.c&#8203;:7512
    if \(\*d == '\('\) \{
        force\_ident\_maybe\_lex\('&'\);
        s = d;
    \}

In the first case, we then hit this code​:

retry&#8203;:
    switch \(\*s\) \{ \<\<\-\-\-\-toke\.c&#8203;:4880
    default&#8203;:

In the second testcase, the error happens here​:

else \{
    if \(key == KEY\_my || key == KEY\_our || key==KEY\_state\)
    \{
        \*d = '\\0'; \<\<\-\-\-\-toke\.c&#8203;:8323
        /\* diag\_listed\_as&#8203;: Missing name in "%s sub" \*/
        Perl\_croak\(aTHX\_
                  "Missing name in \\"%s\\""\, PL\_bufptr\);
    \}

When stepping through with libdislocator, which forces the realloc to
return a new memory segment, I see the following change in Perl_sv_grow​:

(gdb)
1602 s = (char*)saferealloc(s, newlen);
(gdb)
1610 SvPV_set(sv, s);
(gdb) p s
$4 = 0x7ffff63a1fe8 "do"
(gdb) p *sv
$5 = {sv_any = 0x7ffff7fe2410, sv_refcnt = 1, sv_flags = 17411, sv_u = {
svu_pv = 0x7ffff63acff6 "do", svu_iv = 140737324437494,
svu_uv = 140737324437494, svu_rv = 0x7ffff63acff6,
svu_rx = 0x7ffff63acff6, svu_array = 0x7ffff63acff6,
svu_hash = 0x7ffff63acff6, svu_gp = 0x7ffff63acff6,
svu_fp = 0x7ffff63acff6}}
(gdb) n
1617 SvLEN_set(sv, newlen);
(gdb) p *sv
$6 = {sv_any = 0x7ffff7fe2410, sv_refcnt = 1, sv_flags = 17411, sv_u = {
svu_pv = 0x7ffff63a1fe8 "do", svu_iv = 140737324392424,
svu_uv = 140737324392424, svu_rv = 0x7ffff63a1fe8,
svu_rx = 0x7ffff63a1fe8, svu_array = 0x7ffff63a1fe8,
svu_hash = 0x7ffff63a1fe8, svu_gp = 0x7ffff63a1fe8,
svu_fp = 0x7ffff63a1fe8}}

(that is, ~cff6 is the old address, and ~1fe8 is the new address)

Stepping out, I get​:

(gdb) n
Perl_lex_next_chunk (flags=2) at toke.c​:1312
1312 } else if (flags & LEX_NO_TERM) {
(gdb) info locals
linestr = 0x7ffff6606a48
buf = 0x7ffff63acff6 "do" <<---- I hope we never use this, because it's
invalid now
old_bufend_pos = 9
new_bufend_pos = 4294967296
bufptr_pos = 9
oldbufptr_pos = 0
oldoldbufptr_pos = 0
linestart_pos = 0
last_uni_pos = 0
last_lop_pos = 0
got_some_for_debugger = false
got_some = false
__PRETTY_FUNCTION__ = "Perl_lex_next_chunk"
...

1338 buf = SvPVX(linestr);
(gdb) n
1339 new_bufend_pos = SvCUR(linestr);
(gdb) p buf
$8 = 0x7ffff63a1fe8 "do" <<---- Good, we don't

Perl_lex_read_space (flags=2) at toke.c​:1530
1530 CopLINE_set(PL_curcop, l);
(gdb) info locals
got_more = true
l = 1
c = 0 '\000'
s = 0x7ffff63acfff "" <<----
bufend = 0x7ffff63acfff "" <<---- These are both offset from the bad
pointer (s[9], currently)
can_incline = true
need_incline = false
...
(gdb) n
1531 s = PL_parser->bufptr;
(gdb) n
1532 bufend = PL_parser->bufend;
(gdb) n
1533 if (!got_more)
(gdb) p s
$9 = 0x7ffff63a1ff1 ";" <<----
(gdb) p bufend
$10 = 0x7ffff63a1ff2 "" <<---- Ok, this function is safe
...

S_skipspace_flags (s=0x7ffff63acfff "", flags=0) at toke.c​:1834
1834 s = PL_bufptr;
(gdb) p s
$11 = 0x7ffff63acfff ""
(gdb) n
1835 PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
(gdb) p s
$12 = 0x7ffff63a1ff1 ";" <<---- Ok, safe here too...

(gdb) info locals
lex = false
tmp = 44
off = 0
anydelim = false
sv = 0x0
cv = 0x0
rv2cv_op = 0x0
s = 0x7ffff63acff9 "000000" <<---- offset s[3] from the bad pointer
d = 0x7ffff63a1ff1 ";" <<---- As a reminder, we just called d =
skipspace(d)...safe
len = 6
bof = true
saw_infix_sigil = false
formbrack = 0 '\000'
fake_eof = 0
orig_keyword = 0
gv = 0x0
gvp = 0x0
__PRETTY_FUNCTION__ = "Perl_yylex"

More ideas to follow, perhaps.

--
Respectfully,
Dan Collins

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @dcollinsn

Some diagnosis​:

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.

Ideally, these would both just be offsets relative to PL_bufptr rather than pointers, but I understand the desire have them be pointers for performance reasons. This would involve refactoring Perl_yylex as well as changing how skipspace is called (argument and retval would be an offset against PL_bufptr instead of a pointer into PL_bufptr). However, even just looking at skipspace, I don't understand this code well enough to do anything like that.

The simpler fix is to patch the holes by ensuring that the second pointer is always updated when we call skipspace, as in the attached. That fixes all of my testcases, not sure if Brian has any similar ones. This also `make test`s clean.

--
Respectfully,
Dan Collins

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @dcollinsn

0001-RT-129069-Perl_yylex-Fix-two-use-after-free-bugs.patch
From ffdb9c00f4f0fd5a3cfc469ae23b3fe4026b559a Mon Sep 17 00:00:00 2001
From: Dan Collins <dcollinsn@gmail.com>
Date: Wed, 24 Aug 2016 14:19:09 -0400
Subject: [PATCH] [RT #129069] Perl_yylex: Fix two use-after-free bugs

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.
---
 toke.c | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/toke.c b/toke.c
index 2da8366..dd616fc 100644
--- 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-PL_bufptr;
 		    d = skipspace(d);
+                    s = PL_bufptr+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-PL_bufptr;
 		s = skipspace(s);
+                d = PL_bufptr+off;
 
 		if (isIDFIRST_lazy_if(s,UTF)
                     || *s == '\''
-- 
2.8.1

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From [Unknown Contact. See original ticket]

Some diagnosis​:

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.

Ideally, these would both just be offsets relative to PL_bufptr rather than pointers, but I understand the desire have them be pointers for performance reasons. This would involve refactoring Perl_yylex as well as changing how skipspace is called (argument and retval would be an offset against PL_bufptr instead of a pointer into PL_bufptr). However, even just looking at skipspace, I don't understand this code well enough to do anything like that.

The simpler fix is to patch the holes by ensuring that the second pointer is always updated when we call skipspace, as in the attached. That fixes all of my testcases, not sure if Brian has any similar ones. This also `make test`s clean.

--
Respectfully,
Dan Collins

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @cpansprout

On Wed Aug 24 10​:54​:01 2016, brian.carpenter@​gmail.com wrote​:

Reads like a dupe of #129021.

RT Error
No permission to view ticket

Which ticket did you mean?

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @cpansprout

On Wed Aug 24 12​:13​:58 2016, dcollinsn@​gmail.com wrote​:

Some diagnosis​:

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.

Ideally, these would both just be offsets relative to PL_bufptr rather
than pointers, but I understand the desire have them be pointers for
performance reasons. This would involve refactoring Perl_yylex as well
as changing how skipspace is called (argument and retval would be an
offset against PL_bufptr instead of a pointer into PL_bufptr).
However, even just looking at skipspace, I don't understand this code
well enough to do anything like that.

The simpler fix is to patch the holes by ensuring that the second
pointer is always updated when we call skipspace, as in the attached.
That fixes all of my testcases, not sure if Brian has any similar
ones. This also `make test`s clean.

Both hunks look correct to me. (I have a guilty feeling I may have written one of those bits of code.) Could you add tests too, so that ‘make test.valgrind’ (or whatever it’s called) will catch any regressions?

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2016

From @geeknik

On Wed, Aug 24, 2016 at 5​:17 PM, Father Chrysostomos via RT <
perlbug-followup@​perl.org> wrote​:

RT Error
No permission to view ticket

Which ticket did you mean?

#129021 is a bug that I reported to the security list on 20 August 2016.

@p5pRT
Copy link
Author

p5pRT commented Aug 25, 2016

From @dcollinsn

I tried to add tests by using fresh_perl_is() and adding the tests to
t/op/lex.t. I can confirm that the tests are "right" because they fail
without the patch and succeed with the patch when run under libdislocator,
which causes the tests to segfault. However, valgrind doesn't catch any
issues in either case - I don't think it follows child processes. The
errors don't appear under eval, so that isn't an option either.

Come to think of it, running the testsuite under libdislocator as well as
valgrind would probably be a good idea.

On Wed, Aug 24, 2016 at 6​:22 PM, Brian Carpenter via RT <
perlbug-followup@​perl.org> wrote​:

On Wed, Aug 24, 2016 at 5​:17 PM, Father Chrysostomos via RT <
perlbug-followup@​perl.org> wrote​:

RT Error
No permission to view ticket

Which ticket did you mean?

#129021 is a bug that I reported to the security list on 20 August 2016.

@p5pRT
Copy link
Author

p5pRT commented Aug 25, 2016

From @tonycoz

On Wed Aug 24 17​:44​:41 2016, dcollinsn@​gmail.com wrote​:

I tried to add tests by using fresh_perl_is() and adding the tests to
t/op/lex.t. I can confirm that the tests are "right" because they fail
without the patch and succeed with the patch when run under libdislocator,
which causes the tests to segfault. However, valgrind doesn't catch any
issues in either case - I don't think it follows child processes. The
errors don't appear under eval, so that isn't an option either.

My patch on the security ticket (I don't think this is a security issue
but no-one responded on the security list) uses runperl() directly,
I couldn't get it to fail with fresh_perl_is(), which uses a file instead
of -e to run the script​:

+{
+ # RT #129021 - heap use after free
+ # caught by valgrind or with libdislocator
+ is(runperl(prog => 'do 00000', stderr => 1), "", "heap use after free");
+}

For valgrind to detect it you need to get runperl() to use valgrind, so
you'd set​:

  PERL_RUNPERL_DEBUG='valgrind -q'

before running the test, for my testing I was doing​:

  PERL_RUNPERL_DEBUG='valgrind -q' ./perl op/do.t

I'm not sure basing the position off PL_bufptr is correct, skipspace()
doesn't necessarily preserve it relative to the start of PL_linestr​:

  if (PL_linestart > PL_bufptr)
  PL_bufptr = PL_linestart;

but FatherC would know better.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 25, 2016

From @dcollinsn

Yeah, I think you're right Tony. My patch also doesn't fix your testcase,
which I presume is Brian's testcase. So, the 129021 might actually be a
separate problem, or at least a separate cause of the same problem. Is the
following a state that PL_parser should ever be in?​:

(gdb) p *PL_parser
$5 = {old_parser = 0x0, yylval = {ival = 0, pval = 0x0, opval = 0x0,
  gvval = 0x0}, yychar = -2, yyerrstatus = 0, stack_size = 200, yylen = 0,
  stack = 0xac2570, ps = 0xac2610, lex_brackets = 0, lex_casemods = 0,
  lex_brackstack = 0xac2430 "", lex_casestack = 0xac24b0 "",
  lex_defer = 0 '\000', lex_dojoin = 0 '\000', expect = 1 '\001',
  preambled = true, lex_formbrack = 0, lex_inpat = 0x0, lex_op = 0x0,
  lex_repl = 0x0, lex_inwhat = 0, last_lop_op = 0, lex_starts = 0,
  lex_stuff = 0x0, multi_start = 0, multi_end = 0, multi_open = 0,
  multi_close = 0, lex_re_reparsing = false, lex_super_state = 0 '\000',
  lex_sub_inwhat = 0, lex_allbrackets = 0, lex_sub_op = 0x0,
  lex_sub_repl = 0x0, lex_shared = 0xac24d0, linestr = 0xaba6f8,
  bufptr = 0xac250c "", oldbufptr = 0xac250c "",
  oldoldbufptr = 0xac2500 "do 00000\n;", bufend = 0xac250a "",
  linestart = 0xac2509 ";", last_uni = 0x0, last_lop = 0x0,
  copline = 4294967295, in_my = 0, lex_state = 10 '\n',
  error_count = 0 '\000', in_my_stash = 0x0, rsfp = 0x0,
  rsfp_filters = 0xaba9c8, nextval = {{ival = 0, pval = 0x0, opval = 0x0,
  gvval = 0x0}, {ival = 0, pval = 0x0, opval = 0x0, gvval = 0x0}, {
  ival = 0, pval = 0x0, opval = 0x0, gvval = 0x0}, {ival = 0, pval =
0x0,
  opval = 0x0, gvval = 0x0}, {ival = 0, pval = 0x0, opval = 0x0,
  gvval = 0x0}}, nexttype = {0, 0, 0, 0, 0}, nexttoke = 0 '\000',
  form_lex_state = 0 '\000', lex_fakeeof = 0 '\000', lex_flags = 0 '\000',
  saved_curcop = 0xaa1020 <PL_compiling>,
---Type <return> to continue, or q <return> to quit---
  tokenbuf = "&00000", '\000' <repeats 249 times>, herelines = 0,
  preambling = 4294967295, sig_elems = 0, sig_optelems = 0,
  sig_slurpy = 0 '\000', in_pod = 0, filtered = 0, saw_infix_sigil = 0,
  parsed_sub = 0}
(gdb) p s
$6 = 0xac250c ""
(gdb) p d
$7 = 0xac2509 ";"

Emphasis on bufptr > bufend. It happens here​:

Hardware watchpoint 2​: PL_parser->bufptr

Old value = 0xac2509 ";"
New value = 0xac250c ""
0x00000000004b87bd in Perl_yylex () at toke.c​:7527
7527 OPERATOR(DO);
(gdb) p PL_parser->bufptr
$13 = 0xac250c ""
(gdb) p PL_parser->bufend
$14 = 0xac250a ""

I /think/ that skipspace is skipping past the end of the line, so rather
than using bufptr or linestart, I should be using SvPVX(PL_linestr). Here's
a second attempt, fixes both of my testcases as well as yours, and make
test results in all tests passing. (

@p5pRT
Copy link
Author

p5pRT commented Aug 25, 2016

From @dcollinsn

0001-RT-129069-Perl_yylex-Fix-two-use-after-free-bugs.patch
From 1e347a3324c7bc7b68be50fa02c2d05688ffcad5 Mon Sep 17 00:00:00 2001
From: Dan Collins <dcollinsn@gmail.com>
Date: Wed, 24 Aug 2016 14:19:09 -0400
Subject: [PATCH] [RT #129069] Perl_yylex: Fix two use-after-free bugs

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 | 16 +++++++++++++++-
 toke.c     |  5 ++++-
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/t/op/lex.t b/t/op/lex.t
index e68fab4..a667183 100644
--- a/t/op/lex.t
+++ b/t/op/lex.t
@@ -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
--- 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 == '\''
-- 
2.8.1

@p5pRT
Copy link
Author

p5pRT commented Aug 25, 2016

From @cpansprout

On Wed Aug 24 18​:13​:52 2016, tonyc wrote​:

On Wed Aug 24 17​:44​:41 2016, dcollinsn@​gmail.com wrote​:

I tried to add tests by using fresh_perl_is() and adding the tests to
t/op/lex.t. I can confirm that the tests are "right" because they
fail
without the patch and succeed with the patch when run under
libdislocator,
which causes the tests to segfault. However, valgrind doesn't catch
any
issues in either case - I don't think it follows child processes. The
errors don't appear under eval, so that isn't an option either.

My patch on the security ticket (I don't think this is a security
issue
but no-one responded on the security list) uses runperl() directly,
I couldn't get it to fail with fresh_perl_is(), which uses a file
instead
of -e to run the script​:

+{
+ # RT #129021 - heap use after free
+ # caught by valgrind or with libdislocator
+ is(runperl(prog => 'do 00000', stderr => 1), "", "heap use after
free");
+}

For valgrind to detect it you need to get runperl() to use valgrind,
so
you'd set​:

PERL_RUNPERL_DEBUG='valgrind -q'

before running the test, for my testing I was doing​:

PERL_RUNPERL_DEBUG='valgrind -q' ./perl op/do.t

I'm not sure basing the position off PL_bufptr is correct, skipspace()
doesn't necessarily preserve it relative to the start of PL_linestr​:

if (PL_linestart > PL_bufptr)
PL_bufptr = PL_linestart;

but FatherC would know better.

Duh. Yes. Thank you for pointing out my thinko (not noticing this). Dan Collins is right that SvPVX(PL_linestr) is the right thing to use.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2016

From @tonycoz

On Wed Aug 24 19​:51​:20 2016, dcollinsn@​gmail.com wrote​:

I /think/ that skipspace is skipping past the end of the line, so rather
than using bufptr or linestart, I should be using SvPVX(PL_linestr). Here's
a second attempt, fixes both of my testcases as well as yours, and make
test results in all tests passing. (

Thanks, applied as 3781748.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 29, 2016

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2016

From @geeknik

On Sun Aug 28 23​:33​:26 2016, tonyc wrote​:

Thanks, applied as 3781748.

I think we should re-open this bug.

v5.25.5 (v5.25.4-104-g49fc490)

od -tx1 test00
0000000 6f 70 65 6e 20 6d 30 30 24
0000011

./perl test00

==8619==ERROR​: AddressSanitizer​: heap-use-after-free on address 0x60200000e278 at pc 0x0000006595de bp 0x7ffcba0d6490 sp 0x7ffcba0d6488
READ of size 1 at 0x60200000e278 thread T0
  #0 0x6595dd in Perl_yylex /root/perl/toke.c​:4880​:5
  #1 0x6ade9e in Perl_yyparse /root/perl/perly.c​:334​:19
  #2 0x59c6c1 in S_parse_body /root/perl/perl.c​:2373​:9
  #3 0x592a5c in perl_parse /root/perl/perl.c​:1689​:2
  #4 0x4de745 in main /root/perl/perlmain.c​:121​:18
  #5 0x7fe5dafa5b44 in __libc_start_main /build/glibc-uPj9cH/glibc-2.19/csu/libc-start.c​:287
  #6 0x4de3dc in _start (/root/perl/perl+0x4de3dc)

0x60200000e278 is located 8 bytes inside of 10-byte region [0x60200000e270,0x60200000e27a)
freed by thread T0 here​:
  #0 0x4c104e in realloc (/root/perl/perl+0x4c104e)
  #1 0x7f8b46 in Perl_safesysrealloc /root/perl/util.c​:274​:18

previously allocated by thread T0 here​:
  #0 0x4c0d5b in malloc (/root/perl/perl+0x4c0d5b)
  #1 0x7f8457 in Perl_safesysmalloc /root/perl/util.c​:153​:21

SUMMARY​: AddressSanitizer​: heap-use-after-free /root/perl/toke.c​:4880 Perl_yylex
Shadow bytes around the buggy address​:
  0x0c047fff9bf0​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c047fff9c00​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c047fff9c10​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c047fff9c20​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c047fff9c30​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
=>0x0c047fff9c40​: fa fa fa fa fa fa 00 02 fa fa 00 02 fa fa fd[fd]
  0x0c047fff9c50​: fa fa 00 04 fa fa 02 fa fa fa 00 02 fa fa 00 07
  0x0c047fff9c60​: fa fa 00 fa fa fa 00 02 fa fa 05 fa fa fa 00 02
  0x0c047fff9c70​: fa fa 06 fa fa fa 00 02 fa fa 05 fa fa fa 00 05
  0x0c047fff9c80​: fa fa 04 fa fa fa 05 fa fa fa 05 fa fa fa 00 00
  0x0c047fff9c90​: fa fa 00 02 fa fa 05 fa fa fa 00 02 fa fa 00 fa
Shadow byte legend (one shadow byte represents 8 application bytes)​:
  Addressable​: 00
  Partially addressable​: 01 02 03 04 05 06 07
  Heap left redzone​: fa
  Heap right redzone​: fb
  Freed heap region​: fd
  Stack left redzone​: f1
  Stack mid redzone​: f2
  Stack right redzone​: f3
  Stack partial redzone​: f4
  Stack after return​: f5
  Stack use after scope​: f8
  Global redzone​: f9
  Global init order​: f6
  Poisoned by user​: f7
  Container overflow​: fc
  ASan internal​: fe
==8619==ABORTING

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2016

From @geeknik

test00.gz

@p5pRT
Copy link
Author

p5pRT commented Sep 9, 2016

From @tonycoz

On Thu Sep 08 17​:16​:43 2016, brian.carpenter@​gmail.com wrote​:

On Sun Aug 28 23​:33​:26 2016, tonyc wrote​:

Thanks, applied as 3781748.

I think we should re-open this bug.

v5.25.5 (v5.25.4-104-g49fc490)

od -tx1 test00
0000000 6f 70 65 6e 20 6d 30 30 24
0000011

./perl test00

==8619==ERROR​: AddressSanitizer​: heap-use-after-free on address
0x60200000e278 at pc 0x0000006595de bp 0x7ffcba0d6490 sp
0x7ffcba0d6488
READ of size 1 at 0x60200000e278 thread T0
#0 0x6595dd in Perl_yylex /root/perl/toke.c​:4880​:5
#1 0x6ade9e in Perl_yyparse /root/perl/perly.c​:334​:19
#2 0x59c6c1 in S_parse_body /root/perl/perl.c​:2373​:9
#3 0x592a5c in perl_parse /root/perl/perl.c​:1689​:2
#4 0x4de745 in main /root/perl/perlmain.c​:121​:18
#5 0x7fe5dafa5b44 in __libc_start_main /build/glibc-uPj9cH/glibc-
2.19/csu/libc-start.c​:287
#6 0x4de3dc in _start (/root/perl/perl+0x4de3dc)

0x60200000e278 is located 8 bytes inside of 10-byte region
[0x60200000e270,0x60200000e27a)
freed by thread T0 here​:
#0 0x4c104e in realloc (/root/perl/perl+0x4c104e)
#1 0x7f8b46 in Perl_safesysrealloc /root/perl/util.c​:274​:18

previously allocated by thread T0 here​:
#0 0x4c0d5b in malloc (/root/perl/perl+0x4c0d5b)
#1 0x7f8457 in Perl_safesysmalloc /root/perl/util.c​:153​:21

This is a different issue, which is duplicated by #129190 (in the security
queue.)

Tony

@p5pRT
Copy link
Author

p5pRT commented May 30, 2017

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release today of Perl 5.26.0, this and 210 other issues have been
resolved.

Perl 5.26.0 may be downloaded via​:
https://metacpan.org/release/XSAWYERX/perl-5.26.0

If you find that the problem persists, feel free to reopen this ticket.

@p5pRT p5pRT closed this as completed May 30, 2017
@p5pRT
Copy link
Author

p5pRT commented May 30, 2017

@khwilliamson - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant