Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
59 changes: 33 additions & 26 deletions regcomp.c
Original file line number Diff line number Diff line change
Expand Up @@ -1356,6 +1356,24 @@ S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc)
return TRUE;
}

static void
release_RExC_state(pTHX_ void *vstate) {
RExC_state_t *pRExC_state = (RExC_state_t *)vstate;

/* Any or all of these might be NULL.

There's no point in setting them to NULL after the free, since
pRExC_state is about to be released.
*/
SvREFCNT_dec(RExC_rx_sv);
Safefree(RExC_open_parens);
Safefree(RExC_close_parens);
Safefree(RExC_logical_to_parno);
Safefree(RExC_parno_to_logical);

Safefree(pRExC_state);
}

/*
* Perl_re_op_compile - the perl internal RE engine's function to compile a
* regular expression into internal code.
Expand Down Expand Up @@ -1437,8 +1455,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
bool recompile = 0;
bool runtime_code = 0;
scan_data_t data;
RExC_state_t RExC_state;
RExC_state_t * const pRExC_state = &RExC_state;

#ifdef TRIE_STUDY_OPT
/* search for "restudy" in this file for a detailed explanation */
Expand All @@ -1449,25 +1465,28 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,

PERL_ARGS_ASSERT_RE_OP_COMPILE;

DEBUG_r(if (!PL_colorset) reginitcolors());

RExC_state_t *pRExC_state = NULL;
/* Ensure that all members of the pRExC_state is initialized to 0
* at the start of regex compilation. Historically we have had issues
* with people remembering to zero specific members or zeroing them
* too late, etc. Doing it in one place is saner and avoid oversight
* or error. */
Zero(pRExC_state,1,RExC_state_t);
Newxz(pRExC_state, 1, RExC_state_t);

SAVEDESTRUCTOR_X(release_RExC_state, pRExC_state);

DEBUG_r({
/* and then initialize RExC_mysv1 and RExC_mysv2 early so if
* something calls regprop we don't have issues. These variables
* not being set up properly motivated the use of Zero() to initalize
* not being set up properly motivated the use of Newxz() to initalize
* the pRExC_state structure, as there were codepaths under -Uusedl
* that left these unitialized, and non-null as well. */
RExC_mysv1 = sv_newmortal();
RExC_mysv2 = sv_newmortal();
});

DEBUG_r(if (!PL_colorset) reginitcolors());


if (is_bare_re)
*is_bare_re = FALSE;

Expand Down Expand Up @@ -1840,6 +1859,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,

/* Clean up what we did in this parse */
SvREFCNT_dec_NN(RExC_rx_sv);
RExC_rx_sv = NULL;

goto redo_parse;
}
Expand Down Expand Up @@ -1915,12 +1935,12 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
/* search for "restudy" in this file for a detailed explanation */
if (!restudied) {
StructCopy(&zero_scan_data, &data, scan_data_t);
copyRExC_state = RExC_state;
copyRExC_state = *pRExC_state;
} else {
U32 seen=RExC_seen;
DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "Restudying\n"));

RExC_state = copyRExC_state;
*pRExC_state = copyRExC_state;
if (seen & REG_TOP_LEVEL_BRANCHES_SEEN)
RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN;
else
Expand Down Expand Up @@ -2439,22 +2459,10 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
regdump(RExC_rx);
});

if (RExC_open_parens) {
Safefree(RExC_open_parens);
RExC_open_parens = NULL;
}
if (RExC_close_parens) {
Safefree(RExC_close_parens);
RExC_close_parens = NULL;
}
if (RExC_logical_to_parno) {
Safefree(RExC_logical_to_parno);
RExC_logical_to_parno = NULL;
}
if (RExC_parno_to_logical) {
Safefree(RExC_parno_to_logical);
RExC_parno_to_logical = NULL;
}
/* we're returning ownership of the SV to the caller, ensure the cleanup
* doesn't release it
*/
RExC_rx_sv = NULL;

#ifdef USE_ITHREADS
/* under ithreads the ?pat? PMf_USED flag on the pmop is simulated
Expand Down Expand Up @@ -9344,7 +9352,6 @@ S_output_posix_warnings(pTHX_ RExC_state_t *pRExC_state, AV* posix_warnings)
array is mortal, but is a
fail-safe */
(void) sv_2mortal(msg);
PREPARE_TO_DIE;
}
Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s", SvPVX(msg));
SvREFCNT_dec_NN(msg);
Expand Down
74 changes: 8 additions & 66 deletions regcomp_internal.h
Original file line number Diff line number Diff line change
Expand Up @@ -870,21 +870,6 @@ static const scan_data_t zero_scan_data = {
* past a nul byte. */
#define SKIP_IF_CHAR(s, e) (!*(s) ? 0 : UTF ? UTF8_SAFE_SKIP(s, e) : 1)

/* Set up to clean up after our imminent demise */
#define PREPARE_TO_DIE \
STMT_START { \
if (RExC_rx_sv) \
SAVEFREESV(RExC_rx_sv); \
if (RExC_open_parens) \
SAVEFREEPV(RExC_open_parens); \
if (RExC_close_parens) \
SAVEFREEPV(RExC_close_parens); \
if (RExC_logical_to_parno) \
SAVEFREEPV(RExC_logical_to_parno); \
if (RExC_parno_to_logical) \
SAVEFREEPV(RExC_parno_to_logical); \
} STMT_END

/*
* Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
* arg. Show regex, up to a maximum length. If it's too long, chop and add
Expand All @@ -894,7 +879,6 @@ static const scan_data_t zero_scan_data = {
const char *ellipses = ""; \
IV len = RExC_precomp_end - RExC_precomp; \
\
PREPARE_TO_DIE; \
if (len > RegexLengthToShowInErrorMessages) { \
/* chop 10 shorter than the max, to ensure meaning of "..." */ \
len = RegexLengthToShowInErrorMessages - 10; \
Expand Down Expand Up @@ -923,69 +907,29 @@ static const scan_data_t zero_scan_data = {
m, REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END

/*
* Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
*/
#define vFAIL(m) STMT_START { \
PREPARE_TO_DIE; \
Simple_vFAIL(m); \
} STMT_END

/*
* Like Simple_vFAIL(), but accepts two arguments.
*/
#define Simple_vFAIL2(m,a1) STMT_START { \
S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END

/*
* Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
*/
#define vFAIL2(m,a1) STMT_START { \
PREPARE_TO_DIE; \
Simple_vFAIL2(m, a1); \
} STMT_END

#define vFAIL(m) Simple_vFAIL(m)

/*
* Like Simple_vFAIL(), but accepts three arguments.
* Like Simple_vFAIL(), but accepts extra arguments.
*/
#define Simple_vFAIL3(m, a1, a2) STMT_START { \
S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \
REPORT_LOCATION_ARGS(RExC_parse)); \
#define Simple_vFAILn(m, ...) STMT_START { \
S_re_croak(aTHX_ UTF, m REPORT_LOCATION, __VA_ARGS__, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END

/*
* Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
*/
#define vFAIL3(m,a1,a2) STMT_START { \
PREPARE_TO_DIE; \
Simple_vFAIL3(m, a1, a2); \
} STMT_END
#define vFAIL2(m,a1) Simple_vFAILn(m, a1)

/*
* Like Simple_vFAIL(), but accepts four arguments.
*/
#define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, a3, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
#define vFAIL3(m,a1,a2) Simple_vFAILn(m, a1, a2)

#define vFAIL4(m,a1,a2,a3) STMT_START { \
PREPARE_TO_DIE; \
Simple_vFAIL4(m, a1, a2, a3); \
} STMT_END
#define vFAIL4(m,a1,a2,a3) Simple_vFAILn(m, a1, a2, a3)

/* A specialized version of vFAIL2 that works with UTF8f */
#define vFAIL2utf8f(m, a1) STMT_START { \
PREPARE_TO_DIE; \
S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END

#define vFAIL3utf8f(m, a1, a2) STMT_START { \
PREPARE_TO_DIE; \
S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \
REPORT_LOCATION_ARGS(RExC_parse)); \
} STMT_END
Expand Down Expand Up @@ -1026,8 +970,6 @@ static const scan_data_t zero_scan_data = {
__FILE__, __LINE__, loc); \
} \
if (TO_OUTPUT_WARNINGS(loc)) { \
if (ckDEAD(warns)) \
PREPARE_TO_DIE; \
code; \
UPDATE_WARNINGS_LOC(loc); \
} \
Expand Down
18 changes: 17 additions & 1 deletion t/re/pat.t
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ skip_all_without_unicode_tables();
my $has_locales = locales_enabled('LC_CTYPE');
my $utf8_locale = find_utf8_ctype_locale();

plan tests => 1293; # Update this when adding/deleting tests.
plan tests => 1295; # Update this when adding/deleting tests.

run_tests() unless caller;

Expand Down Expand Up @@ -2627,6 +2627,22 @@ SKIP:

}

{
# github #21661
fresh_perl_is(<<'PROG', <<'EXPECT', {}, "double-free on fatal warn with existing error");
use warnings FATAL => qw(all);
/() {}/X;
PROG
Unknown regexp modifier "/X" at - line 2, at end of line
Unescaped left brace in regex is passed through in regex; marked by <-- HERE in m/() { <-- HERE }/ at - line 2.
Execution of - aborted due to compilation errors.
EXPECT
fresh_perl_is(<<'PROG', "", {}, "leak if __WARN__ handler dies");
use warnings;
local $SIG{__WARN__} = sub { die; };
eval "qr/()x{/;" for 1..10;
PROG
}
} # End of sub run_tests

1;
Expand Down