Fix a use-after-free when processing scalar variables in forms
This commit is contained in:
Petr Písař
parent
96616c59c9
commit
64c060a679
|
|
@ -0,0 +1,107 @@
|
|||
From 0c43d46cd570d2a19edfa54b9c637dea5c0a3514 Mon Sep 17 00:00:00 2001
|
||||
From: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu, 19 Jan 2017 16:28:03 +1100
|
||||
Subject: [PATCH] (perl #129125) copy form data if it might be freed
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit 86191aed6f092273950ebdd48f886d4ec0c5e85e
|
||||
Author: Tony Cook <tony@develop-help.com>
|
||||
Date: Thu Jan 19 16:28:03 2017 +1100
|
||||
|
||||
(perl #129125) copy form data if it might be freed
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
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 b94c09a..e859e01 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -490,6 +490,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);
|
||||
|
||||
@@ -687,6 +688,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 590d658..ab2733f 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 + 3;
|
||||
+my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 3;
|
||||
|
||||
# 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.7.4
|
||||
|
||||
|
|
@ -244,6 +244,10 @@ Patch66: perl-5.24.1-perl-130262-split-scalar-context-stack-overflow-fix.
|
|||
Patch67: perl-5.25.8-perl-129149-avoid-a-heap-buffer-overflow-with-pack-W.patch
|
||||
Patch68: perl-5.25.8-perl-129149-fix-the-test-so-skip-has-a-SKIP-to-work-.patch
|
||||
|
||||
# Fix a use-after-free when processing scalar variables in forms, RT#129125,
|
||||
# in upstream after 5.25.8
|
||||
Patch69: perl-5.24.1-perl-129125-copy-form-data-if-it-might-be-freed.patch
|
||||
|
||||
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
||||
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
||||
|
||||
|
|
@ -2936,6 +2940,7 @@ Perl extension for Version Objects
|
|||
%patch66 -p1
|
||||
%patch67 -p1
|
||||
%patch68 -p1
|
||||
%patch69 -p1
|
||||
%patch200 -p1
|
||||
%patch201 -p1
|
||||
|
||||
|
|
@ -2992,6 +2997,7 @@ perl -x patchlevel.h \
|
|||
'Fedora Patch65: Fix regular expression matching (RT#130307)' \
|
||||
'Fedora Patch66: Fix a buffer overflow in split in scalar context (RT#130262)' \
|
||||
'Fedora Patch67: Fix a heap overflow with pack "W" (RT129149)' \
|
||||
'Fedora Patch69: Fix a use-after-free when processing scalar variables in forms (RT#129125)' \
|
||||
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
||||
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||
%{nil}
|
||||
|
|
@ -5271,6 +5277,7 @@ popd
|
|||
* Fri Jan 20 2017 Petr Pisar <ppisar@redhat.com> - 4:5.24.1-386
|
||||
- Fix a buffer overflow in split in scalar context (RT#130262)
|
||||
- Fix a heap overflow with pack "W" (RT129149)
|
||||
- Fix a use-after-free when processing scalar variables in forms (RT#129125)
|
||||
|
||||
* Mon Jan 16 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.24.1-385
|
||||
- 5.24.1 bump (see <http://search.cpan.org/dist/perl-5.24.1/pod/perldelta.pod>
|
||||
|
|
|
|||
Loading…
Reference in New Issue