search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.98k stars 560 forks source link

Deep recursion on subroutine "CGI::Carp::warn" #8015

Closed p5pRT closed 19 years ago

p5pRT commented 19 years ago

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

Searchable as RT36521$

p5pRT commented 19 years ago

From dmuell@gmx.net

This is a bug report for perl from dmuell@​gmx.net\, generated with the help of perlbug 1.35 running under perl v5.8.6.

running this test application crashes perl 5.8.6 or newer (5.8.5 and older works fine)​:

=== Cut === #!/usr/bin/perl

use CGI​::Carp qw(fatalsToBrowser); use diagnostics;

warn "foo"; === Cut ===

output is a lot of garbage\, and then​:

Deep recursion on subroutine "CGI​::Carp​::warn" at /usr/lib/perl5/5.8.6/diagnostics.pm line 506. Segmentation fault (core dumped)

Flags​:   category=core   severity=high

This perlbug was built using Perl v5.8.6 - Fri Jun 24 16​:05​:45 UTC 2005 It is being executed now by Perl v5.8.6 - Fri Jun 24 16​:00​:32 UTC 2005.

Site configuration information for perl v5.8.6​:

Configured by abuild at Fri Jun 24 16​:00​:32 UTC 2005.

Summary of my perl5 (revision 5 version 8 subversion 6) configuration​:   Platform​:   osname=linux\, osvers=2.6.12\, archname=i586-linux-thread-multi   uname='linux salieri 2.6.12 #1 smp tue jun 21 14​:03​:10 utc 2005 i686 athlon i386 gnulinux '   config_args='-ds -e -Dprefix=/usr -Dvendorprefix=/usr -Dinstallusrbinperl -Dusethreads -Di_db -Di_dbm -Di_ndbm -Di_gdbm -Duseshrplib=true -Doptimize=-O2 -march=i586 -mtune=i686 -fmessage-length=0 -Wall -D_FORTIFY_SOURCE=2 -g -Wall -pipe'   hint=recommended\, useposix=true\, d_sigaction=define   usethreads=define use5005threads=undef useithreads=define usemultiplicity=define   useperlio=define d_sfio=undef uselargefiles=define usesocks=undef   use64bitint=undef use64bitall=undef uselongdouble=undef   usemymalloc=n\, bincompat5005=undef   Compiler​:   cc='cc'\, ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'\,   optimize='-O2 -march=i586 -mtune=i686 -fmessage-length=0 -Wall -D_FORTIFY_SOURCE=2 -g -Wall -pipe'\,   cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -pipe'   ccversion=''\, gccversion='4.0.1 20050621 (prerelease) (SUSE Linux)'\, gccosandvers=''   intsize=4\, longsize=4\, ptrsize=4\, doublesize=8\, byteorder=1234   d_longlong=define\, longlongsize=8\, d_longdbl=define\, longdblsize=12   ivtype='long'\, ivsize=4\, nvtype='double'\, nvsize=8\, Off_t='off_t'\, lseeksize=8   alignbytes=4\, prototype=define   Linker and Libraries​:   ld='cc'\, ldflags =''   libpth=/lib /usr/lib /usr/local/lib   libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc   perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc   libc=\, so=so\, useshrplib=true\, libperl=libperl.so   gnulibc_version='2.3.5'   Dynamic Linking​:   dlsrc=dl_dlopen.xs\, dlext=so\, d_dlsymun=undef\, ccdlflags='-Wl\,-E -Wl\,-rpath\,/usr/lib/perl5/5.8.6/i586-linux-thread-multi/CORE'   cccdlflags='-fPIC'\, lddlflags='-shared'

Locally applied patches​:  

@​INC for perl v5.8.6​:   /usr/lib/perl5/5.8.6/i586-linux-thread-multi   /usr/lib/perl5/5.8.6   /usr/lib/perl5/site_perl/5.8.6/i586-linux-thread-multi   /usr/lib/perl5/site_perl/5.8.6   /usr/lib/perl5/site_perl   /usr/lib/perl5/vendor_perl/5.8.6/i586-linux-thread-multi   /usr/lib/perl5/vendor_perl/5.8.6   /usr/lib/perl5/vendor_perl   .

Environment for perl v5.8.6​:   HOME=/home/dirk   LANG=en_US.UTF-8   LANGUAGE (unset)   LD_LIBRARY_PATH (unset)   LOGDIR (unset)   PATH=/opt/gcc/bin​:/home/dirk/bin​:/usr/local/bin​:/usr/bin​:/usr/X11R6/bin​:/bin​:/usr/games​:/opt/gnome/bin​:/opt/kde3/bin​:/opt/kde/bin​:/usr/lib/jvm/jre/bin​:/usr/lib/mit/bin​:/usr/lib/mit/sbin​:/opt/kde/bin​:/home/dirk/src/kde/qt/bin   PERL_BADLANG (unset)   SHELL=/bin/bash

p5pRT commented 19 years ago

From dmuell@gmx.net

On Wednesday 13 July 2005 00​:11\, perlbug-followup@​perl.org wrote​:

perlbug-followup@​perl.org

And this patch fixes it​:

--- lib/diagnostics.pm +++ lib/diagnostics.pm @​@​ -503\,7 +503\,7 @​@​   print STDERR $warning;   }   } - goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; + &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; };

sub death_trap {

Dirk

p5pRT commented 19 years ago

From @schwern

On Tue\, Jul 12\, 2005 at 03​:11​:49PM -0700\, dmuell @​ gmx. net wrote​:

=== Cut === #!/usr/bin/perl

use CGI​::Carp qw(fatalsToBrowser); use diagnostics;

warn "foo"; === Cut ===

output is a lot of garbage\, and then​:

Deep recursion on subroutine "CGI​::Carp​::warn" at /usr/lib/perl5/5.8.6/diagnostics.pm line 506. Segmentation fault (core dumped)

Deep recursion on subroutine "CGI​::Carp​::warn" at /usr/local/perl/bleadperl/lib/5.9.3/diagnostics.pm line 506.

Program received signal EXC_BAD_ACCESS\, Could not access memory. 0x000bec6c in Perl_pad_push () (gdb) bt #0 0x000bec6c in Perl_pad_push () #1 0x0007b620 in Perl_pp_goto () #2 0x000d1e5c in Perl_runops_standard () #3 0x0001e964 in Perl_call_sv () #4 0x00005e68 in Perl_vwarn () #5 0x000062b8 in Perl_vwarner () #6 0x00006078 in Perl_warner () #7 0x0007b60c in Perl_pp_goto () #8 0x000d1e5c in Perl_runops_standard () #9 0x0001e964 in Perl_call_sv () #10 0x00005e68 in Perl_vwarn () #11 0x00005fe8 in Perl_warn () #12 0x00067324 in Perl_pp_warn () #13 0x000d1e5c in Perl_runops_standard () #14 0x0001e964 in Perl_call_sv () #15 0x00005e68 in Perl_vwarn () #16 0x00005fe8 in Perl_warn () #17 0x00067324 in Perl_pp_warn () #18 0x000d1e5c in Perl_runops_standard () #19 0x0001e964 in Perl_call_sv () #20 0x00005e68 in Perl_vwarn () #21 0x00005fe8 in Perl_warn () #22 0x00067324 in Perl_pp_warn () #23 0x000d1e5c in Perl_runops_standard () ...and so on until... #503 0x000d1e5c in Perl_runops_standard () #504 0x0001e964 in Perl_call_sv () #505 0x00005e68 in Perl_vwarn () #506 0x00005fe8 in Perl_warn () #507 0x00067324 in Perl_pp_warn () #508 0x000d1e5c in Perl_runops_standard () #509 0x0001e394 in S_run_body () #510 0x0001dff4 in perl_run () #511 0x00002d60 in main () #512 0x00002780 in _start (argc=2\, argv=0x0\, envp=0xec09c) at /SourceCache/Csu/Csu-47/crt.c​:267 #513 0x8fe1a278 in __dyld__dyld_start ()

-- Michael G Schwern schwern@​pobox.com http​://www.pobox.com/~schwern Ahh email\, my old friend. Do you know that revenge is a dish that is best served cold? And it is very cold on the Internet!

p5pRT commented 19 years ago

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

p5pRT commented 19 years ago

From @schwern

On Wed\, Jul 13\, 2005 at 03​:51​:38AM +0200\, Dirk Mueller wrote​:

And this patch fixes it​:

--- lib/diagnostics.pm +++ lib/diagnostics.pm @​@​ -503\,7 +503\,7 @​@​ print STDERR $warning; } } - goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; + &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap; };

sub death_trap {

No\, that goto is important. It ensures the old warning handler is called in the same caller context as when diagnostics.pm is not there.

  #!/usr/bin/perl -w

  BEGIN { $SIG{__WARN__} = sub { print join "\n"\, caller\, @​_ } }   use diagnostics;

  warn "foo";

If you run that with and without "use diagnostics" the output from the __WARN__ handler should be the same\, it should think its called from line 6. With your patch it thinks its called from inside diagnostics.pm.

The problem is the use of goto &foo inside a __WARN__ when &foo also calls warn(). I suspect whatever magic that keeps warn() from calling $SIG{__WARN__} when its already inside one is lost.

  #!/sw/bin/perl -w

  my $warn = sub { warn(join "\n"\, caller\, @​_) };

  $SIG{__WARN__} = sub {   # &$warn; # this is ok   goto &$warn; # this segfaults   };

  warn "foo";

-- Michael G Schwern schwern@​pobox.com http​://www.pobox.com/~schwern Reality is that which\, when you stop believing in it\, doesn't go away.   -- Phillip K. Dick

p5pRT commented 19 years ago

From @iabyn

On Wed\, Jul 13\, 2005 at 01​:40​:03PM -0700\, Michael G Schwern wrote​:

The problem is the use of goto &foo inside a __WARN__ when &foo also calls warn(). I suspect whatever magic that keeps warn() from calling $SIG{__WARN__} when its already inside one is lost.

#!/sw/bin/perl -w

my $warn = sub { warn(join "\n"\, caller\, @​_) };

$SIG{__WARN__} = sub { # &$warn; # this is ok goto &$warn; # this segfaults };

warn "foo";

the disabling of $SIG{__WARN__} was done by cheking the call depth of the associated sub. The goto &foo ensured that this was always at zero.

The change below fixes this by localsised PL_warnhook t6o zero within a call to a warn hook.

-- Britain\, Britain\, Britain! Discovered by Sir Henry Britain in sixteen-oh-ten. Sold to Germany a year later for a pfennig and the promise of a kiss. Destroyed in eighteen thirty-fourty two\, and rebuilt a week later by a man. This we know. Hello. But what of the people of Britain? Who they? What do? And why? -- Little Britain

Change 25160 by davem@​davem-splatty on 2005/07/17 20​:12​:54

  $SIG{__WARN__} = sub { goto &foo } could recurse infinitely

Affected files ...

... //depot/perl/t/op/goto.t#30 edit ... //depot/perl/util.c#484 edit

Differences ...

==== //depot/perl/t/op/goto.t#30 (xtext) ====

@​@​ -10\,7 +10\,7 @​@​

use warnings; use strict; -plan tests => 56; +plan tests => 57;

our $foo; while ($?) { @​@​ -436\,3 +436\,13 @​@​ like($@​\, qr/Can't goto subroutine from an eval-string/\, 'eval string'); eval { goto &null }; like($@​\, qr/Can't goto subroutine from an eval-block/\, 'eval block'); + +# [perl #36521] goto &foo in warn handler could defeat recursion avoider + +{ + my $r = runperl( + stderr => 1\, + prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' + ); + like($r\, qr/bar/\, "goto &foo in warn"); +}

==== //depot/perl/util.c#484 (text) ====

@​@​ -1278\,6 +1278\,8 @​@​   SV *msg;

  ENTER; + SAVESPTR(PL_warnhook); + PL_warnhook = Nullsv;   save_re_context();   msg = newSVpvn(message\, msglen);   SvFLAGS(msg) |= utf8;

p5pRT commented 19 years ago

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

p5pRT commented 19 years ago

From @schwern

[davem@​iabyn.com - Sun Jul 17 13​:42​:34 2005]​:

On Wed\, Jul 13\, 2005 at 01​:40​:03PM -0700\, Michael G Schwern wrote​:

The problem is the use of goto &foo inside a __WARN__ when &foo also calls warn(). I suspect whatever magic that keeps warn() from calling $SIG{__WARN__} when its already inside one is lost.

#!/sw/bin/perl -w

my $warn = sub { warn(join "\n"\, caller\, @​_) };

$SIG{__WARN__} = sub { # &$warn; # this is ok goto &$warn; # this segfaults };

warn "foo";

the disabling of $SIG{__WARN__} was done by cheking the call depth of the associated sub. The goto &foo ensured that this was always at zero.

The change below fixes this by localsised PL_warnhook t6o zero within a call to a warn hook.

p5pRT commented 19 years ago

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

p5pRT commented 19 years ago

From @schwern

On Sun\, Jul 17\, 2005 at 09​:41​:58PM +0100\, Dave Mitchell wrote​:

+# [perl #36521] goto &foo in warn handler could defeat recursion avoider + +{ + my $r = runperl( + stderr => 1\, + prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' + ); + like($r\, qr/bar/\, "goto &foo in warn");

This program does not segfault\, it does nothing.

0 ~$ perl5.8.6 -wle 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' 0 ~$

I think the problem is you have code to deliberately avoid the recursion in the subroutine. "return if $d++". Get rid of that and it segfaults.

0 ~$ perl5.8.6 -wle 'my $d; my $w = sub { warn @​_}; $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' Bus error 0 ~$

-- Michael G Schwern schwern@​pobox.com http​://www.pobox.com/~schwern Don't try the paranormal until you know what's normal.   -- "Lords and Ladies" by Terry Prachett

p5pRT commented 19 years ago

From @iabyn

On Sun\, Jul 17\, 2005 at 02​:27​:35PM -0700\, Michael G Schwern wrote​:

On Sun\, Jul 17\, 2005 at 09​:41​:58PM +0100\, Dave Mitchell wrote​:

+# [perl #36521] goto &foo in warn handler could defeat recursion avoider + +{ + my $r = runperl( + stderr => 1\, + prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' + ); + like($r\, qr/bar/\, "goto &foo in warn");

This program does not segfault\, it does nothing.

0 ~$ perl5.8.6 -wle 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' 0 ~$

That's the idea. In fixed bleed\, it prints a warning​:

$ ./perl -wle 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' bar at -e line 1. $

The test minimally detects bad behaviour while avoiding runaway recursion and segfault.

-- "Emacs isn't a bad OS once you get used to it. It just lacks a decent editor."

p5pRT commented 19 years ago

From @schwern

On Mon\, Jul 18\, 2005 at 12​:07​:23AM +0100\, Dave Mitchell wrote​:

+{ + my $r = runperl( + stderr => 1\, + prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' + ); + like($r\, qr/bar/\, "goto &foo in warn");

This program does not segfault\, it does nothing.

0 ~$ perl5.8.6 -wle 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' 0 ~$

That's the idea. In fixed bleed\, it prints a warning​:

$ ./perl -wle 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' bar at -e line 1. $

The test minimally detects bad behaviour while avoiding runaway recursion and segfault.

But with runperl() its ok to segfault\, its run in a different process. You can even reduce it using fresh_perl_like().

fresh_perl_like(\<\<'CODE'\, qr/bar/);   my $w = sub { warn q(bar) }; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo); CODE

-- Michael G Schwern schwern@​pobox.com http​://www.pobox.com/~schwern Insulting our readers is part of our business model.   http​://somethingpositive.net/sp07122005.shtml

p5pRT commented 19 years ago

From @iabyn

On Sun\, Jul 17\, 2005 at 04​:25​:19PM -0700\, Michael G Schwern wrote​:

On Mon\, Jul 18\, 2005 at 12​:07​:23AM +0100\, Dave Mitchell wrote​: But with runperl() its ok to segfault\, its run in a different process.

I know. Orignally I was trying to write the test to run in the same process (thus the need to avoid segfault)\, but couldn't get round the fact that when working correctly\, it needed to write to STDERR\, which is why I then bunged it in a freshperl.

You can even reduce it using fresh_perl_like().

Ooh\, I'll try to remember that in future.

-- SCO - a train crash in slow motion

p5pRT commented 19 years ago

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