In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1a13b0759af8c958576ca1da3d406f7abdf9d241?hp=8aed2c65cec8aaa88a3d43cb2992c5383ce2e6e8>
- Log ----------------------------------------------------------------- commit 1a13b0759af8c958576ca1da3d406f7abdf9d241 Author: Yves Orton <[email protected]> Date: Sun Apr 15 11:23:11 2012 +0200 fix [perl #112370] memEQ off-by-one in Perl_regexec_flags() The problem was that when we had a floating non-unicode substr we could read past the beginning of the string. So for instance this code: foreach ("\x{2603}", 'a') { 'b' =~ /(?:^|.)$_$/; } When run under valgrind would show an illegal read. If run under use re 'debug' we would see output like this: floating utf8 "a"$ at 0..1 (checking floating) minlen 1 Matching REx "(?:^|.)a$" against "b" UTF-8 pattern... Can't trim the tail, match fails (should not happen) Match failed Which suggests we are falling into a "should not happen" branch of the code. This patch fixes the logic to properly test string length issues, and changes the debug output so it looks like this: floating utf8 "a"$ at 0..1 (checking floating) minlen 1 Matching REx "(?:^|.)a$" against "b" UTF-8 pattern... String does not contain required trailing substring, cannot match. Match failed Which makes more sense. M regexec.c commit 1d589e3bb1d165eda8b41fa754586bf1c5f0200e Author: Yves Orton <[email protected]> Date: Sun Apr 15 11:22:29 2012 +0200 Add an assert related to [perl #112370] memEQ off-by-one in Perl_regexec_flags() This probably breaks tests under DEBUGGING, but it should also make this codepath more robust to future changes. It seems to pass all tests. Follow up patch fixes one cause of this assert being utilized. M regexec.c ----------------------------------------------------------------------- Summary of changes: regexec.c | 52 +++++++++++++++++++++++++++++++++++++++++++++------- 1 files changed, 45 insertions(+), 7 deletions(-) diff --git a/regexec.c b/regexec.c index 8ccb6f7..ea4810d 100644 --- a/regexec.c +++ b/regexec.c @@ -2448,15 +2448,52 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre else { STRLEN len; const char * const little = SvPV_const(float_real, len); - if (SvTAIL(float_real)) { - if (memEQ(strend - len + 1, little, len - 1)) - last = strend - len + 1; - else if (!multiline) - last = memEQ(strend - len, little, len) - ? strend - len : NULL; - else + /* This means that float_real contains an artificial \n on the end + * due to the presence of something like this: /foo$/ + * where we can match both "foo" and "foo\n" at the end of the string. + * So we have to compare the end of the string first against the float_real + * without the \n and then against the full float_real with the string. + * We have to watch out for cases where the string might be smaller + * than the float_real or the float_real without the \n. + */ + char *checkpos= strend - len; + DEBUG_OPTIMISE_r( + PerlIO_printf(Perl_debug_log, + "%sChecking for float_real.%s\n", + PL_colors[4], PL_colors[5])); + if (checkpos + 1 < strbeg) { + /* can't match, even if we remove the trailing \n string is too short to match */ + DEBUG_EXECUTE_r( + PerlIO_printf(Perl_debug_log, + "%sString shorter than required trailing substring, cannot match.%s\n", + PL_colors[4], PL_colors[5])); + goto phooey; + } else if (memEQ(checkpos + 1, little, len - 1)) { + /* can match, the end of the string matches without the "\n" */ + last = checkpos + 1; + } else if (checkpos < strbeg) { + /* cant match, string is too short when the "\n" is included */ + DEBUG_EXECUTE_r( + PerlIO_printf(Perl_debug_log, + "%sString does not contain required trailing substring, cannot match.%s\n", + PL_colors[4], PL_colors[5])); + goto phooey; + } else if (!multiline) { + /* non multiline match, so compare with the "\n" at the end of the string */ + if (memEQ(checkpos, little, len)) { + last= checkpos; + } else { + DEBUG_EXECUTE_r( + PerlIO_printf(Perl_debug_log, + "%sString does not contain required trailing substring, cannot match.%s\n", + PL_colors[4], PL_colors[5])); + goto phooey; + } + } else { + /* multiline match, so we have to search for a place where the full string is located */ goto find_last; + } } else { find_last: if (len) @@ -2465,6 +2502,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre last = strend; /* matching "$" */ } } + assert(last != NULL); /* the re_debug output below suggests we need this assert() */ if (last == NULL) { DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, -- Perl5 Master Repository
