[perl #66930] segmentation fault modifying array ref during push

# New Ticket Created by  [email protected: d...@gina.alaska.edu] 
# Please include the string:  [perl #66930]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=66930 >



This is a bug report for perl from [email protected: d...@gina.alaska.edu],
generated with the help of perlbug 1.36 running under perl 5.10.0.


-----------------------------------------------------------------
[Please enter your report here]

The following program causes a segmentation fault:

#!/usr/bin/perl

use strict;
use warnings;

my $x;
#my $x = [];  # also crashes

push @$x, abc();

sub abc {
$x = 1;
 #$x = [];   # also crashes
return 2;
 #return $x = 1;   # also crashes
# absense of return statement prevents crash
}

#####

$ gdb --args perl crash.pl
Program received signal SIGSEGV, Segmentation fault.
0x00007ffff7d091a8 in Perl_av_store (my_perl=0x602010, av=0x606e88, key=6319745, val=0x6070b0) at av.c:336
336   ary[++AvFILLp(av)] = &PL_sv_undef;
(gdb) bt
#0 0x00007ffff7d091a8 in Perl_av_store (my_perl=0x602010, av=0x606e88, key=6319745, val=0x6070b0) at av.c:336
#1  0x00007ffff7d3f23a in Perl_pp_push (my_perl=0x602010) at pp.c:4454
#2  0x00007ffff7cead38 in Perl_runops_debug (my_perl=0x602010) at dump.c:1931
#3 0x00007ffff7d114f8 in S_run_body (oldscope=<value optimized out>, my_perl=<value optimized out>) at perl.c:2391
#4 perl_run (oldscope=<value optimized out>, my_perl=<value optimized out>) at perl.c:2309
#5 0x0000000000400cfc in main (argc=2, argv=0x7fffffffe018, env=0x7fffffffe030) at perlmain.c:113

I am using Fedora 11.


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=medium
---
This perlbug was built using Perl 5.10.0 in the Fedora build system.
It is being executed now by Perl 5.10.0 - Fri Apr 10 06:34:03 EDT 2009.

Site configuration information for perl 5.10.0:

Configured by Red Hat, Inc. at Fri Apr 10 06:34:03 EDT 2009.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.18-128.1.6.el5, archname=x86_64-linux-thread-multi
uname='linux x86-3.fedora.phx.redhat.com 2.6.18-128.1.6.el5 #1 smp tue mar 24 12:05:57 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 -DPERL_USE_SAFE_PUTENV -Dversion=5.10.0 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dprefix=/usr -Dvendorprefix=/usr -Dsiteprefix=/usr/local -Dprivlib=/usr/lib/perl5/5.10.0 -Dsitelib=/usr/local/lib/perl5/site_perl/5.10.0 -Dvendorlib=/usr/lib/perl5/vendor_perl/5.10.0 -Darchlib=/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi -Dsitearch=/usr/local/lib64/perl5/site_perl/5.10.0/x86_64-linux-thread-multi -Dvendorarch=/usr/lib64/perl5/vendor_perl/5.10.0/x86_64-linux-thread-multi -Dinc_version_list=none -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 -Dpag!
er=/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/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 -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m64 -mtune=generic -DPERL_USE_SAFE_PUTENV',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -I/usr/local/include -I/usr/include/gdbm'
ccversion='', gccversion='4.4.0 20090409 (Red Hat 4.4.0-0.32)', 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 =''
    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.9.90'
  Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib64/perl5/5.10.0/x86_64-linux-thread-multi/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 -DPERL_USE_SAFE_PUTENV'

Locally applied patches:
    

---
@INC for perl 5.10.0:
    /usr/local/ION/lib/perl
    /usr/local/ION/lib/perl
    /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/lib64/perl5/5.10.0/x86_64-linux-thread-multi
    /usr/lib/perl5/5.10.0
    /usr/lib/perl5/site_perl
    .

---
Environment for perl 5.10.0:
    HOME=/home/dstahlke
    LANG=C
    LANGUAGE (unset)
LD_LIBRARY_PATH=/usr/local/lib:/usr/local/jprofiler3/bin/linux-x86:/home/dstahlke/thesis/lib
    LOGDIR (unset)
PATH=/usr/java/jdk1.6.0_04/bin:/usr/local/bin:/usr/java/jdk1.6.0_04/bin:/usr/local/bin:/usr/lib64/qt-3.3/bin:/usr/kerberos/bin:/usr/lib64/ccache:/usr/local/bin:/bin:/usr/bin:/usr/local/sbin:/usr/sbin:/sbin:/home/dstahlke/bin:/usr/local/Acrobat5/bin:/usr/local/ION/bin:/usr/java/jdk1.5.0_14/bin:/usr/local/jprofiler3/bin:/home/dstahlke/bin:/home/dstahlke/bin:/usr/local/Acrobat5/bin:/usr/local/ION/bin:/usr/java/jdk1.5.0_14/bin:/usr/local/jprofiler3/bin
    PERL5LIB=:/usr/local/ION/lib/perl:/usr/local/ION/lib/perl
    PERL_BADLANG (unset)
    SHELL=/bin/bash

Hi all,

[email protected: d...@gina.alaska.edu] (via RT) wrote:
> # New Ticket Created by [email protected: d...@gina.alaska.edu]
> # Please include the string:  [perl #66930]
> # in the subject line of all future correspondence about this issue.
> # <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=66930 >
[...]

> The following program causes a segmentation fault:
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> my $x;
> #my $x = [];  # also crashes
>
> push @$x, abc();
>
> sub abc {
>  $x = 1;
>  #$x = [];   # also crashes
>  return 2;
>  #return $x = 1;   # also crashes
>  # absense of return statement prevents crash
> }

Confirmed with blead at 3244086bce52e956e04c61b12eb7b67fc1041d8b.

Cheers,
Steffen

This happens because the array referenced by $x is pushed on the stack,
and then is freed when abc() resets $x. Hence push tries to access a
freed SV. It can be fixed by deciding at compile time to pass the
reference itself and letting push() dereference it, after the
interpreter is done with the argument list.

Note that replacing push by a prototyped sub doesn't segfault :

   sub def (\@$) { print @{$_[0]} }
   my $x;
   def @$x, do { $x = [ 1 ]; 42 };

This will print "1", because the first argument is actually a new
reference to @$x, so it survives even if $x is changed. On a side note,
I'm unsure whether this is a very nice behaviour : I'd expect the first
pushed reference to be the one I have access to. Think :

   our $global;
   def @$global, opaque_sub_that_modifies_global_but_you_dont_know_it();

In any case, it's not consistent with push() where you pass the array
its original state (even if currently it crashes).


Vincent.

I shrunk the demonstration a little for addition to t/op/list.t.
Maybe push could be made to really have a \@@ prototype instead of
whatever it does now?  Where that subroutine result winds up getting
pushed to is not the question here, but I think left to right
processing implies it gets pushed to whatever array $x referred to
before calling the subroutine, so making that new reference is needed
because the reference in the argument can't be trusted to still be an
array reference when we get to the pushing part.  When push comes to
shove as it were.  Take it away, Vincent Pit!

diff --git a/t/op/list.t b/t/op/list.t
index a8fdc18..b678224 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -6,7 +6,7 @@ BEGIN {
}

require "test.pl";
-plan( tests => 57 );
+plan( tests => 59 );

@foo = (1, 2, 3, 4);
cmp_ok($foo[0], '==', 1, 'first elem');
@@ -161,3 +161,21 @@ cmp_ok(join('',(1,2),3,(4,5)),'eq','12345','list
(..).(..)');
     test_zero_args("do-returned list slice", do { (10,11)[2,3]; });
}

+{
+    # perl #66930
+ fresh_perl_is (<<'WORKS',"cheese",{},"66930 push segfault null case");
+push @$x, (sub {
+    $x = 'cheese';
+})->();
+print "$x\n";
+WORKS
+    fresh_perl_is (<<'66930',"cheese",{},"66930 push segfault");
+push @$x, (sub {
+    $x = 'cheese';
+    2;
+})->();
+print "$x\n";
+66930
+
+}
+

>> Where that subroutine result winds up getting
>> pushed to is not the question here, but I think left to right
>> processing implies it gets pushed to whatever array $x referred to
>> before calling the subroutine

On the other hand, that subroutine arguments are all aliases and that
all arguments are evaluated before the subroutine is invoked would put
the subroutine result in the later array.  Where does the
non-seg-faulting version put it?  In the earlier array.

With the \@@ prototype it goes in the earlier array too.  With the
implied (@) prototype, the mypush2 routine below puts "shove" in the
after array.

cat 66930_where_does_it_go.pl
@before=@after=();
$x="before";
push @$x, (sub {
       $x = 'after';
})->();
print "PURE PUSH:\nx: $x\nbefore:@before\nafter: @after\n";

sub mypush(\@@) { my $ref = shift; push @$ref, @_ }
@before=@after=();
$x="before";
mypush @$x, (sub {
       $x = 'after';
})->();
print "MY PUSH:\nx: $x\nbefore:@before\nafter: @after\n";

@before=@after=();
$x="before";
mypush @$x, (sub {
       $x = 'after';
       "shove"
})->();
print "WOULD SEGFAULT:\nx: $x\nbefore:@before\nafter: @after\n";

@before=@after=();
$x="before";
$sub_result = (sub { $x = 'after'; "shove" })->();
push @$x, $sub_result;
print "PERL-SIDE ORDERING:\nx: $x\nbefore:@before\nafter: @after\n";

@before=@after=();
$x="before";
$arrayref = $x;
$sub_result = (sub { $x = 'after'; "shove" })->();
push @$arrayref, $sub_result;
print "PERL-SIDE ORDERING 2:\nx: $x\nbefore:@before\nafter: @after\n";

sub mypush2 { my $ref = shift; push @$ref, @_ }
@before=@after=();
$x="before";
mypush2 $x, (sub {
       $x = 'after';
       "shove"
})->();
print "MY PUSH NO PROTOTYPE:\nx: $x\nbefore:@before\nafter: @after\n";
__END__

Stunningly, unshift doesn't have the segfault problem. Like push that
works, or a \@... prototype, the array that gets modified is as seen
before rather than after the modification in the subroutine.

I wonder if a note about this edge case of parameter ordering being
another effect of prototyping belongs in perlsub.pod.

pp_push and pp_unshift in pp.c are very similar.

Hmm.  5.10.0 (standard cygwin) segfaults on push but not unshift.

5.8.8 (debian package) segfaults on both.

Current blead on linux allows push, complains and aborts on unshift,
and I have no idea why.  The problem is in the returning, not in the
operations. The time of destruction has been deferred for push and the
same deferment needs to be applied to unshift too?

diff --git a/pp.c b/pp.c
index 9cedc3f..9318755 100644
--- a/pp.c
+++ b/pp.c
@@ -4549,6 +4549,7 @@ PP(pp_push)
        }
     }
     else {
+           Perl_warn(aTHX_ "inside push refcount %i", SvREFCNT((SV*) ary));
        PL_delaymagic = DM_DELAY;
        for (++MARK; MARK <= SP; MARK++) {
            SV * const sv = newSV(0);
@@ -4596,17 +4597,23 @@ PP(pp_unshift)
        SPAGAIN;
     }
     else {
+           Perl_warn(aTHX_ "inside unshift refcount %i", SvREFCNT((SV*) ary));
        register I32 i = 0;
        av_unshift(ary, SP - MARK);
+           Perl_warn(aTHX_ "unshifted %i", SP - MARK);
        while (MARK < SP) {
+           Perl_warn(aTHX_ "unshifting %i", SP - MARK);
            SV * const sv = newSVsv(*++MARK);
+           Perl_warn(aTHX_ "unshifting %i", SP - MARK);
            (void)av_store(ary, i++, sv);
+           Perl_warn(aTHX_ "unshifting %i", SP - MARK);
        }
     }
     SP = ORIGMARK;
     if (GIMME_V != G_VOID) {
        PUSHi( AvFILL(ary) + 1 );
     }
+           Perl_warn(aTHX_ "returning");
     RETURN;
}

diff --git a/utils/Makefile b/utils/Makefile


perlhacker@catnip:~/perl$ ./perl -v

This is perl, v5.11.0 (GitLive-blead-g7f6de3f*) built for i686-linux
...

perlhacker@catnip:~/perl$ ./perl -le '$x=[]; push @$x, (sub {$x="";"pbth"})->()'
inside push refcount 1 at -e line 1.
perlhacker@catnip:~/perl$ ./perl -le '$x=[]; unshift @$x, (sub
{$x="";"pbth"})->()'
inside unshift refcount 1 at -e line 1.
unshifted 1 at -e line 1.
unshifting 1 at -e line 1.
unshifting 0 at -e line 1.
unshifting 0 at -e line 1.
returning at -e line 1.
*** glibc detected *** free(): invalid pointer: 0x0816939c ***
Aborted

Without looking at this thread in detail (I just haven't got time at the
moment), my general observation is that most of these bugs are due to
the fact that the perl stack isn't refcounted, which is a fairly
fundamental problem with no quick fixes. So the usual advice is just
"don't modify an array while you're iterating over it / using it as a
function arg / etc etc; and maybe well fix this one year".

--0016362850c8f90c95046dc22811
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 7bit

On Tue, Jun 30, 2009 at 7:54 AM, Dave Mitchell <davem@iabyn.com> wrote:

> Without looking at this thread in detail (I just haven't got time at the
> moment), my general observation is that most of these bugs are due to
> the fact that the perl stack isn't refcounted, which is a fairly
> fundamental problem with no quick fixes. So the usual advice is just
> "don't modify an array while you're iterating over it / using it as a
> function arg / etc etc; and maybe well fix this one year".


While it is true that this bug is clearly of the "so don't do that" variety,
a segfault in any circumstance seems like spilled milk worth wiping up.

While a refcounted stack might prevent freeing the no-longer-referenced
array too early, whatever method is used to call an explicitly prototyped
userland routine manages to escape without segfaulting. That push and
unshift appear to have switched status as to if they segfault or not is
intruiging.

Don't we want to normalize the builtins to use the prototyped calling
conventions?  I thought at one point we did; that initiative like so many
others may have fizzled or been rejected due to a slight benchmarked
performance hit.

--0016362850c8f90c95046dc22811--

> Don't we want to normalize the builtins to use the prototyped calling
> conventions? =A0I thought at one point we did; that initiative like so ma=
ny
> others may have fizzled or been rejected due to a slight benchmarked
> performance hit.
>


Id suspect that its more like:

These are problems that are understood, if not by everyone,
then by enough who can say with some authority: "dont do that".

Im unconvinced that fixing 70% of the bugs I dont understand
will help me at all when I find myself blocked by the other 30%.

Wisdom (self-preservation?) says stay the hell out of the minefield,
It only takes one to go boom, stumpy.

Then theres that "we" in there.
Only the queen gets to use that word.
(and Im as guilty of that as anyone)

You appear to be conflating "it doesn't segfault" with "there's nothing
wrong". An underlying recount bug may cause some operations to segfault
but not others, and what does and doesn't segfault may vary randomly
between versions.

Anyway, as I said before, I haven't got time to discuss this now.