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 Perl_pp_formline pp_ctl.c:543 #15566

Closed
p5pRT opened this issue Aug 29, 2016 · 12 comments

Comments

@p5pRT
Copy link
Collaborator

commented Aug 29, 2016

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

Searchable as RT129125$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Aug 29, 2016

From @geeknik

Perl v5.25.4-20-gc2f7c0b*, AFL, ASAN, libdislocator

Unable to minimize the script as afl-tmin minimizes the crash away, so I've
attached the original crasher.

==8600==ERROR​: AddressSanitizer​: heap-use-after-free on address
0x60f00000ebb0 at pc 0x000000a4530c bp 0x7ffc59356f70 sp 0x7ffc59356f68
READ of size 4 at 0x60f00000ebb0 thread T0
  #0 0xa4530b in Perl_pp_formline /root/perl/pp_ctl.c​:543​:2
  #1 0x7f1c63 in Perl_runops_debug /root/perl/dump.c​:2234​:23
  #2 0x5a10a6 in S_run_body /root/perl/perl.c​:2525​:2
  #3 0x5a10a6 in perl_run /root/perl/perl.c​:2448
  #4 0x4de6cd in main /root/perl/perlmain.c​:123​:9
  #5 0x7f8ff9903b44 in __libc_start_main
/build/glibc-uPj9cH/glibc-2.19/csu/libc-start.c​:287
  #6 0x4de33c in _start (/root/perl/perl+0x4de33c)

0x60f00000ebb0 is located 32 bytes inside of 168-byte region
[0x60f00000eb90,0x60f00000ec38)
freed by thread T0 here​:
  #0 0x4c0a3b in __interceptor_free (/root/perl/perl+0x4c0a3b)
  #1 0x7f6974 in Perl_safesysfree /root/perl/util.c​:388​:2

previously allocated by thread T0 here​:
  #0 0x4c0cbb in malloc (/root/perl/perl+0x4c0cbb)
  #1 0x7f5aa7 in Perl_safesysmalloc /root/perl/util.c​:153​:21
  #2 0x7f1c63 in Perl_runops_debug /root/perl/dump.c​:2234​:23

SUMMARY​: AddressSanitizer​: heap-use-after-free /root/perl/pp_ctl.c​:543
Perl_pp_formline
Shadow bytes around the buggy address​:
  0x0c1e7fff9d20​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c1e7fff9d30​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c1e7fff9d40​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c1e7fff9d50​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
  0x0c1e7fff9d60​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
=>0x0c1e7fff9d70​: fa fa fd fd fd fd[fd]fd fd fd fd fd fd fd fd fd
  0x0c1e7fff9d80​: fd fd fd fd fd fd fd fa fa fa fa fa fa fa fa fa
  0x0c1e7fff9d90​: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
  0x0c1e7fff9da0​: 00 00 00 00 00 07 fa fa fa fa fa fa fa fa fd fd
  0x0c1e7fff9db0​: fd fd fd fd fd fd fd fd fd fd fd fd fd fd fd fd
  0x0c1e7fff9dc0​: fd fd fd fd fa fa fa fa fa fa fa fa fd fd fd fd
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
==8600==ABORTING

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Aug 29, 2016

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Aug 30, 2016

From @tonycoz

On Sun Aug 28 23​:29​:59 2016, brian.carpenter@​gmail.com wrote​:

Perl v5.25.4-20-gc2f7c0b*, AFL, ASAN, libdislocator

Unable to minimize the script as afl-tmin minimizes the crash away, so I've
attached the original crasher.

Simplifies to​:

my $x = '^@​';
formline$x=>$x;

The compiled form is stored as magic on the SV ($x), when the chomp op
modifies $x it calls SvSETMAGIC(), releasing the compiled form.

pp_formline() then attempts to access the next op, but accesses freed
memory.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Aug 30, 2016

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Sep 5, 2016

From @tonycoz

On Mon Aug 29 18​:49​:40 2016, tonyc wrote​:

On Sun Aug 28 23​:29​:59 2016, brian.carpenter@​gmail.com wrote​:

Perl v5.25.4-20-gc2f7c0b*, AFL, ASAN, libdislocator

Unable to minimize the script as afl-tmin minimizes the crash away,
so I've
attached the original crasher.

Simplifies to​:

my $x = '^@​';
formline$x=>$x;

The compiled form is stored as magic on the SV ($x), when the chomp op
modifies $x it calls SvSETMAGIC(), releasing the compiled form.

pp_formline() then attempts to access the next op, but accesses freed
memory.

Here's a fix, though it might be a bit heavy-handed.

Another possible fix would be to do the check only in FF_CHOP, and if the
argument SV is set-magical or is the same SV as tmpForm, copy the compiled
format and formsv.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Sep 5, 2016

From @tonycoz

0001-perl-129125-avoid-freeing-the-compiled-format-too-ea.patch
From 15c6e35b3bda690b323da54f6a94509cb9bc34e2 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 5 Sep 2016 12:07:23 +1000
Subject: (perl #129125) avoid freeing the compiled format too early

If the format SV also appeared as an argument, and the FF_CHOP
operator modified that argument, the magic and hence the compiled
format would be freed, and the next iteration of the processing
the compiled format would read freed memory.
---
 pp_ctl.c     | 22 +++++++++++++++++++++-
 t/op/write.t | 11 ++++++++++-
 2 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 0d76286..13ced3f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -464,7 +464,7 @@ S_rxres_free(pTHX_ void **rsp)
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
-    SV * const tmpForm = *++MARK;
+    SV * tmpForm = *++MARK;
     SV *formsv;		    /* contains text of original format */
     U32 *fpc;	    /* format ops program counter */
     char *t;	    /* current append position in target string */
@@ -491,6 +491,26 @@ PP(pp_formline)
     STRLEN to_copy;	    /* how may bytes to append */
     char trans;		    /* what chars to translate */
 
+    {
+        /* It's possible for tmpForm to be the same SV (or a magical alias)
+           to one of the arguments, if so, make a copy to avoid set magic
+           on the argument from releasing the compiled form.
+
+           If the copy is made the compiled form won't be cached.
+        */
+        SV **p;
+        bool copy_form = false;
+
+        for (p = MARK+1; p <= SP; ++p) {
+            if (*p == tmpForm || SvSMAGICAL(*p)) {
+                copy_form = true;
+                break;
+            }
+        }
+        if (copy_form || (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm)))
+            tmpForm = sv_mortalcopy(tmpForm);
+    }
+
     mg = doparseform(tmpForm);
 
     fpc = (U32*)mg->mg_ptr;
diff --git a/t/op/write.t b/t/op/write.t
index 93f70fa..1a2462c 100644
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -98,7 +98,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 21;
 
 # number of tests in section 3
-my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 4;
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 5 + 2 + 3 + 96 + 11 + 4;
 
 # number of tests in section 4
 my $hmb_tests = 37;
@@ -1637,6 +1637,15 @@ printf ">%s<\n", ref $zamm;
 print "$zamm->[0]\n";
 EOP
 
+# [perl #129125] - detected by -fsanitize=address or valgrind
+# the compiled format would be freed when the format string was modified
+# by the chop operator
+fresh_perl_is(<<'EOP', "^", { stderr => 1 }, '#129125 - chop on format');
+my $x = '^@';
+formline$x=>$x;
+print $^A;
+EOP
+
 # [perl #73690]
 
 select +(select(RT73690), do {
-- 
2.1.4

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Oct 23, 2016

From @tonycoz

On Sun Sep 04 19​:09​:46 2016, tonyc wrote​:

Here's a fix, though it might be a bit heavy-handed.

Another possible fix would be to do the check only in FF_CHOP, and if the
argument SV is set-magical or is the same SV as tmpForm, copy the compiled
format and formsv.

Attached.

I don't *think* this is a security issue.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Oct 23, 2016

From @tonycoz

0001-perl-129125-only-copy-the-form-data-if-needed.patch
From 65318c6e5b5b8d347fcf04e35752a9f5dad8739f Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 24 Oct 2016 10:45:14 +1100
Subject: (perl #129125) only copy the form data if needed

Also, unlike my original patch this copies the formsv too, since
that is also stored in the magic, and is needed for presenting
literal text from the format.
---
 pp_ctl.c     | 18 ++++++++++++++++++
 t/op/write.t | 19 ++++++++++++++++++-
 2 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 36b68b6..37ff886 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -478,6 +478,7 @@ PP(pp_formline)
     U8 *source;		    /* source of bytes to append */
     STRLEN to_copy;	    /* how may bytes to append */
     char trans;		    /* what chars to translate */
+    bool copied_form = false; /* have we duplicated the form? */
 
     mg = doparseform(tmpForm);
 
@@ -675,6 +676,23 @@ PP(pp_formline)
 	case FF_CHOP: /* (for ^*) chop the current item */
 	    if (sv != &PL_sv_no) {
 		const char *s = chophere;
+                if (!copied_form &&
+                    ((sv == tmpForm || SvSMAGICAL(sv))
+                     || (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm))) ) {
+                    /* sv and tmpForm are either the same SV, or magic might allow modification
+                       of tmpForm when sv is modified, so copy */
+                    SV *newformsv = sv_mortalcopy(formsv);
+                    U32 *new_compiled;
+
+                    f = SvPV_nolen(newformsv) + (f - SvPV_nolen(formsv));
+                    Newx(new_compiled, mg->mg_len / sizeof(U32), U32);
+                    memcpy(new_compiled, mg->mg_ptr, mg->mg_len);
+                    SAVEFREEPV(new_compiled);
+                    fpc = new_compiled + (fpc - (U32*)mg->mg_ptr);
+                    formsv = newformsv;
+
+                    copied_form = true;
+                }
 		if (chopspace) {
 		    while (isSPACE(*s))
 			s++;
diff --git a/t/op/write.t b/t/op/write.t
index 93f70fa..3172681 100644
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -98,7 +98,7 @@ for my $tref ( @NumTests ){
 my $bas_tests = 21;
 
 # number of tests in section 3
-my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 4;
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 4;
 
 # number of tests in section 4
 my $hmb_tests = 37;
@@ -1637,6 +1637,23 @@ printf ">%s<\n", ref $zamm;
 print "$zamm->[0]\n";
 EOP
 
+# [perl #129125] - detected by -fsanitize=address or valgrind
+# the compiled format would be freed when the format string was modified
+# by the chop operator
+fresh_perl_is(<<'EOP', "^", { stderr => 1 }, '#129125 - chop on format');
+my $x = '^@';
+formline$x=>$x;
+print $^A;
+EOP
+
+fresh_perl_is(<<'EOP', '<^< xx AA><xx ^<><>', { stderr => 1 }, '#129125 - chop on format, later values');
+my $x = '^< xx ^<';
+my $y = 'AA';
+formline $x => $x, $y;
+print "<$^A><$x><$y>";
+EOP
+
+
 # [perl #73690]
 
 select +(select(RT73690), do {
-- 
2.1.4

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Jan 19, 2017

From @tonycoz

On Sun, 23 Oct 2016 16​:57​:27 -0700, tonyc wrote​:

On Sun Sep 04 19​:09​:46 2016, tonyc wrote​:

Here's a fix, though it might be a bit heavy-handed.

Another possible fix would be to do the check only in FF_CHOP, and if the
argument SV is set-magical or is the same SV as tmpForm, copy the compiled
format and formsv.

Attached.

Applied as 86191ae.

I don't *think* this is a security issue.

Everyone must agree, made it public.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

commented Jan 19, 2017

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

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

This comment has been minimized.

Copy link
Collaborator Author

commented May 30, 2017

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

@p5pRT p5pRT closed this May 30, 2017
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.