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

illegal sub declaration crashes #13546

Closed
p5pRT opened this issue Jan 21, 2014 · 17 comments
Closed

illegal sub declaration crashes #13546

p5pRT opened this issue Jan 21, 2014 · 17 comments

Comments

@p5pRT
Copy link

p5pRT commented Jan 21, 2014

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

Searchable as RT121048$

@p5pRT
Copy link
Author

p5pRT commented Jan 21, 2014

From zefram@fysh.org

Created by zefram@fysh.org

$ perl -lwe 'BEGIN <> { }'
Use of uninitialized value at -e line 1.
zsh​: segmentation fault perl -lwe 'BEGIN <> { }'

This takes a funny path through the tokeniser. "BEGIN" and a few other
keywords get treated as if "sub" had been said first. The "sub" handler
has an explicit check for unexpected stuff preceding the body​:

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

But the "sub" handler doesn't apply this check if the "sub" keyword
wasn't really there.

I haven't looked into what actually makes this crash. In theory the
check should be entirely redundant​: if the next token isn't one of the
permitted ones then a simple syntax error should result.

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.19.7:

Configured by zefram at Mon Dec 23 19:18:49 GMT 2013.

Summary of my perl5 (revision 5 version 19 subversion 7) configuration:
   
  Platform:
    osname=linux, osvers=3.2.0-4-amd64, archname=x86_64-linux-thread-multi
    uname='linux barba.rous.org 3.2.0-4-amd64 #1 smp debian 3.2.46-1 x86_64 gnulinux '
    config_args='-des -Dprefix=/home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52 -Duselargefiles -Dusethreads -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dusedevel -Uversiononly -Ui_db'
    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='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.7.2', 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/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib
    libs=-lnsl -ldb -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.15'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/5.19.7/x86_64-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector'



@INC for perl 5.19.7:
    /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/site_perl/5.19.7/x86_64-linux-thread-multi
    /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/site_perl/5.19.7
    /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/5.19.7/x86_64-linux-thread-multi
    /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/5.19.7
    .


Environment for perl 5.19.7:
    HOME=/home/zefram
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/bin:/home/zefram/usr/perl/util:/home/zefram/pub/x86_64-unknown-linux-gnu/bin:/home/zefram/pub/common/bin:/usr/bin:/bin:/usr/local/bin:/usr/games
    PERL_BADLANG (unset)
    SHELL=/usr/bin/zsh

@p5pRT
Copy link
Author

p5pRT commented Jun 6, 2015

From @geeknik

The following "script" causes two behaviors to manifest in two different versions of Perl.

perl -e 'BEGIN<>'

1st, in Perl 5.23.0 (v5.22.0-63-g216b41c), it causes Perl_newATTRSUB_x​: Assertion `proto->op_type == OP_CONST' failed at op.c​:8458.

2nd, in Perl 5.21.6-602-ge9d2bd8, it causes a segfault at Perl_op_free (op.c​:757).

==34585== Invalid read of size 2
==34585== at 0x43D368​: Perl_op_free (op.c​:757)
==34585== by 0x8B93D7​: Perl_leave_scope (scope.c​:986)
==34585== by 0x4AD9F6​: Perl_newATTRSUB_x (op.c​:8870)
==34585== by 0x5CD38A​: Perl_yyparse (perly.y​:294)
==34585== by 0x4F0874​: perl_parse (perl.c​:2271)
==34585== by 0x42A87B​: main (perlmain.c​:114)
==34585== Address 0x300000020 is not stack'd, malloc'd or (recently) free'd
==34585==
==34585==
==34585== Process terminating with default action of signal 11 (SIGSEGV)
==34585== Access not within mapped region at address 0x300000020
==34585== at 0x43D368​: Perl_op_free (op.c​:757)
==34585== by 0x8B93D7​: Perl_leave_scope (scope.c​:986)
==34585== by 0x4AD9F6​: Perl_newATTRSUB_x (op.c​:8870)
==34585== by 0x5CD38A​: Perl_yyparse (perly.y​:294)
==34585== by 0x4F0874​: perl_parse (perl.c​:2271)
==34585== by 0x42A87B​: main (perlmain.c​:114)
==34585== If you believe this happened as a result of a stack
==34585== overflow in your program's main thread (unlikely but
==34585== possible), you can try to increase the size of the
==34585== main thread stack using the --main-stacksize= flag.
==34585== The main thread stack size used in this run was 8388608.

Program received signal SIGSEGV, Segmentation fault.
Perl_op_free (o=0xe46898) at op.c​:757
757 op.c​: No such file or directory.
(gdb) bt
#0 Perl_op_free (o=0xe46898) at op.c​:757
#1 0x00000000008b93d8 in Perl_leave_scope (base=39) at scope.c​:986
#2 0x00000000004ad9f7 in Perl_newATTRSUB_x (floor=39, o=<optimized out>,
  proto=0xe46898, attrs=0x0, block=<optimized out>, o_is_gv=<optimized out>)
  at op.c​:8870
#3 0x00000000005cd38b in Perl_yyparse (gramtype=<optimized out>)
  at perly.y​:294
#4 0x00000000004f0875 in S_parse_body (xsinit=0x42ac70 <xs_init>, env=0x0)
  at perl.c​:2271
#5 perl_parse (my_perl=<optimized out>, xsinit=0x42ac70 <xs_init>,
  argc=<optimized out>, argv=<optimized out>, env=0x0) at perl.c​:1605
#6 0x000000000042a87c in main (argc=2, argv=0x7fffffffe3a8,
  env=0x7fffffffe3c0) at perlmain.c​:114
#7 0x00007ffff6f98ead in __libc_start_main (main=<optimized out>,
  argc=<optimized out>, ubp_av=<optimized out>, init=<optimized out>,
  fini=<optimized out>, rtld_fini=<optimized out>, stack_end=0x7fffffffe398)
  at libc-start.c​:244
#8 0x000000000042ab95 in _start ()

@p5pRT
Copy link
Author

p5pRT commented Aug 11, 2015

From @dcollinsn

Greetings,

While experimenting with the afl-gcc fuzzing utility, I located a very simple test case that causes perl to segfault without printing any errors​:

$ perl ../test1.pl
Segmentation fault (core dumped)

$ perl -w ../test1.pl
Use of uninitialized value at ../test1.pl line 1.
Segmentation fault (core dumped)

The testcase reads as follows​:

$ od -c ../test1.pl
0000000 B E G I N < > \n
0000010

NB​: The newline is not strictly required to reproduce and is a consequence of me starting to debug this on one computer, and finishing on a different computer. I didn't realize the newline was there, but since it appears in the backtrace below, I didn't want to confuse you by removing it.

This is reproducible with perls at least as old as 5.14.4 through blead, and miniperl fails in the same manner. The segfault occurs in Perl_op_free, when attempting to free the sibling of the child of an OP, as evidenced below. Here is the stack trace for the segfault​:

#0 0x000000010040c171 in Perl_op_free (o=0x600077a78) at op.c​:761
#1 0x00000001005229de in Perl_leave_scope (base=39) at scope.c​:986
#2 0x0000000100421331 in Perl_newATTRSUB_x (floor=39, o=0x6000777c8,
  proto=0x600077a78, attrs=0x0, block=0x0, o_is_gv=false) at op.c​:8828
#3 0x000000010046a20f in Perl_yyparse (gramtype=258) at perly.y​:294
#4 0x0000000100404538 in S_parse_body (env=0x0, xsinit=0x10042f9e9 <xs_init>)
  at perl.c​:2296
#5 0x00000001004036d5 in perl_parse (my_perl=0x60003ab40,
  xsinit=0x10042f9e9 <xs_init>, argc=2, argv=0x22aac0, env=0x0)
  at perl.c​:1626
#6 0x000000010042f93b in main (argc=2, argv=0x22aac0, env=0x6000281a0)
  at miniperlmain.c​:120
 
(gdb) l op.c​:761
756 CALL_OPFREEHOOK(o);
757
758 if (o->op_flags & OPf_KIDS) {
759 OP *kid, *nextkid;
760 for (kid = cUNOPo->op_first; kid; kid = nextkid) {
761 nextkid = OpSIBLING(kid); /* Get before next freeing kid */
762 if (!kid || kid->op_type == OP_FREED)
763 /* During the forced freeing of ops after
764 compilation failure, kidops may be freed before
765 their parents. */
 
It appears that Perl_op_free is being called on an op which has a child that believes it has a sibling. The relevant op is created at​:

#0 Perl_newUNOP (type=26, flags=0, first=0x600077ab8) at op.c​:4783
#1 0x0000000100463834 in S_scan_inputsymbol (start=0x6000742c5 "<>\n")
  at toke.c​:9603
#2 0x000000010044f84f in Perl_yylex () at toke.c​:5926
#3 0x00000001004697d2 in Perl_yyparse (gramtype=258) at perly.c​:322
#4 0x0000000100404538 in S_parse_body (env=0x0, xsinit=0x10042f9e9 <xs_init>)
  at perl.c​:2296
#5 0x00000001004036d5 in perl_parse (my_perl=0x60003ab40,
  xsinit=0x10042f9e9 <xs_init>, argc=2, argv=0x22aac0, env=0x0)
  at perl.c​:1626
#6 0x000000010042f93b in main (argc=2, argv=0x22aac0, env=0x6000281a0)
  at miniperlmain.c​:120
 
At the time of the crash, the following is true​:

(gdb) p ((UNOP*)0x600077a78)->op_first
$32 = (OP *) 0x600077ab8
(gdb) p ((OP*)0x600077ab8)->op_sibling
$33 = (OP *) 0x300000000

The child's op_sibling becomes non-NULL at the following line​:

1347 SvFLAGS(sv) |= new_type;
(gdb) p ((OP*)0x600077ab8)->op_sibling
$52 = (OP *) 0x0
(gdb) s
1352 switch (new_type) {
(gdb) p ((OP*)0x600077ab8)->op_sibling
$53 = (OP *) 0x300000000
(gdb) bt
#0 Perl_sv_upgrade (sv=0x600077ab8, new_type=SVt_PV) at sv.c​:1352
#1 0x00000001004eb26d in Perl_sv_2pv_flags (sv=0x600077ab8, lp=0x22a168,
  flags=34) at sv.c​:3223
#2 0x000000010041f426 in Perl_newATTRSUB_x (floor=39, o=0x6000777c8,
  proto=0x600077a78, attrs=0x0, block=0x0, o_is_gv=false) at op.c​:8459
#3 0x000000010046a20f in Perl_yyparse (gramtype=258) at perly.y​:294
#4 0x0000000100404538 in S_parse_body (env=0x0, xsinit=0x10042f9e9 <xs_init>)
  at perl.c​:2296
#5 0x00000001004036d5 in perl_parse (my_perl=0x60003ab40,
  xsinit=0x10042f9e9 <xs_init>, argc=2, argv=0x22aac0, env=0x0)
  at perl.c​:1626
#6 0x000000010042f93b in main (argc=2, argv=0x22aac0, env=0x6000281a0)
  at miniperlmain.c​:120

This memory appears to be being used as both an OP and an SV. This appears to be problematic. See for example​:
(gdb) p sv
$66 = (SV * const) 0x600077ab8
(gdb) p ((UNOP*)0x600077a78)->op_first # Some time in the future, this address will be passed to Perl_op_free
$67 = (OP *) 0x600077ab8
(gdb) p *sv
$68 = {sv_any = 0x600077ab8, sv_refcnt = 0, sv_flags = 3, sv_u = {
  svu_pv = 0x1004d8257 <Perl_pp_gv> "UH\211\345H\203\354\060H\213\005\212%\022", svu_iv = 4300046935, svu_uv = 4300046935, svu_nv = 2.1245054660884477e-314,
  svu_rv = 0x1004d8257 <Perl_pp_gv>, svu_rx = 0x1004d8257 <Perl_pp_gv>,
  svu_array = 0x1004d8257 <Perl_pp_gv>, svu_hash = 0x1004d8257 <Perl_pp_gv>,
  svu_gp = 0x1004d8257 <Perl_pp_gv>, svu_fp = 0x1004d8257 <Perl_pp_gv>}}
(gdb) p *(OP*)0x600077ab8
$69 = {op_next = 0x600077ab8, op_sibling = 0x300000000,
  op_ppaddr = 0x1004d8257 <Perl_pp_gv>, op_targ = 0, op_type = 7, op_opt = 0,
  op_slabbed = 1, op_savefree = 0, op_static = 0, op_folded = 0,
  op_moresib = 0, op_spare = 0, op_flags = 2 '\002', op_private = 0 '\000'}

I'm not sure if this memory was freed somewhere and reused, and we have failed to null out ((UNOP*)0x600077a78)->op_first before using the memory it points to to store an SV, or if some other witchcraft has allowed this to occur, so I'll hand it off to you.

$ perl -V
Summary of my perl5 (revision 5 version 14 subversion 4) configuration​:

  Platform​:
  osname=cygwin, osvers=1.7.18(0.26353), archname=cygwin-thread-multi
  uname='cygwin_nt-6.1 yaakov04 1.7.18(0.26353) 2013-03-07 19​:25 x86_64 cygwin '
  config_args='-d -e -Dprefix=/usr -Dmksymlinks -Dusethreads -Darchname=x86_64-cygwin-threads -Dlibperl=cygperl5_14.dll -Dcc=gcc -Dld=g++'
  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 ='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fno-strict-aliasing -pipe -fstack-protector',
  optimize='-O3',
  cppflags='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fno-strict-aliasing -pipe -fstack-protector'
  ccversion='', gccversion='4.8.0 20130307 (experimental)', 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='g++', ldflags =' -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -fstack-protector'
  libpth=/usr/lib /lib
  libs=-lgdbm -ldb -ldl -lcrypt -lgdbm_compat
  perllibs=-ldl -lcrypt
  libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=cygperl5_14.dll
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags=' --shared -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -fstack-protector'

Characteristics of this binary (from libperl)​:
  Compile-time options​: MULTIPLICITY PERL_DONT_CREATE_GVSV
  PERL_IMPLICIT_CONTEXT PERL_PRESERVE_IVUV
  PERL_USE_SAFE_PUTENV USE_64_BIT_ALL USE_64_BIT_INT
  USE_ITHREADS USE_LARGE_FILES USE_PERLIO USE_PERL_ATOF
  USE_REENTRANT_API
  Locally applied patches​:
  Bug#55162 File​::Spec​::case_tolerant performance
  CYG07 $vendorarch/auto/.rebase
  CYG15 static Win32CORE
  CYG17 cyg-1.7 paths-utf8
  0c612ce82 Fix building static extensions on cygwin, -UUSEIMPORTLIB
  1bac5ec Fix 64-bit threading sv.c​: S_anonymise_cv_maybe
  Cygwin​::sync_winenv added
  Built under cygwin
  Compiled at Mar 11 2013 18​:25​:23
  @​INC​:
  /usr/lib/perl5/site_perl/5.14/x86_64-cygwin-threads
  /usr/lib/perl5/site_perl/5.14
  /usr/lib/perl5/vendor_perl/5.14/x86_64-cygwin-threads
  /usr/lib/perl5/vendor_perl/5.14
  /usr/lib/perl5/5.14/x86_64-cygwin-threads
  /usr/lib/perl5/5.14
  .

$ ./miniperl -Ilib -V
Summary of my perl5 (revision 5 version 22 subversion 0) configuration​:

  Platform​:
  osname=cygwin, osvers=1.7.28(0.27153), archname=cygwin
  uname='cygwin_nt-6.1 wdlkhr204823 1.7.28(0.27153) 2014-02-09 21​:06 x86_64 cygwin '
  config_args=''
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=undef, usemultiplicity=undef
  use64bitint=define, use64bitall=define, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags ='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include',
  optimize='-g',
  cppflags='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.8.2', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='g++', ldflags =' -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib/gcc/x86_64-pc-cygwin/4.8.2/include-fixed /usr/lib /usr/lib/gcc/x86_64-pc-cygwin/4.8.2/../../../../lib/../include/w32api /lib
  libs=-lpthread -ldb -ldl -lcrypt
  perllibs=-lpthread -ldl -lcrypt
  libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=cygperl5_22_0.dll
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags=' --shared -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -L/usr/local/lib -fstack-protector'

Characteristics of this binary (from libperl)​:
  Compile-time options​: HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV
  PERL_EXTERNAL_GLOB PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
  PERL_IS_MINIPERL PERL_NEW_COPY_ON_WRITE
  PERL_PRESERVE_IVUV PERL_USE_SAFE_PUTENV
  USE_64_BIT_ALL USE_64_BIT_INT USE_LARGE_FILES
  USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE
  USE_LOCALE_NUMERIC USE_LOCALE_TIME USE_PERLIO
  USE_PERL_ATOF USE_SITECUSTOMIZE
  Built under cygwin
  Compiled at Aug 11 2015 10​:01​:48
  @​INC​:
  /home/daniel.r.collins1/perl-5.22.0/cpan/AutoLoader/lib
  /home/daniel.r.collins1/perl-5.22.0/dist/Carp/lib
  /home/daniel.r.collins1/perl-5.22.0/dist/PathTools
  /home/daniel.r.collins1/perl-5.22.0/dist/PathTools/lib
  /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-Command/lib
  /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-Install/lib
  /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-MakeMaker/lib
  /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-Manifest/lib
  /home/daniel.r.collins1/perl-5.22.0/cpan/File-Path/lib
  /home/daniel.r.collins1/perl-5.22.0/ext/re
  /home/daniel.r.collins1/perl-5.22.0/dist/Term-ReadLine/lib
  /home/daniel.r.collins1/perl-5.22.0/dist/Exporter/lib
  /home/daniel.r.collins1/perl-5.22.0/ext/File-Find/lib
  /home/daniel.r.collins1/perl-5.22.0/cpan/Text-Tabs/lib
  /home/daniel.r.collins1/perl-5.22.0/dist/constant/lib
  /home/daniel.r.collins1/perl-5.22.0/lib
  .

@p5pRT
Copy link
Author

p5pRT commented Aug 11, 2015

From zefram@fysh.org

Dan Collins wrote​:

$ od -c ../test1.pl
0000000 B E G I N < > \n

This is a duplicate of [perl #121048]. (Except that the test code in
that ticket has braces as well.)

-zefram

@p5pRT
Copy link
Author

p5pRT commented Aug 11, 2015

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

@p5pRT
Copy link
Author

p5pRT commented Aug 12, 2015

From @rurban

On Sat Jun 06 09​:02​:11 2015, brian.carpenter@​gmail.com wrote​:

perl -e 'BEGIN<>'

Fixed with the attached patch
failing with a proper error message
--
Reini Urban

@p5pRT
Copy link
Author

p5pRT commented Aug 12, 2015

From @rurban

0001-add-panic-wrong-function-prototype-for-funcname.patch
From c1aaf18b8a9c21d60b022e33efd9c3c354eb6dd4 Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpanel.net>
Date: Wed, 12 Aug 2015 10:51:15 +0200
Subject: [PATCH] add panic: wrong function prototype for funcname

Fixes RT #125341, -e'BEGIN<>' where the
readline term was used as proto for a function. All THINGS
(literals) are allowed, but only CONST is accepted.
Rather panic with a proper message than just assert.
---
 op.c             | 4 +++-
 pod/perldiag.pod | 5 +++++
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git op.c op.c
index e652ed2..ffc625d 100644
--- op.c
+++ op.c
@@ -8451,7 +8451,9 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 			isGV(gv) ? gv : (GV *)cSVOPo->op_sv);
 
     if (proto) {
-	assert(proto->op_type == OP_CONST);
+        if (OP_TYPE_ISNT(proto, OP_CONST))
+            Perl_croak(aTHX_ "panic: wrong function prototype %s for %s",
+                       OP_NAME(proto), name);
 	ps = SvPV_const(((SVOP*)proto)->op_sv, ps_len);
         ps_utf8 = SvUTF8(((SVOP*)proto)->op_sv);
     }
diff --git pod/perldiag.pod pod/perldiag.pod
index 7004aeb..32ea7f0 100644
--- pod/perldiag.pod
+++ pod/perldiag.pod
@@ -4440,6 +4440,11 @@ to even) byte length.
 (P) Something tried to call utf16_to_utf8_reversed with an odd (as opposed
 to even) byte length.
 
+=item panic: wrong function prototype %s for %s
+
+(P) A function declaration expects a CONST prototype, but a wrong prototype
+was declared.
+
 =item panic: yylex, %s
 
 (P) The lexer got into a bad state while processing a case modifier.
-- 
2.4.5

@p5pRT
Copy link
Author

p5pRT commented Aug 12, 2015

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

@p5pRT
Copy link
Author

p5pRT commented Aug 12, 2015

From @rurban

Please see my patch at RT #125341
--
Reini Urban

@p5pRT
Copy link
Author

p5pRT commented Aug 12, 2015

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

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2015

From @tonycoz

On Sat Jun 06 09​:02​:11 2015, brian.carpenter@​gmail.com wrote​:

The following "script" causes two behaviors to manifest in two
different versions of Perl.

perl -e 'BEGIN<>'

The attached seems to fix it.

I have an alternate change that turns the prototype into a new token type (rather than THING) and that worked, but then I noticed this block and making the fix there allows BEGIN <> to behave more closely to sub foo <>.

Reini's patch turns the assert() (or crash) into a panic, which isn't really an improvement.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 24, 2015

From @tonycoz

0001-perl-125341-check-for-unexpected-trash-after-any-sub.patch
From dce3a02fc588b60ec375dda1004e15975b7f1e5f Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 24 Aug 2015 11:46:35 +1000
Subject: [perl #125341] check for unexpected trash after any sub start

---
 t/lib/croak/toke | 5 +++++
 toke.c           | 8 +++++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 78ff6cd..64012fb 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -279,3 +279,8 @@ state ($x, $y, state $z);
 EXPECT
 Can't redeclare "state" in "state" at - line 2, near ", "
 Execution of - aborted due to compilation errors.
+########
+# NAME BEGIN <> [perl #125341]
+BEGIN <>
+EXPECT
+Illegal declaration of subroutine BEGIN at - line 1.
diff --git a/toke.c b/toke.c
index 7a0f1b6..4814352 100644
--- a/toke.c
+++ b/toke.c
@@ -8100,7 +8100,13 @@ Perl_yylex(pTHX)
 
 		if (*s == ':' && s[1] != ':')
 		    PL_expect = attrful;
-		else if ((*s != '{' && *s != '(') && key == KEY_sub) {
+		else if ((*s != '{' && *s != '(') && key != KEY_format) {
+                    assert(key == KEY_sub || key == KEY_AUTOLOAD ||
+                           key == KEY_DESTROY || key == KEY_BEGIN ||
+                           key == KEY_UNITCHECK || key == KEY_CHECK ||
+                           key == KEY_INIT || key == KEY_END ||
+                           key == KEY_my || key == KEY_state ||
+                           key == KEY_our);
 		    if (!have_name)
 			Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
 		    else if (*s != ';' && *s != '}')
-- 
2.1.4

@p5pRT
Copy link
Author

p5pRT commented Aug 27, 2015

From @tonycoz

On Sun Aug 23 18​:50​:10 2015, tonyc wrote​:

On Sat Jun 06 09​:02​:11 2015, brian.carpenter@​gmail.com wrote​:

The following "script" causes two behaviors to manifest in two
different versions of Perl.

perl -e 'BEGIN<>'

The attached seems to fix it.

Pushed to blead as e6b2cf8.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 27, 2015

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented Dec 7, 2015

From @tonycoz

On Wed Aug 26 21​:08​:46 2015, tonyc wrote​:

On Sun Aug 23 18​:50​:10 2015, tonyc wrote​:

On Sat Jun 06 09​:02​:11 2015, brian.carpenter@​gmail.com wrote​:

The following "script" causes two behaviors to manifest in two
different versions of Perl.

perl -e 'BEGIN<>'

The attached seems to fix it.

Pushed to blead as e6b2cf8.

Tickets 121048, 125341 and 125789 are all the same issue, which was fixed by
the commit above.

Tony

@p5pRT
Copy link
Author

p5pRT commented Dec 7, 2015

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT p5pRT closed this as completed Jan 10, 2016
@p5pRT
Copy link
Author

p5pRT commented Jan 10, 2016

@mauke - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant