Re: [perl #130561] Coredump in Perl_re_op_compile

Front page | perl.perl5.porters | Postings from January 2017

Re: [perl #130561] Coredump in Perl_re_op_compile

Thread Previous | Thread Next

From:

demerphq

Date:

January 27, 2017 06:21

Subject:

Re: [perl #130561] Coredump in Perl_re_op_compile

Message ID:

CANgJU+XBDzTu-7ADeEgSN+5pvo+cbUi3mVhdHGsNfAVLjo0TkQ@mail.gmail.com

On 26 January 2017 at 11:20, Hugo van der Sanden via RT
<perlbug-followup@perl.org> wrote:
> Ugh, I experimented with this some more, and found that after my patch to deoptimize this loops until stack exhaustion:
>
> ./miniperl -wle '"abaad" =~ m{(a) b ( ((?1)){2,1} | aa )d}x'

That is because your patch did not change regexec.c to fail when the
min/max are incorrect.

> I think it'd be worth trying to chase down the bugs here, but I suspect the fuzzers will find more, and we're quite late in the release cycle to be hoping for confidence in this before 5.26 freeze.
>
> So for now I'm going to look instead whether I can make it less dangerous to miss RExC_recurse entries, that feels like the surer (and more useful) target.

That wont work either.

This:

"foo"=~/(foo){8,0}|(?1)/

should match if we allow this pattern to execute. If we optimise away
the (foo){8,0} then the (?1) cant match 'foo'.

Because of this I think we should either revert the original change
until we can rethink it, or otherwise pursue your original solution
which IMO could work.

FWIW, before I realized the flaw in the original logic I nearly pushed
the following:

commit c934d69b23fd180481261c72c04cda25924cb10e
Author: Yves Orton <demerphq@gmail.com>
Date:   Fri Jan 27 06:50:58 2017 +0100

    fix [#130561], optimizing away a RECURSE op should not result in a SEGV

    It is possible that an OPEN which is the target of a recurse op,
    or that a recursion call itself, such as (?1) might be optimised
    away, which broke assumptions made about optimising recursion.

    The simplest fix is to verify that scan and OP(scan) are correct
    before we try to update parameters in the possible optimised away
    opcode.

diff --git a/regcomp.c b/regcomp.c
index 4f54b01..e515204 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7789,7 +7789,9 @@ Perl_re_op_compile(pTHX_ SV ** const patternp,
int pat_count,

     while ( RExC_recurse_count > 0 ) {
         const regnode *scan = RExC_recurse[ --RExC_recurse_count ];
-        ARG2L_SET( scan, RExC_open_parens[ARG(scan)] - scan );
+        /* this GOSUB may have been optimized away */
+        if (scan && OP(scan) == GOSUB)
+            ARG2L_SET( scan, RExC_open_parens[ARG(scan)] - scan );
     }

     Newxz(r->offs, RExC_npar, regexp_paren_pair);
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 2b6063c..150c854 100644
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -20,7 +20,7 @@ use warnings;
 use 5.010;
 use Config;

-plan tests => 2502;  # Update this when adding/deleting tests.
+plan tests => 2503;  # Update this when adding/deleting tests.

 run_tests() unless caller;

@@ -1131,6 +1131,12 @@ EOP
         my $s = "\x{f2}\x{140}\x{fe}\x{ff}\x{ff}\x{ff}";
         ok($s !~ /^0000.\34500\376\377\377\377/, "RT #129085");
     }
+    {
+        fresh_perl_is(
+            '"foo"=~/((?1)){8,0}/; print "ok"',
+            "ok", {}, 'RT #130561 - Optimised away recursion should
not cause SEGVs');
+    }
+

 } # End of sub run_tests



-- 
perl -Mre=debug -e "/just|another|perl|hacker/"

Thread Previous | Thread Next