perl segfautls on input

[p5pRT]

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

Searchable as RT2738$

[p5pRT]

From bah@orientation.com

Created by bah@orientation.com

$ perl -e 'sub _ <> { }'
Segmentation fault

$ gdb perl
GNU gdb 19990928
Copyright 1998 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you are
welcome to change it and/or distribute copies of it under certain conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB. Type "show warranty" for details.
This GDB was configured as "i686-pc-linux-gnu"...
(no debugging symbols found)...
(gdb) r -e 'sub _ <> { }'
Starting program​: /usr/local/bin/perl -e 'sub _ <> { }'
(no debugging symbols found)...(no debugging symbols found)...
(no debugging symbols found)...(no debugging symbols found)...
(no debugging symbols found)...(no debugging symbols found)...
(no debugging symbols found)...(no debugging symbols found)...
Program received signal SIGSEGV, Segmentation fault.
0x808c883 in Perl_sv_2pv ()
(gdb) where
#0 0x808c883 in Perl_sv_2pv ()
#1 0x8075c2d in Perl_newSUB ()
#2 0x806f200 in Perl_yyparse ()
#3 0x8058ff9 in perl_parse ()
#4 0x8057786 in main ()
#5 0x400a8a42 in __libc_start_main () from /lib/libc.so.6

Perl Info

Site configuration information for perl 5.00503:

Configured by randolph at Sat Jan 22 10:22:49 MST 2000.

Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration:
  Platform:
    osname=linux, osvers=2.3.39, archname=i386-linux
    uname='linux samwise.tausq.org 2.3.39 #1 smp wed jan 12 05:59:50 mst 2000 i686 unknown '
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
  Compiler:
    cc='cc', optimize='-O2 ', gccversion=2.95.2 19991109 (Debian GNU/Linux)
    cppflags='-Dbool=char -DHAS_BOOL -D_REENTRANT -DDEBIAN -I/usr/local/include'
    ccflags ='-Dbool=char -DHAS_BOOL -D_REENTRANT -DDEBIAN -I/usr/local/include'
    stdchar='char', d_stdstdio=undef, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl 5.00503:
    /usr/lib/perl5/5.005/i386-linux
    /usr/lib/perl5/5.005
    /usr/local/lib/site_perl/i386-linux
    /usr/local/lib/site_perl
    /usr/lib/perl5
    .


Environment for perl 5.00503:
    HOME=/home/bah
    LANG=C
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/usr/local/lib
    LOGDIR (unset)
    PATH=/usr/X11R6/bin:/usr/local/RealPlayer7:/usr/bin:/bin:/usr/local/bin:/usr/bin/X11:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/bash

----- End forwarded message -----

-- 
|        Ben Holzman                       bah@orientation.com       |
|      orientation.com                     Tel: +1 212 966 5553 x307 |
|  Senior Software Engineer                Fax: +1 212 966 5554      | 
$ perl -l040e 'print ucfirst for reverse qw/hacker perl another just/'

[p5pRT]

From [Unknown Contact. See original ticket]

Benjamin Holzman writes​:

Subject​: failure notice

Hi. This is the qmail-send program at tmtowtdi.perl.org.
I'm afraid I wasn't able to deliver your message to the following addresses.
This is a permanent error; I've given up. Sorry it didn't work out.

<richard-perlbug@​tmtowtdi.perl.org>​:
Sorry, no mailbox here by that name. (#5.1.1)

This is why Richard didn't want to make any changes to the bug
software until after 5.6 was out.

Nat

[p5pRT]

From @vanstyn

In <20000327162355.Q13085@​orientation.com>, Benjamin Holzman writes​:
:----- Forwarded message from MAILER-DAEMON@​tmtowtdi.perl.org -----
:Subject​: failure notice

This problem is known, and should hopefully be fixed soon.

:$ perl -e 'sub _ <> { }'
:Segmentation fault

I'm not sure what caused this, but I can reproduce it here under
5.005_03; the same code compiles without a problem here under
5.6.0, though I'm not at all sure that it should. So this particular
problem has been either fixed or swept under the carpet. :)

Hugo

[p5pRT]

From @rspier

Replicated in 5.8.0 and 5.8.1 to be

[p5pRT]

From The RT System itself

present in bleadperl 3/august/2000

[p5pRT]

From @rspier

perl -e 'sub _ <> { }'
  5.8.3 - OK

  blead - SEGV

#0 0x08081563 in Perl_op_free ()
#1 0x080ccd6f in Perl_leave_scope ()
#2 0x080888c5 in Perl_newATTRSUB ()
#3 0x0807fc97 in Perl_yyparse ()
#4 0x08060fb3 in S_parse_body ()
#5 0x08060b8b in perl_parse ()
#6 0x0805e38f in main ()
#7 0x42015704 in __libc_start_main () from /lib/tls/libc.so.6

(also interesting.. blead throws a warning with -w, 5.8.3 doesn't.)

[p5pRT]

From @rgs

Robert via RT wrote​:

perl -e 'sub _ <> { }'
5.8.3 - OK

blead - SEGV

Not for me ; are you using threads ?

#0 0x08081563 in Perl_op_free ()
#1 0x080ccd6f in Perl_leave_scope ()
#2 0x080888c5 in Perl_newATTRSUB ()
#3 0x0807fc97 in Perl_yyparse ()
#4 0x08060fb3 in S_parse_body ()
#5 0x08060b8b in perl_parse ()
#6 0x0805e38f in main ()
#7 0x42015704 in __libc_start_main () from /lib/tls/libc.so.6

(also interesting.. blead throws a warning with -w, 5.8.3 doesn't.)

not for me either.

[p5pRT]

From @mhx

On 2004-06-23, at 11​:27​:53 +0200, Rafael Garcia-Suarez wrote​:

Robert via RT wrote​:

perl -e 'sub _ <> { }'
5.8.3 - OK

blead - SEGV

Not for me ; are you using threads ?

Try a version with debugging enabled​:

mhx@​r2d2 ~ $ bleadperl -e 'sub _ <> { }'
mhx@​r2d2 ~ $ bleadperl-debug -e 'sub _ <> { }'
Segmentation fault

(Both also built with threads.)

The reason seems to be that <> is being interpreted as a prototype,
but op_sv is obviously crap​:

mhx@​r2d2 ~ $ gdb bleadperl-debug
GNU gdb 6.0
Copyright 2003 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you are
welcome to change it and/or distribute copies of it under certain conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB. Type "show warranty" for details.
This GDB was configured as "i686-pc-linux-gnu"...Using host libthread_db library "/lib/libthread_db.so.1".

(gdb) r -e 'sub _ <> { }'
Starting program​: /home/mhx/apps/bin/bleadperl-debug -e 'sub _ <> { }'
warning​: Unable to find dynamic linker breakpoint function.
GDB will be unable to debug shared library initializers
and track explicitly loaded dynamic code.

Program received signal SIGSEGV, Segmentation fault.
0x08158e13 in Perl_sv_2pv_flags (my_perl=0x827abd8, sv=0x827f400, lp=0xbfffeba4, flags=2) at sv.c​:3658
3658 SvCUR_set(sv, ebuf - ptr);
(gdb) l
3653 ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
3654 else
3655 ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
3656 SvGROW(sv, (STRLEN)(ebuf - ptr + 1)); /* inlined from sv_setpvn */
3657 Move(ptr,SvPVX(sv),ebuf - ptr,char);
3658 SvCUR_set(sv, ebuf - ptr);
3659 s = SvEND(sv);
3660 *s = '\0';
3661 if (isIOK)
3662 SvIOK_on(sv);
(gdb) bt
#0 0x08158e13 in Perl_sv_2pv_flags (my_perl=0x827abd8, sv=0x827f400, lp=0xbfffeba4, flags=2) at sv.c​:3658
#1 0x080c963b in Perl_newATTRSUB (my_perl=0x827abd8, floor=112, o=0x8296930, proto=0x827f420, attrs=0x0, block=0x827f440) at op.c​:4072
#2 0x080b44c4 in Perl_yyparse (my_perl=0x827abd8) at perly.y​:313
#3 0x08068ba5 in S_parse_body (my_perl=0x827abd8, env=0x0, xsinit=0x805fdf8 <xs_init>) at perl.c​:1640
#4 0x08067003 in perl_parse (my_perl=0x827abd8, xsinit=0x805fdf8 <xs_init>, argc=3, argv=0xbffff184, env=0x0) at perl.c​:1143
#5 0x0805fd6d in main (argc=3, argv=0xbffff184, env=0xbffff194) at perlmain.c​:84
(gdb) frame 1
#1 0x080c963b in Perl_newATTRSUB (my_perl=0x827abd8, floor=112, o=0x8296930, proto=0x827f420, attrs=0x0, block=0x827f440) at op.c​:4072
4072 char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
(gdb) l
4067 {
4068 STRLEN n_a;
4069 char *name;
4070 char *aname;
4071 GV *gv;
4072 char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
4073 register CV *cv=0;
4074 SV *const_sv;
4075
4076 name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
(gdb) p *((SVOP*)proto)
$1 = {op_next = 0x0, op_sibling = 0x0, op_ppaddr = 0x8136b26 <Perl_pp_readline>, op_targ = 2, op_type = 26, op_opt = 0, op_static = 0, op_spare = 0, op_flags = 4 '\004', op_private = 1 '\001', op_sv = 0x827f400}
(gdb) frame 0
#0 0x08158e13 in Perl_sv_2pv_flags (my_perl=0x827abd8, sv=0x827f400, lp=0xbfffeba4, flags=2) at sv.c​:3658
3658 SvCUR_set(sv, ebuf - ptr);
(gdb) p *sv
$2 = {sv_any = 0x39323635, sv_refcnt = 825241656, sv_flags = 842608952}
(gdb) p /x *sv
$3 = {sv_any = 0x39323635, sv_refcnt = 0x31303038, sv_flags = 0x32393138}

#0 0x08081563 in Perl_op_free ()
#1 0x080ccd6f in Perl_leave_scope ()
#2 0x080888c5 in Perl_newATTRSUB ()
#3 0x0807fc97 in Perl_yyparse ()
#4 0x08060fb3 in S_parse_body ()
#5 0x08060b8b in perl_parse ()
#6 0x0805e38f in main ()
#7 0x42015704 in __libc_start_main () from /lib/tls/libc.so.6

(also interesting.. blead throws a warning with -w, 5.8.3 doesn't.)

not for me either.

I don't get a warning either...

--
Base 8 is just like base 10, if you are missing two fingers.
  -- Tom Lehrer

[p5pRT]

From @mhx

On 2004-06-23, at 05​:28​:47 -0000, Robert via RT wrote​:

perl -e 'sub _ <> { }'
5.8.3 - OK

blead - SEGV

#0 0x08081563 in Perl_op_free ()
#1 0x080ccd6f in Perl_leave_scope ()
#2 0x080888c5 in Perl_newATTRSUB ()
#3 0x0807fc97 in Perl_yyparse ()
#4 0x08060fb3 in S_parse_body ()
#5 0x08060b8b in perl_parse ()
#6 0x0805e38f in main ()
#7 0x42015704 in __libc_start_main () from /lib/tls/libc.so.6

(also interesting.. blead throws a warning with -w, 5.8.3 doesn't.)

This has now been fixed by the change below.
The code will now trigger a compile-time error​:

  $ perl -e 'sub _ <> {}'
  Illegal declaration of subroutine main​::_ at -e line 1.

Marcus

Change 22990 by mhx@​mhx-r2d2 on 2004/06/24 16​:22​:05

  Fix for​: [perl #2738] perl segfautls on input
  The parser was incorrectly accepting <> as a subroutine prototype and
  newATTRSUB didn't validate the proto argument before accessing op_sv.

Affected files ...

... //depot/perl/op.c#628 edit
... //depot/perl/pod/perldiag.pod#383 edit
... //depot/perl/t/comp/parser.t#17 edit
... //depot/perl/toke.c#500 edit

Differences ...

==== //depot/perl/op.c#628 (text) ====

@​@​ -4069,11 +4069,19 @​@​
  char *name;
  char *aname;
  GV *gv;
- char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
+ char *ps;
  register CV *cv=0;
  SV *const_sv;

  name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
+
+ if (proto) {
+ assert(proto->op_type == OP_CONST);
+ ps = SvPVx(((SVOP*)proto)->op_sv, n_a);
+ }
+ else
+ ps = Nullch;
+
  if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) {
  SV *sv = sv_newmortal();
  Perl_sv_setpvf(aTHX_ sv, "%s[%s​:%"IVdf"]",

==== //depot/perl/pod/perldiag.pod#383 (text) ====

@​@​ -1729,6 +1729,10 @​@​
(F) When using the C<sub> keyword to construct an anonymous subroutine,
you must always specify a block of code. See L<perlsub>.

+=item Illegal declaration of subroutine %s
+
+(F) A subroutine was not declared correctly. See L<perlsub>.
+
=item Illegal division by zero

(F) You tried to divide a number by 0. Either something was wrong in

==== //depot/perl/t/comp/parser.t#17 (text) ====

@​@​ -9,7 +9,7 @​@​
}

require "./test.pl";
-plan( tests => 44 );
+plan( tests => 47 );

eval '%@​x=0;';
like( $@​, qr/^Can't modify hash dereference in repeat \(x\)/, '%@​x=0' );
@​@​ -156,3 +156,15 @​@​
  pass();
  $[ = 0; # restore the original value for less side-effects
}
+
+# [perl #2738] perl segfautls on input
+{
+ eval q{ sub _ <> {} };
+ like($@​, qr/Illegal declaration of subroutine main​::_/, "readline operator as prototype");
+
+ eval q{ $s = sub <> {} };
+ like($@​, qr/Illegal declaration of anonymous subroutine/, "readline operator as prototype");
+
+ eval q{ sub _ __FILE__ {} };
+ like($@​, qr/Illegal declaration of subroutine main​::_/, "__FILE__ as prototype");
+}

==== //depot/perl/toke.c#500 (text) ====

@​@​ -5095,8 +5095,12 @​@​

  if (*s == '​:' && s[1] != '​:')
  PL_expect = attrful;
- else if (!have_name && *s != '{' && key == KEY_sub)
- Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
+ else if (*s != '{' && key == KEY_sub) {
+ if (!have_name)
+ Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
+ else if (*s != ';')
+ Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname);
+ }

  if (have_proto) {
  PL_nextval[PL_nexttoke].opval =

[p5pRT]

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