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

unpack leads to segmentation fault #10257

Closed
p5pRT opened this issue Mar 25, 2010 · 7 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Mar 25, 2010

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

Searchable as RT73814$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Mar 25, 2010

From mmaslano@redhat.com

Created by mmaslano@redhat.com

From the original report by Richard W.M. Jones
https://bugzilla.redhat.com/show_bug.cgi?id=576824

Description of problem​:

$ perl -e 'use bytes;
print join(",",split(/../,unpack("%02H*","hello world")))'
Segmentation fault

Version-Release number of selected component (if applicable)​:

perl-5.10.1-117.fc14.x86_64

How reproducible​:

Always.

Steps to Reproduce​:
1. Run the above command.

Actual results​:

Core dump.

Stack trace​:

Program received signal SIGSEGV, Segmentation fault.
0x00007ffff7d56670 in Perl_pp_split (my_perl=0x602010) at pp.c​:4619
4619 rx = PM_GETRE(pm);
(gdb) bt
#0 0x00007ffff7d56670 in Perl_pp_split (my_perl=0x602010) at pp.c​:4619
#1 0x00007ffff7d36656 in Perl_runops_standard (my_perl=0x602010) at run.c​:40
#2 0x00007ffff7cdf088 in S_run_body (oldscope=<value optimized out>,
  my_perl=<value optimized out>) at perl.c​:2431
#3 perl_run (oldscope=<value optimized out>, my_perl=<value optimized out>)
  at perl.c​:2349
#4 0x0000000000400c5c in main (argc=3, argv=0x7fffffffe448,
  env=0x7fffffffe468) at perlmain.c​:117
The segmentation faul could be also reproduced on​:
perl -e 'print split(/../,unpack("%02H*","hello world"))'

I've reproduced this bug also with perl-5.11.4.

Perl Info

Flags:
    category=library
    severity=low
    module=base

This perlbug was built using Perl 5.10.1 in the Fedora build system.
It is being executed now by Perl 5.10.1 - Sun Mar  7 06:02:09 UTC 2010.

Site configuration information for perl 5.10.1:

Configured by Red Hat, Inc. at Sun Mar  7 06:02:09 UTC 2010.

Summary of my perl5 (revision 5 version 10 subversion 1) configuration:

  Platform:
    osname=linux, osvers=2.6.18-164.6.1.el5, archname=x86_64-linux-thread-multi
    uname='linux x86-02.phx2.fedoraproject.org 2.6.18-164.6.1.el5 #1 smp tue oct 27 11:28:30 edt 2009 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Doptimize=-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DDEBUGGING=-g -Accflags=-DPERL_USE_SAFE_PUTENV -Dversion=5.10.1 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dprefix=/usr -Dvendorprefix=/usr -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl5 -Dsitearch=/usr/local/lib64/perl5 -Dprivlib=/usr/share/perl5 -Dvendorlib=/usr/share/perl5 -Darchlib=/usr/lib64/perl5 -Dvendorarch=/usr/lib64/perl5 -Dinc_version_list=5.10.0 -Darchname=x86_64-linux-thread-multi -Dlibpth=/usr/local/lib64 /lib64 /usr/lib64 -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto -Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto -Ud_endservent_r_proto -Ud_setservent_r_proto -Dscriptdir=/usr/bin -Dotherlibdirs=/usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi:/usr/local/lib/perl5/site_perl/5.10.0:/usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi:/usr/lib/perl5/vendor_perl:/usr/lib/perl5/site_perl'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DPERL_USE_SAFE_PUTENV -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.4.3 20100211 (Red Hat 4.4.3-6)', 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='gcc', ldflags =' -fstack-protector'
    libpth=/usr/local/lib64 /lib64 /usr/lib64
    libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.11.90'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib64/perl5/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic'

Locally applied patches:



@INC for perl 5.10.1:
    /usr/local/lib64/perl5
    /usr/local/share/perl5
    /usr/local/share/perl5
    /usr/lib64/perl5
    /usr/share/perl5
    /usr/share/perl5
    /usr/lib64/perl5
    /usr/share/perl5
    /usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi
    /usr/local/lib/perl5/site_perl/5.10.0
    /usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.10.0
    /usr/lib/perl5/vendor_perl
    /usr/lib/perl5/site_perl
    .


Environment for perl 5.10.1:
    HOME=/home/marca
    LANG=en_US.UTF-8
    LANGUAGE=
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/lib64/ccache:/usr/lib64/qt-3.3/bin:/usr/kerberos/sbin:/usr/kerberos/bin:/usr/lib64/ccache:/usr/local/bin:/usr/bin:/bin:/usr/games:/usr/local/sbin:/usr/sbin:/sbin:/home/marca/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Mar 26, 2010

From @rgarcia

On 25 March 2010 14​:17, Marcela Maslanova <perlbug-followup@​perl.org> wrote​:

Description of problem​:

$ perl -e 'use bytes;
print join(",",split(/../,unpack("%02H*","hello world")))'
Segmentation fault

Shorter test case :

$ ./perl -e 'split/a/,unpack("%02H*","a")'
Segmentation fault

Looks like split has difficulties with its argument list there, which
boils down apparently to unpack returning too many values :

$ perl -le 'print for scalar unpack("%02H*","a")'
61
0

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Mar 26, 2010

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 23, 2010

From @tonycoz

On Fri, Mar 26, 2010 at 10​:57​:27AM +0100, Rafael Garcia-Suarez wrote​:

On 25 March 2010 14​:17, Marcela Maslanova <perlbug-followup@​perl.org> wrote​:

Description of problem​:

$ perl -e 'use bytes;
print join(",",split(/../,unpack("%02H*","hello world")))'
Segmentation fault

Shorter test case :

$ ./perl -e 'split/a/,unpack("%02H*","a")'
Segmentation fault

Looks like split has difficulties with its argument list there, which
boils down apparently to unpack returning too many values :

$ perl -le 'print for scalar unpack("%02H*","a")'
61
0

The H and u formats were returning the unpack()ed text as well as the
checksum.

Patch with tests attached.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 23, 2010

From @tonycoz

0001-RT-73814-unpack-didn-t-handle-scalar-context-cor.patch
From aee0279a5d6c3c12063e2c5488b35e88ccd13c54 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Fri, 23 Apr 2010 19:28:35 +1000
Subject: [PATCH] RT#73814 - unpack() didn't handle scalar context correctly for %32H and %32u

split() would crash because the third item on the stack wasn't the
regular expression it expected.  unpack("%2H", ...) would return both
the unpacked result and the checksum on the stack, similarly for
unpack("%2u", ...).
---
 pp_pack.c   |   33 +++++++++++++++++++++------------
 t/op/pack.t |   10 +++++++++-
 2 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/pp_pack.c b/pp_pack.c
index 0670548..0ae8afd 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1562,9 +1562,11 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    /* Preliminary length estimate, acceptable for utf8 too */
 	    if (howlen == e_star || len > (strend - s) * 2)
 		len = (strend - s) * 2;
-	    sv = sv_2mortal(newSV(len ? len : 1));
-	    SvPOK_on(sv);
-	    str = SvPVX(sv);
+	    if (!checksum) {
+		sv = sv_2mortal(newSV(len ? len : 1));
+		SvPOK_on(sv);
+		str = SvPVX(sv);
+	    }
 	    if (datumtype == 'h') {
 		U8 bits = 0;
 		I32 ai32 = len;
@@ -1574,7 +1576,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			if (s >= strend) break;
 			bits = uni_to_byte(aTHX_ &s, strend, datumtype);
 		    } else bits = * (U8 *) s++;
-		    *str++ = PL_hexdigit[bits & 15];
+		    if (!checksum)
+			*str++ = PL_hexdigit[bits & 15];
 		}
 	    } else {
 		U8 bits = 0;
@@ -1585,12 +1588,15 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			if (s >= strend) break;
 			bits = uni_to_byte(aTHX_ &s, strend, datumtype);
 		    } else bits = *(U8 *) s++;
-		    *str++ = PL_hexdigit[(bits >> 4) & 15];
+		    if (!checksum)
+			*str++ = PL_hexdigit[(bits >> 4) & 15];
 		}
 	    }
-	    *str = '\0';
-	    SvCUR_set(sv, str - SvPVX_const(sv));
-	    XPUSHs(sv);
+	    if (!checksum) {
+		*str = '\0';
+		SvCUR_set(sv, str - SvPVX_const(sv));
+		XPUSHs(sv);
+	    }
 	    break;
 	}
 	case 'C':
@@ -2123,7 +2129,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 	    break;
 #endif
 	case 'u':
-	    {
+	    if (!checksum) {
                 const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
 		sv = sv_2mortal(newSV(l));
 		if (l) SvPOK_on(sv);
@@ -2141,7 +2147,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			hunk[0] = (char)((a << 2) | (b >> 4));
 			hunk[1] = (char)((b << 4) | (c >> 2));
 			hunk[2] = (char)((c << 6) | d);
-			sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
+			if (!checksum)
+			    sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
 			len -= 3;
 		    }
 		    if (s < strend) {
@@ -2182,7 +2189,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			hunk[0] = (char)((a << 2) | (b >> 4));
 			hunk[1] = (char)((b << 4) | (c >> 2));
 			hunk[2] = (char)((c << 6) | d);
-			sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
+			if (!checksum)
+			    sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
 			len -= 3;
 		    }
 		    if (*s == '\n')
@@ -2192,7 +2200,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 			    s += 2;
 		}
 	    }
-	    XPUSHs(sv);
+	    if (!checksum)
+		XPUSHs(sv);
 	    break;
 	}
 
diff --git a/t/op/pack.t b/t/op/pack.t
index 4b5f9a5..5775caf 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 => 14697;
+plan tests => 14699;
 
 use strict;
 use warnings qw(FATAL all);
@@ -1985,3 +1985,11 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
     my ($v) = split //, unpack ('(B)*', 'ab');
     is($v, 0); # Doesn't SEGV :-)
 }
+{
+    #73814
+    my $x = runperl( prog => 'print split( /,/, unpack(q(%2H*), q(hello world))), qq(\n)' );
+    is($x, "0\n", "split /a/, unpack('%2H*'...) didn't crash");
+
+    my $y = runperl( prog => 'print split( /,/, unpack(q(%32u*), q(#,3,Q)), qq(\n)), qq(\n)' );
+    is($y, "0\n", "split /a/, unpack('%32u*'...) didn't crash");
+}
-- 
1.5.6.5

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 30, 2010

@rgs - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this Apr 30, 2010
@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 30, 2010

From @rgarcia

On 23 April 2010 11​:56, Tony Cook <tony@​develop-help.com> wrote​:

The H and u formats were returning the unpack()ed text as well as the
checksum.

Patch with tests attached.

Thanks, applied to bleadperl as 858fe5e.

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.