illegal sub declaration crashes #13546
Comments
From zefram@fysh.orgCreated by zefram@fysh.org$ perl -lwe 'BEGIN <> { }' This takes a funny path through the tokeniser. "BEGIN" and a few other $ perl -lwe 'sub BEGIN <> { }' But the "sub" handler doesn't apply this check if the "sub" keyword I haven't looked into what actually makes this crash. In theory the Perl Info |
From @geeknikThe 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 Program received signal SIGSEGV, Segmentation fault. |
From @dcollinsnGreetings, 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 $ perl -w ../test1.pl The testcase reads as follows: $ od -c ../test1.pl 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 #0 Perl_newUNOP (type=26, flags=0, first=0x600077ab8) at op.c:4783 (gdb) p ((UNOP*)0x600077a78)->op_first The child's op_sibling becomes non-NULL at the following line: 1347 SvFLAGS(sv) |= new_type; This memory appears to be being used as both an OP and an SV. This appears to be problematic. See for example: 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 Platform: Characteristics of this binary (from libperl): $ ./miniperl -Ilib -V Platform: Characteristics of this binary (from libperl): |
From zefram@fysh.orgDan Collins wrote:
This is a duplicate of [perl #121048]. (Except that the test code in -zefram |
|
The RT System itself - Status changed from 'new' to 'open' |
From @rurbanOn Sat Jun 06 09:02:11 2015, brian.carpenter@gmail.com wrote:
Fixed with the attached patch |
From @rurban0001-add-panic-wrong-function-prototype-for-funcname.patchFrom 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
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @rurbanPlease see my patch at RT #125341 |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Sat Jun 06 09:02:11 2015, brian.carpenter@gmail.com wrote:
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 |
From @tonycoz0001-perl-125341-check-for-unexpected-trash-after-any-sub.patchFrom 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
|
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @tonycozOn Wed Aug 26 21:08:46 2015, tonyc wrote:
Tickets 121048, 125341 and 125789 are all the same issue, which was fixed by Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
|
@mauke - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#121048 (status was 'resolved')
Searchable as RT121048$
The text was updated successfully, but these errors were encountered: