In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/de0885da327045eed274d7f8913a58e6de0e0f30?hp=b12396ac84cef7e23e1aac516fa676165ddfc790>
- Log ----------------------------------------------------------------- commit de0885da327045eed274d7f8913a58e6de0e0f30 Author: David Mitchell <[email protected]> Date: Tue May 5 10:44:16 2015 +0100 null ptr deref in Perl_cv_forget_slab RT #124385 Parsing following a syntax error could result in a null ptr dereference. This commit contains a band-aid that returns from Perl_cv_forget_slab() if the cv arg is null; but the real issue is much deeper and needs a more general fix at some point. Basically, both the lexer and the parser use the save stack, and after an error, they can get out of sync. In particular: 1) when handling a double-quoted string, the lexer does an ENTER, saves most of its current state on the save stack, then uses the literal string as the toke source. When it reaches the end of the string, it LEAVEs, restores the lexer state and continues with the main source. 2) Whenever the parser starts a new block or sub scope, it remembers the current save stack position, and at end of scope, pops the save stack back to that position. In something like "@{ sub {]}} }}}" the lexer sees a double-quoted string, and saves the current lex state. The parser sees the start of a sub, and saves PL_compcv etc. Then a parse error occurs. The parser goes into error recovery, discarding tokens until it can return to a sane state. The lexer runs out of tokens when toking the string, does a LEAVE, and switches back to toking the main source. This LEAVE restores both the lexer's and the parser's state; in particular the parser gets its old PL_compcv restored, even though the parser hasn't finished compiling the current sub. Later, series of '}' tokens coming through allows the parser to finish the sub. Since PL_error_count > 0, it discards the just-compiled sub and sets PL_compcv to null. Normally the LEAVE_SCOPE done just after this would restore PL_compcv to its old value (e.g. PL_main_cv) but the stack has already been popped, so PL_compcv gets left null, and SEGVs occur. The two main ways I can think of fixing this in the long term are 1) avoid the lexer using the save stack for long-term state storage; in particular, make S_sublex_push() malloc a new parser object rather than saving the current lexer state on the save stack. 2) At the end of a sublex, if PL_error_count > 0, don't try to restore state and continue, instead just croak. N.B. the test that this commit adds to lex.t doesn't actually trigger the SEGV, since the bad code is wrapped in an eval which (for reasons I haven't researched) avoids the SEGV. ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- pad.c | 7 ++++--- proto.h | 6 +----- t/base/lex.t | 8 +++++++- 4 files changed, 13 insertions(+), 10 deletions(-) diff --git a/embed.fnc b/embed.fnc index fc9f3f3..5302779 100644 --- a/embed.fnc +++ b/embed.fnc @@ -317,7 +317,7 @@ pRn |SV* |cv_const_sv_or_av|NULLOK const CV *const cv Apd |SV * |cv_name |NN CV *cv|NULLOK SV *sv|U32 flags Apd |void |cv_undef |NN CV* cv p |void |cv_undef_flags |NN CV* cv|U32 flags -p |void |cv_forget_slab |NN CV *cv +p |void |cv_forget_slab |NULLOK CV *cv Ap |void |cx_dump |NN PERL_CONTEXT* cx Ap |SV* |filter_add |NULLOK filter_t funcp|NULLOK SV* datasv Ap |void |filter_del |NN filter_t funcp diff --git a/pad.c b/pad.c index 569f995..ad1fc85 100644 --- a/pad.c +++ b/pad.c @@ -500,11 +500,12 @@ finished its job, so it can forget the slab. void Perl_cv_forget_slab(pTHX_ CV *cv) { - const bool slabbed = !!CvSLABBED(cv); + bool slabbed; OPSLAB *slab = NULL; - PERL_ARGS_ASSERT_CV_FORGET_SLAB; - + if (!cv) + return; + slabbed = cBOOL(CvSLABBED(cv)); if (!slabbed) return; CvSLABBED_off(cv); diff --git a/proto.h b/proto.h index 0cfb696..0a33758 100644 --- a/proto.h +++ b/proto.h @@ -818,11 +818,7 @@ PERL_CALLCONV SV* Perl_cv_const_sv(const CV *const cv) PERL_CALLCONV SV* Perl_cv_const_sv_or_av(const CV *const cv) __attribute__warn_unused_result__; -PERL_CALLCONV void Perl_cv_forget_slab(pTHX_ CV *cv) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_CV_FORGET_SLAB \ - assert(cv) - +PERL_CALLCONV void Perl_cv_forget_slab(pTHX_ CV *cv); PERL_CALLCONV void Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckfun_p, SV **ckobj_p) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) diff --git a/t/base/lex.t b/t/base/lex.t index a34a508..8862337 100644 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -1,6 +1,6 @@ #!./perl -print "1..102\n"; +print "1..103\n"; $x = 'x'; @@ -511,3 +511,9 @@ eval q|s##[}#e|; # Used to crash [perl #124187] eval q|qq{@{[{}}*sub{]]}}}=u|; } + +{ + # Used to crash [perl #124385] + eval '0; qq{@{sub{]]}}}}}'; + print "ok $test - 124385\n"; $test++; +} -- Perl5 Master Repository
