In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b3725d49f914ef2bed63d7eb92a72ef6e886b489?hp=0fa70a06a98fc8fa9840d4dbaa31fc2d3b28b99b>
- Log ----------------------------------------------------------------- commit b3725d49f914ef2bed63d7eb92a72ef6e886b489 Author: Hugo van der Sanden <[email protected]> Date: Tue Feb 10 14:25:42 2015 +0000 [perl #123782] regcomp: check for overflow on /(?123)/ AFL (<http://lcamtuf.coredump.cx/afl>) found that the UV to I32 conversion can evade the necessary range checks on wraparound, leading to bad reads. Check for it, and force to I32_MAX, expecting that this will usually yield a "Reference to nonexistent group" error. ----------------------------------------------------------------------- Summary of changes: regcomp.c | 4 +++- t/re/pat.t | 15 ++++++++++++++- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/regcomp.c b/regcomp.c index 9e1fab9..a761fd5 100644 --- a/regcomp.c +++ b/regcomp.c @@ -10118,12 +10118,14 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) parse_recursion: { bool is_neg = FALSE; + UV unum; parse_start = RExC_parse - 1; /* MJD */ if (*RExC_parse == '-') { RExC_parse++; is_neg = TRUE; } - num = grok_atou(RExC_parse, &endptr); + unum = grok_atou(RExC_parse, &endptr); + num = (unum > I32_MAX) ? I32_MAX : (I32)unum; if (endptr) RExC_parse = (char*)endptr; if (is_neg) { diff --git a/t/re/pat.t b/t/re/pat.t index 53972fe..9c54f68 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -22,7 +22,7 @@ BEGIN { skip_all_without_unicode_tables(); } -plan tests => 765; # Update this when adding/deleting tests. +plan tests => 769; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1646,6 +1646,19 @@ EOP "qr/${pat}x/ shows x in error even if it's a wide character"); } } + + { + # Expect one of these sizes to cause overflow and wrap to negative + for my $bits (32, 64) { + my $wrapneg = 2 ** ($bits - 2) * 3; + for my $sign ('', '-') { + my $pat = sprintf "qr/(?%s%u)/", $sign, $wrapneg; + eval $pat; + ok(1, "big backref $pat did not crash"); + } + } + } + } # End of sub run_tests 1; -- Perl5 Master Repository
