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

heap-use-after-free in pp.c:Perl_pp_list() #16124

Closed
p5pRT opened this issue Aug 24, 2017 · 17 comments
Closed

heap-use-after-free in pp.c:Perl_pp_list() #16124

p5pRT opened this issue Aug 24, 2017 · 17 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 24, 2017

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

Searchable as RT131954$

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From imdb95@gmail.com

Hello,
I found this bug when fuzzing perl5 with afl-fuzz.

**********Build Date & Hardware**********
Version​: Version​: the dev version (https://perl5.git.perl.org/perl.git)
manh@​manh-VirtualBox​:~/Fuzzing/afl/perl$ ./perl/perl -v

This is perl 5, version 27, subversion 4 (v5.27.4
(v5.27.3-14-gd2dccc0)) built for x86_64-linux

Copyright 1987-2017, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl". If you have access to the
Internet, point your browser at http​://www.perl.org/, the Perl Home Page.


OS​: Ubuntu 16.04 Desktop
manh@​manh-VirtualBox​:~/Fuzzing/afl/perl$ uname -a
Linux manh-VirtualBox 4.4.0-92-generic #115-Ubuntu SMP Thu Aug 10
09​:04​:33 UTC 2017 x86_64 x86_64 x86_64 GNU/Linux


Compilation​:
AFL_USE_ASAN=1 ./Configure -des -Dusedevel -DDEBUGGING
-Dcc=afl-clang-fast -Doptimize=-O0\ -g && AFL_USE_ASAN=1 make

**********Reproduce**********
manh@​manh-VirtualBox​:~/Fuzzing/afl/perl$ ./perl/perl crash_heap_Perl_pp_list
1..3
ok 0
ok 1
ok 2
ok 3
ok 4
ok 5
ok 6

==17157==ERROR​: AddressSanitizer​: heap-use-after-free on address
0x6110000013f0 at pc 0x000000a770ea bp 0x7fffffffcc30 sp
0x7fffffffcc28
WRITE of size 8 at 0x6110000013f0 thread T0
  #0 0xa770e9 in Perl_pp_list /home/manh/Fuzzing/afl/perl/perl/pp.c​:5127​:12
  #1 0x83943c in Perl_runops_debug
/home/manh/Fuzzing/afl/perl/perl/dump.c​:2486​:23
  #2 0x5e30ec in Perl_call_sv /home/manh/Fuzzing/afl/perl/perl/perl.c​:2885​:6
  #3 0x5cd2fd in Perl_call_list /home/manh/Fuzzing/afl/perl/perl/perl.c​:5056​:6
  #4 0x57af8e in S_process_special_blocks
/home/manh/Fuzzing/afl/perl/perl/op.c​:9059​:6
  #5 0x54b6d7 in Perl_newATTRSUB_x
/home/manh/Fuzzing/afl/perl/perl/op.c​:8988​:21
  #6 0x6f445f in Perl_yyparse /home/manh/Fuzzing/afl/perl/perl/perly.y​:302​:12
  #7 0x5da9e9 in S_parse_body /home/manh/Fuzzing/afl/perl/perl/perl.c​:2414​:9
  #8 0x5d0f38 in perl_parse /home/manh/Fuzzing/afl/perl/perl/perl.c​:1732​:2
  #9 0x5093cc in main /home/manh/Fuzzing/afl/perl/perl/perlmain.c​:121​:18
  #10 0x7ffff6caf82f in __libc_start_main
(/lib/x86_64-linux-gnu/libc.so.6+0x2082f)
  #11 0x435928 in _start (/home/manh/Fuzzing/afl/perl/perl/perl+0x435928)

0x6110000013f0 is located 240 bytes inside of 256-byte region
[0x611000001300,0x611000001400)
freed by thread T0 here​:
  #0 0x4dc9de in realloc
/scratch/llvm/clang-4/xenial/final/llvm.src/projects/compiler-rt/lib/asan/asan_malloc_linux.cc​:79​:3
  #1 0x83f1b6 in Perl_safesysrealloc
/home/manh/Fuzzing/afl/perl/perl/util.c​:274​:18

previously allocated by thread T0 here​:
  #0 0x4dc62c in malloc
/scratch/llvm/clang-4/xenial/final/llvm.src/projects/compiler-rt/lib/asan/asan_malloc_linux.cc​:66​:3
  #1 0x83eaab in Perl_safesysmalloc
/home/manh/Fuzzing/afl/perl/perl/util.c​:153​:21

SUMMARY​: AddressSanitizer​: heap-use-after-free
/home/manh/Fuzzing/afl/perl/perl/pp.c​:5127​:12 in Perl_pp_list
Shadow bytes around the buggy address​:
  0x0c227fff8220​: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  0x0c227fff8230​: fa fa fa fa fa fa fa fa fd fd fd fd fd fd fd fd
  0x0c227fff8240​: fd fd fd fd fd fd fd fd fd fd fd fd fd fd fd fd
  0x0c227fff8250​: fd fd fd fd fd fd fa fa fa fa fa fa fa fa fa fa
  0x0c227fff8260​: fd fd fd fd fd fd fd fd fd fd fd fd fd fd fd fd
=>0x0c227fff8270​: fd fd fd fd fd fd fd fd fd fd fd fd fd fd[fd]fd
  0x0c227fff8280​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c227fff8290​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c227fff82a0​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c227fff82b0​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c227fff82c0​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa 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
  Freed heap region​: fd
  Stack left redzone​: f1
  Stack mid redzone​: f2
  Stack right redzone​: f3
  Stack after return​: f5
  Stack use after scope​: f8
  Global redzone​: f9
  Global init order​: f6
  Poisoned by user​: f7
  Container overflow​: fc
  Array cookie​: ac
  Intra object redzone​: bb
  ASan internal​: fe
  Left alloca redzone​: ca
  Right alloca redzone​: cb
==17157==ABORTING

**********Analysis**********
With the crafted file crash_heap_Perl_pp_list​:
At pp.c​:5125, in the macro EXTEND, Perl_safesysrealloc is called with
arguments = (where=0x611000001300, size=1336), and
where=0x611000001300 is freed (Perl_safesysrealloc returns ptr =
0x61a000000c80).
Breakpoint 20, Perl_safesysrealloc (where=0x611000001300, size=1336)
at util.c​:325
325 return ptr;
$2759 = '-' <repeats 13 times>, "realloc-return----------"
$2760 = "arguments​:\n"
where = 0x611000001300
size = 1336
$2761 = "ptr​: "
$2762 = (void *) 0x61a000000c80
#0 Perl_safesysrealloc (where=0x611000001300, size=1336) at util.c​:325
#1 0x00000000008ec7ac in Perl_av_extend_guts (av=<optimized out>,
key=<optimized out>, maxp=<optimized out>, allocp=<optimized out>,
arrayp=<optimized out>) at av.c​:163
#2 0x00000000008ec276 in Perl_av_extend (av=0x62100000f2f8, key=160) at av.c​:80
#3 0x0000000000a9ad80 in Perl_stack_grow (sp=<optimized out>,
p=<optimized out>, n=1) at scope.c​:57
#4 0x0000000000a76ff5 in Perl_pp_list () at pp.c​:5125
#5 0x000000000083943d in Perl_runops_debug () at dump.c​:2486
#6 0x00000000005e30ed in Perl_call_sv (sv=<optimized out>,
flags=<optimized out>) at perl.c​:2885
#7 0x00000000005cd2fe in Perl_call_list (oldscope=<optimized out>,
paramList=<optimized out>) at perl.c​:5056
#8 0x000000000057af8f in S_process_special_blocks (floor=<optimized
out>, fullname=<optimized out>, gv=<optimized out>, cv=0x62100000f310)
at op.c​:9059
#9 0x000000000054b6d8 in Perl_newATTRSUB_x (floor=89,
o=0x6020000019d0, proto=<optimized out>, attrs=<optimized out>,
block=0x6210000133d8, o_is_gv=<optimized out>) at op.c​:8988
#10 0x00000000006f4460 in Perl_yyparse (gramtype=<optimized out>) at perly.y​:302
#11 0x00000000005da9ea in S_parse_body (env=<optimized out>,
xsinit=<optimized out>) at perl.c​:2414
#12 0x00000000005d0f39 in perl_parse (my_perl=<optimized out>,
xsinit=<optimized out>, argc=<optimized out>, argv=<optimized out>,
env=<optimized out>) at perl.c​:1732
#13 0x00000000005093cd in main (argc=440, argv=0x1ea5030
<__afl_area_initial>, env=0x7fffffffdd70) at perlmain.c​:121

Right after that, at pp.c​:51257
  *MARK = *SP

With mark = 0x6110000013f0, within the range of
[0x611000001300;0x611000001300+1336), which has been freed.
=> heap-use-after-free

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From @tonycoz

On Wed, 23 Aug 2017 21​:07​:53 -0700, imdb95@​gmail.com wrote​:

Hello,
I found this bug when fuzzing perl5 with afl-fuzz.

Right after that, at pp.c​:51257
*MARK = *SP

With mark = 0x6110000013f0, within the range of
[0x611000001300;0x611000001300+1336), which has been freed.
=> heap-use-after-free

Thanks for the analysis, it made this very easy to fix, per the attached patch.

As an attack, it overwrites a single pointer worth of memory with an address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address are zeros, but not much beyond that.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From @tonycoz

0001-perl-131954-don-t-initialize-mark-before-a-possible-.patch
From 6197d39797b6d1113c7129ac838eba5e3479b381 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 24 Aug 2017 15:52:33 +1000
Subject: (perl #131954) don't initialize mark before a possible move of the
 stack

---
 pp.c        |  4 +++-
 t/op/list.t | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/pp.c b/pp.c
index 46366c3..2898d15 100644
--- a/pp.c
+++ b/pp.c
@@ -5120,9 +5120,11 @@ PP(pp_list)
 {
     I32 markidx = POPMARK;
     if (GIMME_V != G_ARRAY) {
-	SV **mark = PL_stack_base + markidx;
+        /* don't initialize mark here, EXTEND() may move the stack */
+	SV **mark;
 	dSP;
         EXTEND(SP, 1);          /* in case no arguments, as in @empty */
+        mark = PL_stack_base + markidx;
 	if (++MARK <= SP)
 	    *MARK = *SP;		/* unwanted list, return last item */
 	else
diff --git a/t/op/list.t b/t/op/list.t
index 3f9487b..2acb03a 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc(qw(. ../lib));
 }
 
-plan( tests => 71 );
+plan( tests => 72 );
 
 @foo = (1, 2, 3, 4);
 cmp_ok($foo[0], '==', 1, 'first elem');
@@ -228,3 +228,43 @@ ok(($0[()[()]],1), "[perl #126193] list slice with zero indexes");
     @x;
     pass('no panic'); # panics only under DEBUGGING
 }
+
+fresh_perl_is(<<'EOS', "", {}, "[perl #131954] heap use after free in pp_list");
+#!./perl
+BEGIN {
+my $bar = "bar";
+
+sub test_no_error {
+    eval $_[0];
+}
+
+test_no_error($_) for split /\n/,
+q[	x
+	definfoo, $bar;
+	x
+	x
+	x
+	grep((not $bar, $bar, $bar), $bar);
+        x
+        x
+    x
+        x
+        x
+        x
+        x
+        x
+        x
+        x
+        x
+        x
+        x
+       x
+        x
+        x
+        x
+        x
+        x
+        x
+ ];
+}
+EOS
-- 
2.1.4

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

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

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From imdb95@gmail.com

Thank you for quick reply.This is the first time i submit a perl bug. Would this bug qualify for a bounty?
Thank you,
Manh

Gửi từ điện thoại thông minh Samsung Galaxy của tôi.-------- Tin nhắn gốc --------Từ​: Tony Cook via RT <perl5-security-report@​perl.org> Ngày​: 24/08/2017 13​:03 (GMT+07​:00) Đến​: imdb95@​gmail.com Chủ đề​: [perl #131954] heap-use-after-free in pp.c​:Perl_pp_list()
On Wed, 23 Aug 2017 21​:07​:53 -0700, imdb95@​gmail.com wrote​:

Hello,
I found this bug when fuzzing perl5 with afl-fuzz.

Right after that, at pp.c​:51257
       *MARK = *SP

With mark = 0x6110000013f0, within the range of
[0x611000001300;0x611000001300+1336), which has been freed.
=> heap-use-after-free

Thanks for the analysis, it made this very easy to fix, per the attached patch.

As an attack, it overwrites a single pointer worth of memory with an address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address are zeros, but not much beyond that.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From @jhi

The Perl project does not offer bug bounties, sorry. Perl is an open source
project and those do not usually have budgets for bug bounties.

to 24. elokuuta 2017 klo 12.54 imdb95 <imdb95@​gmail.com> kirjoitti​:

Thank you for quick reply.
This is the first time i submit a perl bug. Would this bug qualify for a
bounty?

Thank you,

Manh

Gửi từ điện thoại thông minh Samsung Galaxy của tôi.
-------- Tin nhắn gốc --------
Từ​: Tony Cook via RT <perl5-security-report@​perl.org>
Ngày​: 24/08/2017 13​:03 (GMT+07​:00)
Đến​: imdb95@​gmail.com
Chủ đề​: [perl #131954] heap-use-after-free in pp.c​:Perl_pp_list()

On Wed, 23 Aug 2017 21​:07​:53 -0700, imdb95@​gmail.com wrote​:

Hello,
I found this bug when fuzzing perl5 with afl-fuzz.

Right after that, at pp.c​:51257
*MARK = *SP

With mark = 0x6110000013f0, within the range of
[0x611000001300;0x611000001300+1336), which has been freed.
=> heap-use-after-free

Thanks for the analysis, it made this very easy to fix, per the attached
patch.

As an attack, it overwrites a single pointer worth of memory with an
address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address are
zeros, but not much beyond that.

Tony

--
There is this special biologist word we use for 'stable'. It is 'dead'. --
Jack Cohen

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From imdb95@gmail.com

Oh, I read about HackerOne​:
https://hackerone.com/ibb-perl
Could you explain this to me please?

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2017

From @nwc10

On Thu, Aug 24, 2017 at 12​:24​:34PM +0000, Jarkko Hietaniemi wrote​:

The Perl project does not offer bug bounties, sorry. Perl is an open source
project and those do not usually have budgets for bug bounties.

However HackerOne (completely independently) does offer a bug bounty program
for various projects, including Perl​: https://hackerone.com/ibb-perl

This might be eligible for their bounty. Given that their steps are​:

  Submission Process

  * Disclose a previously unknown security vulnerability directly to the
  project maintainers.
  * Follow the disclosure process established by the project maintainers.
  * Clearly demonstrate the security vulnerability. Respect the time of
  the project volunteers as they cannot invest significant effort into
  incomplete reports. Low-quality reports may be disqualified.
  * Once a public security advisory has been issued, please submit a
  report here. You must not send us the details of the vulnerability
  until it has been validated, accepted, and publicly disclosed by the
  project maintainers.

if you wanted to follow this up with them, I think you'd

1) need to figure out how to comply with their requirement to
  "clearly demonstrate demonstrate the security vulnerability"
  (where at a minimum they pay out on "probable remote exploitation
  potential")
2) hold off with details until this bug is public (which likely would be as
  soon as its fix is merged into the active maintenance branches)

HackerOne's rider about "cannot invest significant effort" applies here.

I'm personally not aware of any existing framework for remote exploits of
Perl applications into which your vulnerability could simply be "plugged"
to unambiguously meet their qualification criteria. I can't speak for the
other volunteers on the security list as to that specifically, but I am
confident that given how under-resourced we feel we are for locating and
fixing the bugs themselves, that the list as a whole will not able to help
further with crafting an exploit that uses this (or anything time consuming
that HackerOne might ask for)

I have no idea how HackerOne assess eligibility (beyond what I read on their
public website), so likely you'd need to contact them to ask. However, given
Tony's assessment​:

  As an attack, it overwrites a single pointer worth of memory with an
  address the attacker has little control over. On a 64-bit system they
  could predict the high-bytes of the address are zeros, but not much
  beyond that.

I'm *guessing* that it's going to be hard to demonstrate that it has
"probable remote exploitation potential"* without an actual working exploit,
and for *remote* exploitation potential that means that one has to find a
way to feed malicious input data to existing code (running exposed to the
Internet - for example a Web App written in any Perl framework of your
choosing that happens to already have suitable existing code)

Less than that and it's not a remote exploit.

To me that looks like a lot of work for a low chance of payout *for this
bug*. I'm guessing that continuing to fuzz in the hope of finding bugs with
better exploit potential is more likely to meet their payout criteria.

Whilst *we* can't offer you monetary bounties, we can offer you thanks and
"eternal fame" (ie your name is added to the contributor list).

Thanks for reporting this bug, and for the very clear analysis, and good
luck with finding more.

Nicholas Clark

* they clarify remote exploitation as "typically Arbitrary Code Execution or
  equivalent impact". I assume that by "lower severity issues are not in
  scope at this time", I'm inferring that they remote denial of service, or
  local exploit potential.

@p5pRT
Copy link
Author

p5pRT commented Aug 27, 2017

From imdb95@gmail.com

Hello,
Have this issue been fixed?

On Thu, Aug 24, 2017 at 1​:03 PM, Tony Cook via RT <
perl5-security-report@​perl.org> wrote​:

On Wed, 23 Aug 2017 21​:07​:53 -0700, imdb95@​gmail.com wrote​:

Hello,
I found this bug when fuzzing perl5 with afl-fuzz.

Right after that, at pp.c​:51257
*MARK = *SP

With mark = 0x6110000013f0, within the range of
[0x611000001300;0x611000001300+1336), which has been freed.
=> heap-use-after-free

Thanks for the analysis, it made this very easy to fix, per the attached
patch.

As an attack, it overwrites a single pointer worth of memory with an
address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address are
zeros, but not much beyond that.

Tony

From 6197d39797b6d1113c7129ac838eba5e3479b381 Mon Sep 17 00​:00​:00 2001
From​: Tony Cook <tony@​develop-help.com>
Date​: Thu, 24 Aug 2017 15​:52​:33 +1000
Subject​: (perl #131954) don't initialize mark before a possible move of the
stack

---
pp.c | 4 +++-
t/op/list.t | 42 +++++++++++++++++++++++++++++++++++++++++-
2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/pp.c b/pp.c
index 46366c3..2898d15 100644
--- a/pp.c
+++ b/pp.c
@​@​ -5120,9 +5120,11 @​@​ PP(pp_list)
{
I32 markidx = POPMARK;
if (GIMME_V != G_ARRAY) {
- SV **mark = PL_stack_base + markidx;
+ /* don't initialize mark here, EXTEND() may move the stack */
+ SV **mark;
dSP;
EXTEND(SP, 1); /* in case no arguments, as in @​empty */
+ mark = PL_stack_base + markidx;
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item
*/
else
diff --git a/t/op/list.t b/t/op/list.t
index 3f9487b..2acb03a 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@​@​ -6,7 +6,7 @​@​ BEGIN {
set_up_inc(qw(. ../lib));
}

-plan( tests => 71 );
+plan( tests => 72 );

@​foo = (1, 2, 3, 4);
cmp_ok($foo[0], '==', 1, 'first elem');
@​@​ -228,3 +228,43 @​@​ ok(($0[()[()]],1), "[perl #126193] list slice with
zero indexes");
@​x;
pass('no panic'); # panics only under DEBUGGING
}
+
+fresh_perl_is(<<'EOS', "", {}, "[perl #131954] heap use after free in
pp_list");
+#!./perl
+BEGIN {
+my $bar = "bar";
+
+sub test_no_error {
+ eval $_[0];
+}
+
+test_no_error($_) for split /\n/,
+q[ x
+ definfoo, $bar;
+ x
+ x
+ x
+ grep((not $bar, $bar, $bar), $bar);
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ ];
+}
+EOS
--
2.1.4

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @tonycoz

On Thu, 24 Aug 2017 08​:21​:16 -0700, nicholas wrote​:

I have no idea how HackerOne assess eligibility (beyond what I read on
their
public website), so likely you'd need to contact them to ask. However,
given
Tony's assessment​:

As an attack, it overwrites a single pointer worth of memory with an
address the attacker has little control over. On a 64-bit system they
could predict the high-bytes of the address are zeros, but not much
beyond that.

AFAIK Hackerone lets each project decide whether an issue is a security vulnerability or not.

As an aside - the eval is not required for this code to write to a freed block, removig the sub definition and changing the loop to​:

grep((not $bar, $bar, $bar), $bar) for split /\n/,
...

also writes to a freed block.

So vaguely sane code can misbehave with the right input here which might be supplied by an attacker.

Depending on the implementation of malloc, that might result in perl segfaulting, which could be a denial of service.

I don't think it can reasonably result in code execution - the memory overwritten in within a memory block which has only just been freed (by EXTEND()) so it's unlikely to overwrite any heap housekeeping data which might be at that location for new allocations within the freed block.

This was introduced in v5.27.1-248-gb54564c which might make us feel safe since we don't do security support for blead-ish releases, but unfortunately this was backported to maint-5.26 as v5.26.0-16-g6a20648 (which fixed 131732, not 131627.)

I'd tend to treat this issue as a security issue, but it's difficult to tell - and if this is a security issue, 131732 was one too.

Tony

@p5pRT
Copy link
Author

p5pRT commented Nov 29, 2017

From @iabyn

On Thu, Aug 24, 2017 at 1​:03 PM, Tony Cook via RT <

Thanks for the analysis, it made this very easy to fix, per the attached
patch.

As an attack, it overwrites a single pointer worth of memory with an
address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address are
zeros, but not much beyond that.

Tony, any particular reason why this patch hasn't been applied yet?

From 6197d39797b6d1113c7129ac838eba5e3479b381 Mon Sep 17 00​:00​:00 2001
From​: Tony Cook <tony@​develop-help.com>
Date​: Thu, 24 Aug 2017 15​:52​:33 +1000
Subject​: (perl #131954) don't initialize mark before a possible move of the
stack

---
pp.c | 4 +++-
t/op/list.t | 42 +++++++++++++++++++++++++++++++++++++++++-
2 files changed, 44 insertions(+), 2 deletions(-)

diff --git a/pp.c b/pp.c
index 46366c3..2898d15 100644
--- a/pp.c
+++ b/pp.c
@​@​ -5120,9 +5120,11 @​@​ PP(pp_list)
{
I32 markidx = POPMARK;
if (GIMME_V != G_ARRAY) {
- SV **mark = PL_stack_base + markidx;
+ /* don't initialize mark here, EXTEND() may move the stack */
+ SV **mark;
dSP;
EXTEND(SP, 1); /* in case no arguments, as in @​empty */
+ mark = PL_stack_base + markidx;
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item
*/
else
diff --git a/t/op/list.t b/t/op/list.t
index 3f9487b..2acb03a 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@​@​ -6,7 +6,7 @​@​ BEGIN {
set_up_inc(qw(. ../lib));
}

-plan( tests => 71 );
+plan( tests => 72 );

@​foo = (1, 2, 3, 4);
cmp_ok($foo[0], '==', 1, 'first elem');
@​@​ -228,3 +228,43 @​@​ ok(($0[()[()]],1), "[perl #126193] list slice with
zero indexes");
@​x;
pass('no panic'); # panics only under DEBUGGING
}
+
+fresh_perl_is(<<'EOS', "", {}, "[perl #131954] heap use after free in
pp_list");
+#!./perl
+BEGIN {
+my $bar = "bar";
+
+sub test_no_error {
+ eval $_[0];
+}
+
+test_no_error($_) for split /\n/,
+q[ x
+ definfoo, $bar;
+ x
+ x
+ x
+ grep((not $bar, $bar, $bar), $bar);
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ x
+ ];
+}
+EOS
--
2.1.4

--
Monto Blanco... scorchio!

@p5pRT
Copy link
Author

p5pRT commented Jan 17, 2018

From @tonycoz

On Wed, 29 Nov 2017 01​:23​:16 -0800, davem wrote​:

On Thu, Aug 24, 2017 at 1​:03 PM, Tony Cook via RT <

Thanks for the analysis, it made this very easy to fix, per the
attached
patch.

As an attack, it overwrites a single pointer worth of memory with an
address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address
are
zeros, but not much beyond that.

Tony, any particular reason why this patch hasn't been applied yet?

Mostly indecisiveness on whether to treat this as a security issue.

I've applied this as 57bd660 and made the ticket public.

I've also added this to the 5.26 maint-votes file since the patch that introduced the bug was backported to maint-5.26. Vote early, vote often.

Tony

@p5pRT
Copy link
Author

p5pRT commented Jan 17, 2018

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

@p5pRT
Copy link
Author

p5pRT commented Jan 20, 2018

From @xsawyerx

On 01/17/2018 01​:53 AM, Tony Cook via RT wrote​:

On Wed, 29 Nov 2017 01​:23​:16 -0800, davem wrote​:

On Thu, Aug 24, 2017 at 1​:03 PM, Tony Cook via RT <

Thanks for the analysis, it made this very easy to fix, per the
attached
patch.

As an attack, it overwrites a single pointer worth of memory with an
address the attacker has little control over.

On a 64-bit system they could predict the high-bytes of the address
are
zeros, but not much beyond that.
Tony, any particular reason why this patch hasn't been applied yet?
Mostly indecisiveness on whether to treat this as a security issue.

I've applied this as 57bd660 and made the ticket public.

I've also added this to the 5.26 maint-votes file since the patch that introduced the bug was backported to maint-5.26. Vote early, vote often.

Added my vote +1 to this.

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

From @khwilliamson

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

With the release yesterday of Perl 5.28.0, this and 185 other issues have been
resolved.

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

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

@p5pRT p5pRT closed this as completed Jun 23, 2018
@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

@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
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant