[perl #94560] [PATCH v5.12.4-1-gea42574] large repeat count causes heap corruption

# New Ticket Created by  Jim Meyering 
# Please include the string:  [perl #94560]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=94560 >


I first noticed this using Fedora 15's perl-5.12.4-159.fc15.x86_64,
but reproduced (below) using the latest built from git on the maint-5.12
branch.

Using a large string repeat count makes perl overrun a heap buffer:

  $ ./perl -le 'print "v"x(2**31+1)'
  [Exit 139 (SEGV)]

If you use an approx. doubled count (s/31/32), you can make Perl
fail to initialize a 4GiB buffer and then proceed to write all of
that uninitialized data to output:

  $ ./perl -le 'print "v"x(2**32+1)' > out
  ("out" starts with "v", and the following 4GiB are from
  uninitialized heap)

Why?  Because the caller of Perl_repeatcpy uses a type of IV
for the "count" variable corresponding to our counts, while
Perl_repeatcpy itself uses the narrower type of I32.
When you pass "count - 1" to Perl_repeatcpy you get INT_MIN
in the first case, and 0 in the second.
Passing INT_MIN as the count here,

    util.c:3037:	memset(to, *from, count);

sign-extends to SIZE_MAX, and no one has that much memory,
so the memset scribbles well beyond the "to" buffer.

As for fixing it, I've included a patch that works for me, but it's
probably not so simple.  I doubt you can so easily change a public API
like Perl_repeatcpy, even if it's so fundamentally limited.  Besides,
if you want to fix this, I suspect that this is just one manifestation
of a larger problem.  For example, what if the string itself has length
larger than INT_MAX?  Same problem, maybe, since the "len" parameter
also has type I32.

-- >8 --
Subject: [PATCH] don't segfault given string repeat count larger than 2^31

E.g., this overflows INT_MAX and overruns heap memory:

    $ perl -le 'print "v"x(2**31+1)'
    [Exit 139 (SEGV)]

(Perl_repeatcpy): Use the same type for "count" as our sole
callers in pp.c: IV (long), not I32 (int).  Otherwise, passing
the wider value to a narrower "I32 count"
---
 proto.h |    2 +-
 util.c  |    8 ++++----
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/proto.h b/proto.h
index 3306ab0..e402ac2 100644
--- a/proto.h
+++ b/proto.h
@@ -2801,7 +2801,7 @@ PERL_CALLCONV void	Perl_regprop(pTHX_ const regexp *prog, SV* sv, const regnode*
 #define PERL_ARGS_ASSERT_REGPROP	\
 	assert(sv); assert(o)

-PERL_CALLCONV void	Perl_repeatcpy(char* to, const char* from, I32 len, I32 count)
+PERL_CALLCONV void	Perl_repeatcpy(char* to, const char* from, I32 len, IV count)
 			__attribute__nonnull__(1)
 			__attribute__nonnull__(2);
 #define PERL_ARGS_ASSERT_REPEATCPY	\
diff --git a/util.c b/util.c
index 89fea23..1518a95 100644
--- a/util.c
+++ b/util.c
@@ -3029,7 +3029,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)

 #define PERL_REPEATCPY_LINEAR 4
 void
-Perl_repeatcpy(register char *to, register const char *from, I32 len, register I32 count)
+Perl_repeatcpy(register char *to, register const char *from, I32 len, register IV count)
 {
     PERL_ARGS_ASSERT_REPEATCPY;

@@ -3037,19 +3037,19 @@ Perl_repeatcpy(register char *to, register const char *from, I32 len, register I
 	memset(to, *from, count);
     else if (count) {
 	register char *p = to;
-	I32 items, linear, half;
+	IV items, linear, half;

 	linear = count < PERL_REPEATCPY_LINEAR ? count : PERL_REPEATCPY_LINEAR;
 	for (items = 0; items < linear; ++items) {
 	    register const char *q = from;
-	    I32 todo;
+	    IV todo;
 	    for (todo = len; todo > 0; todo--)
 		*p++ = *q++;
         }

 	half = count / 2;
 	while (items <= half) {
-	    I32 size = items * len;
+	    IV size = items * len;
 	    memcpy(p, to, size);
 	    p     += size;
 	    items *= 2;
--
1.7.6.430.g34be2


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=medium
---
Site configuration information for perl 5.12.4:

Configured by meyering at Mon Jul 11 18:32:01 CEST 2011.

Summary of my perl5 (revision 5 version 12 subversion 4) configuration:
  Commit id: ea42574774cb2e3ace8e32e92fa69595c6c233e9
  Platform:
    osname=linux, osvers=2.6.38.8-32.fc15.x86_64, archname=x86_64-linux
    uname='linux hx.meyering.net 2.6.38.8-32.fc15.x86_64 #1 smp mon jun 13 19:49:05 utc 2011 x86_64 gnulinux '
    config_args='-ds -e CFLAGS=-g -Dprefix=/p/p/perl'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-g',
    cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.6.0 20110530 (Red Hat 4.6.0-9)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /usr/lib /lib64 /usr/lib64 /usr/local/lib64
    libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.14'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -g -L/usr/local/lib -fstack-protector'

Locally applied patches:


---
@INC for perl 5.12.4:
    /p/p/perl/lib/site_perl/5.13.2/x86_64-linux
    /p/p/perl/lib/site_perl/5.13.2
    /p/p/perl/lib/5.13.2/x86_64-linux
    /p/p/perl/lib/5.13.2
    .

---
Environment for perl 5.12.4:
    HOME=/h/j
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_ALL=C
    LC_COLLATE=C
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/opt/cov-sa-linux64-5.3.0/bin:/usr/lib64/ccache:/h/j/bin/perl:/h/j/bin:/p/p/git/bin:/p/bin:/sbin:/usr/sbin:/bin:/usr/bin:/usr/local:/usr/local/bin
    PERL_BADLANG (unset)
    SHELL=/bin/zsh

• [perl #94560] [PATCH v5.12.4-1-gea42574] large repeat count causes heap corruption by Jim Meyering