Permalink
Browse files

[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.
  • Loading branch information...
hvds committed Feb 10, 2015
1 parent 0fa70a0 commit b3725d49f914ef2bed63d7eb92a72ef6e886b489
Showing with 17 additions and 2 deletions.
  1. +3 −1 regcomp.c
  2. +14 −1 t/re/pat.t
View
@@ -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) {
View
@@ -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;

0 comments on commit b3725d4

Please sign in to comment.