Segmentation fault in pack (S_pack_rec tries to access unallocated memory) #14977
Comments
From @dcollinsnGreetings Porters, I have compiled bleadperl with the afl-gcc compiler using: ./Configure -Dusedevel -Dprefix='/usr/local/perl-afl' -Dcc='ccache afl-gcc' -Duselongdouble -Duse64bitall -Doptimize=-g -Uversiononly -Uman1dir -Uman3dir -des And then fuzzed the resulting binary using: AFL_NO_VAR_CHECK=1 afl-fuzz -i in -o out bin/perl @@ After reducing testcases using `afl-tmin` and performing additional minimization by hand, I have located the following testcase that triggers a segmentation fault in the perl interpreter. The testcase is the file: pack+WH200000,\0 Today I'm reporting a pair of bugs related to pack/unpack. They appeared to be related, but GDB shows that they have very different behaviours. This is by far the tamer of the two. **GDB** (gdb) run Program received signal SIGSEGV, Segmentation fault. **VALGRIND** ==31388== Memcheck, a memory error detector **PERL -V** Summary of my perl5 (revision 5 version 23 subversion 4) configuration: Characteristics of this binary (from libperl): |
From @tonycozOn Sun Oct 11 04:49:37 2015, dcollinsn@gmail.com wrote:
The attached seems to fix it. I'm going to review the other pack handlers to check for similar issues. Tony |
From @tonycoz0001-perl-126325-don-t-read-past-the-end-of-the-source-fo.patchFrom 45f3993798e8339daceeb6b1a0ce606da9e8a613 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 22 Oct 2015 12:03:05 +1100
Subject: [perl #126325] don't read past the end of the source for pack [Hh]
With a utf8 target but a non-utf8 source, pack Hh would read past the
end of the source when given a length, due to an incorrect condition.
---
pp_pack.c | 2 +-
t/op/pack.t | 22 +++++++++++++++++++++-
2 files changed, 22 insertions(+), 2 deletions(-)
diff --git a/pp_pack.c b/pp_pack.c
index 96dfd20..044ea7f 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2488,7 +2488,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
if (howlen == e_star) len = fromlen;
field_len = (len+1)/2;
GROWING(utf8, cat, start, cur, field_len);
- if (!utf8 && len > (I32)fromlen) len = fromlen;
+ if (!utf8_source && len > (I32)fromlen) len = fromlen;
bits = 0;
l = 0;
if (datumtype == 'H')
diff --git a/t/op/pack.t b/t/op/pack.t
index e348693..a2da636 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";
-plan tests => 14708;
+plan tests => 14712;
use strict;
use warnings qw(FATAL all);
@@ -2024,3 +2024,23 @@ is $o::num, 1, 'pack "c" does call num overloading';
#[perl #123874]: argument underflow leads to corrupt length
eval q{ pack "pi/x" };
ok(1, "argument underflow did not crash");
+
+{
+ # [perl #126325] pack [hH] with a unicode string
+ # the hex encoders would read past the end of the string, using
+ # invalid source bytes
+ my $twenty_nuls = "\0" x 20;
+ # This is the case that failed
+ is(pack("WH40", 0x100, ""), "\x{100}$twenty_nuls",
+ "check pack H zero fills (utf8 target)");
+ my $up_nul = "\0";
+
+ utf8::upgrade($up_nul);
+ # check the other combinations too
+ is(pack("WH40", 0x100, $up_nul), "\x{100}$twenty_nuls",
+ "check pack H zero fills (utf8 target/source)");
+ is(pack("H40", ""), $twenty_nuls,
+ "check pack H zero fills (utf8 none)");
+ is(pack("H40", $up_nul), $twenty_nuls,
+ "check pack H zero fills (utf8 source)");
+}
--
2.1.4
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Wed Oct 21 18:05:47 2015, tonyc wrote:
Pushed as 0403a1a.
The others seemed ok to me. Tony |
|
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#126325 (status was 'resolved')
Searchable as RT126325$
The text was updated successfully, but these errors were encountered: