Skip to content

2026 ithread repairs #5

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
joesuf4 wants to merge 7 commits into
base: trunk
Choose a base branch
from
Open

2026 ithread repairs #5

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
47b1c8a
HTTP/2
joesuf4 Apr 2, 2026
48a0a1d
bugfixes-under-h2load-tests
joesuf4 Apr 3, 2026
d81ad0c
massive-reliability-cleanup
joesuf4 Apr 5, 2026
eff1204
whitespace,etc
joesuf4 Apr 6, 2026
01ee00d
interpreter-locks
joesuf4 Apr 9, 2026
918a432
mostly-fix-BIZARRE-refcnt-issues
joesuf4 Apr 9, 2026
43af9e0
nuke-redundant-interpreter-locks-experiment
joesuf4 Apr 9, 2026
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
11 changes: 5 additions & 6 deletions src/modules/perl/mod_perl.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1034,27 +1034,27 @@ int modperl_response_handler(request_rec *r)
{
MP_dDCFG;
apr_status_t retval, rc;
MP_dINTERP;

if (!strEQ(r->handler, "modperl")) {
return DECLINED;
}

MP_INTERPa(r, r->connection, r->server);

/* default is -SetupEnv, add if PerlOption +SetupEnv */

MP_dINTERPa(r, NULL, NULL);

if (MpDirSETUP_ENV(dcfg)) {
modperl_env_request_populate(aTHX_ r);
}


retval = modperl_response_handler_run(r);
rc = modperl_response_finish(r);
if (rc != APR_SUCCESS) {
retval = rc;
}

MP_INTERP_PUTBACK(interp, aTHX);

return retval;
}

Expand All @@ -1064,13 +1064,12 @@ int modperl_response_handler_cgi(request_rec *r)
GV *h_stdin, *h_stdout;
apr_status_t retval, rc;
MP_dRCFG;
MP_dINTERP;

if (!strEQ(r->handler, "perl-script")) {
return DECLINED;
}

MP_INTERPa(r, r->connection, r->server);
MP_dINTERPa(r, NULL, NULL);

modperl_perl_global_request_save(aTHX_ r);

Expand Down
4 changes: 2 additions & 2 deletions src/modules/perl/modperl_callback.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ int modperl_callback(pTHX_ modperl_handler_t *handler, apr_pool_t *p,
I32 flags = G_EVAL|G_SCALAR;
dSP;
int count, status = OK;
PERL_SET_CONTEXT(aTHX);

/* handler callbacks shouldn't affect each other's taintedness
* state, so start every callback with a clear tainted status
Expand Down Expand Up @@ -147,7 +148,6 @@ int modperl_callback_run_handlers(int idx, int type,
apr_pool_t *ptemp,
modperl_hook_run_mode_e run_mode)
{
MP_dINTERP;
MP_dSCFG(s);
MP_dDCFG;
MP_dRCFG;
Expand Down Expand Up @@ -180,7 +180,7 @@ int modperl_callback_run_handlers(int idx, int type,
return DECLINED;
}

MP_INTERPa(r, c, s);
MP_dINTERPa(r, c, s);

switch (type) {
case MP_HANDLER_TYPE_PER_SRV:
Expand Down
14 changes: 6 additions & 8 deletions src/modules/perl/modperl_config.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -366,14 +366,12 @@ apr_status_t modperl_config_request_cleanup(pTHX_ request_rec *r)
apr_status_t modperl_config_req_cleanup(void *data)
{
request_rec *r = (request_rec *)data;
apr_status_t rc;
MP_dINTERPa(r, NULL, NULL);

rc = modperl_config_request_cleanup(aTHX_ r);

MP_INTERP_PUTBACK(interp, aTHX);

return rc;
apr_pool_t *p = ap_is_initial_req(r) ? r->pool : r->main->pool;
modperl_interp_t *interp = modperl_interp_pool_get(p);
if (interp && interp->perl)
return modperl_config_request_cleanup(interp->perl, r);
dTHX;
return modperl_config_request_cleanup(aTHX_ r);
}

void *modperl_get_perl_module_config(ap_conf_vector_t *cv)
Expand Down
4 changes: 2 additions & 2 deletions src/modules/perl/modperl_handler.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -352,8 +352,8 @@ void modperl_handler_make_args(pTHX_ AV **avp, ...)
*/
#define check_modify(dtype) \
if ((action > MP_HANDLER_ACTION_GET) && rcfg) { \
dTHXa(PERL_GET_CONTEXT); \
MP_ASSERT(aTHX+0); \
dTHX; \
MP_ASSERT(aTHX+0); \
Perl_croak(aTHX_ "too late to modify %s handlers", \
modperl_handler_desc_##dtype(idx)); \
}
Expand Down
127 changes: 89 additions & 38 deletions src/modules/perl/modperl_interp.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,8 +62,8 @@ modperl_interp_t *modperl_interp_new(modperl_interp_pool_t *mip,
#endif

PERL_SET_CONTEXT(perl);

interp->perl = perl_clone(perl, clone_flags);
PERL_SET_CONTEXT(interp->perl);

MP_ASSERT_CONTEXT(interp->perl);

Expand Down Expand Up @@ -92,7 +92,6 @@ modperl_interp_t *modperl_interp_new(modperl_interp_pool_t *mip,

modperl_interp_clone_init(interp);

PERL_SET_CONTEXT(perl);

#ifdef MP_USE_GTOP
MP_TRACE_m_do(
Expand All @@ -113,22 +112,24 @@ void modperl_interp_destroy(modperl_interp_t *interp)
void **handles;
dTHXa(interp->perl);

PERL_SET_CONTEXT(interp->perl);
PERL_SET_CONTEXT(aTHX);

MP_TRACE_i(MP_FUNC, "interp == 0x%lx / perl: 0x%lx",
(unsigned long)interp, (unsigned long)interp->perl);

if (MpInterpIN_USE(interp)) {
MP_TRACE_i(MP_FUNC, "*error - still in use!*");
abort();
}

handles = modperl_xs_dl_handles_get(aTHX);

modperl_perl_destruct(interp->perl);
modperl_perl_destruct(aTHX);

modperl_xs_dl_handles_close(handles);

free(interp);

}

apr_status_t modperl_interp_cleanup(void *data)
Expand All @@ -142,7 +143,7 @@ modperl_interp_t *modperl_interp_get(server_rec *s)
MP_dSCFG(s);
modperl_interp_t *interp = NULL;
modperl_interp_pool_t *mip = scfg->mip;
modperl_list_t *head;
volatile modperl_list_t *head;

head = modperl_tipool_pop(mip->tipool);
interp = (modperl_interp_t *)head->data;
Expand Down Expand Up @@ -200,7 +201,7 @@ static void interp_pool_shrink(modperl_tipool_t *tipool, void *data,
}

static void interp_pool_dump(modperl_tipool_t *tipool, void *data,
modperl_list_t *listp)
volatile modperl_list_t *listp)
{
while (listp) {
modperl_interp_t *interp = (modperl_interp_t *)listp->data;
Expand Down Expand Up @@ -249,18 +250,28 @@ void modperl_interp_init(server_rec *s, apr_pool_t *p,
scfg->mip = mip;
}

static apr_status_t modperl_interp_pool_unselect(void *data)
{
modperl_interp_t *interp = (modperl_interp_t *)data;
if (interp->refcnt > 1) {
MP_TRACE_i(MP_FUNC, "BIZARRE REFCNT: unselect(interp=%pp): refcnt=%d",
interp, interp->refcnt);
interp->refcnt = 1;
}
interp->pool = NULL;
return modperl_interp_unselect(data);
}

apr_status_t modperl_interp_unselect(void *data)
{
modperl_interp_t *interp = (modperl_interp_t *)data;
modperl_interp_pool_t *mip = interp->mip;

modperl_tipool_t *tipool = mip->tipool;
MP_ASSERT(interp && MpInterpIN_USE(interp) && interp->refcnt > 0);
MP_TRACE_i(MP_FUNC, "unselect(interp=%pp): refcnt=%d",
interp, interp->refcnt);

--interp->refcnt;

if (interp->refcnt > 0) {
if (--interp->refcnt > 0) {
MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d -- interp still in use",
(unsigned long)interp, interp->refcnt);
return APR_SUCCESS;
Expand All @@ -274,6 +285,9 @@ apr_status_t modperl_interp_unselect(void *data)

MpInterpIN_USE_Off(interp);

if (interp->pool)
apr_pool_cleanup_kill(interp->pool, interp, modperl_interp_pool_unselect), interp->pool = NULL;

modperl_thx_interp_set(interp->perl, NULL);
#ifdef MP_DEBUG
PERL_SET_CONTEXT(NULL);
Expand All @@ -284,9 +298,9 @@ apr_status_t modperl_interp_unselect(void *data)
}
else {
interp->ccfg->interp = NULL;
modperl_tipool_putback_data(mip->tipool, data, interp->num_requests);
modperl_tipool_putback_data(tipool, data, interp->num_requests);
MP_TRACE_i(MP_FUNC, "interp=%pp freed, tipool(size=%ld, in_use=%ld)",
interp, mip->tipool->size, mip->tipool->in_use);
interp, tipool->size, tipool->in_use);
}

return APR_SUCCESS;
Expand All @@ -304,7 +318,7 @@ apr_status_t modperl_interp_unselect(void *data)

#define set_interp(p) \
(void)apr_pool_userdata_set((void *)interp, MP_INTERP_KEY, \
modperl_interp_unselect, \
modperl_interp_pool_unselect, \
p)

modperl_interp_t *modperl_interp_pool_get(apr_pool_t *p)
Expand All @@ -320,6 +334,15 @@ void modperl_interp_pool_set(apr_pool_t *p,
(void)apr_pool_userdata_set((void *)interp, MP_INTERP_KEY, NULL, p);
}

modperl_interp_t *modperl_interp_pool_unset(apr_pool_t *p)
{
modperl_interp_t *interp = NULL;
get_interp(p);
(void)apr_pool_userdata_set(NULL, MP_INTERP_KEY, NULL, p);
return interp;
}


/*
* used in the case where we don't have a request_rec or conn_rec,
* such as for directive handlers per-{dir,srv} create and merge.
Expand All @@ -343,7 +366,7 @@ modperl_interp_t *modperl_interp_pool_select(apr_pool_t *p,
modperl_init_vhost(s, p, NULL);
if (!scfg->mip) {
/* FIXME: We get here if global "server_rec" == s, scfg->mip
* is not created then. I'm not sure if that's bug or
* is not created then. I'm not sure if that's bug or
* bad/good design decicision. For now just return NULL.
*/
return NULL;
Expand Down Expand Up @@ -385,15 +408,16 @@ modperl_interp_t *modperl_interp_pool_select(apr_pool_t *p,
}
}

modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
server_rec *s)
modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec *s)
{
MP_dSCFG((r ? s=r->server : c ? s=c->base_server : s));
s = r ? r->server : c ? c->base_server : s;
MP_dSCFG(s);
MP_dDCFG;
modperl_config_con_t *ccfg;
modperl_config_con_t *ccfg = NULL;
modperl_config_req_t *rcfg = NULL;
const char *desc = NULL;
modperl_interp_t *interp = NULL;
apr_pool_t *p = NULL;
apr_pool_t *p;

/* What does the following condition mean?
* (r || c): if true we are at runtime. There is some kind of request
Expand All @@ -405,7 +429,7 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
if (!((r || c) && modperl_threaded_mpm())) {
interp = scfg->mip->parent;
MpInterpIN_USE_On(interp);
interp->refcnt++;
interp->refcnt = 1;
/* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */
PERL_SET_CONTEXT(interp->perl);
/* let the perl interpreter point back to its interp */
Expand All @@ -418,21 +442,24 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
return interp;
}

if(!c) c = r->connection;
ccfg = modperl_config_con_get(c);
if (r && !ap_is_initial_req(r))
r = r->main;

p = r ? r->pool : c ? c->pool : NULL;

if (ccfg && ccfg->interp) {
ccfg->interp->refcnt++;
if (r && !c) c = r->connection;

if (c)
ccfg = modperl_config_con_get(c);

if (p && (interp = modperl_interp_pool_get(p)) && MpInterpIN_USE(interp)) {
interp->refcnt++;
interp->num_requests++;
MP_TRACE_i(MP_FUNC,
"found interp 0x%lx in con config, refcnt incremented to %d",
(unsigned long)ccfg->interp, ccfg->interp->refcnt);
/* set context (THX) for this thread */
PERL_SET_CONTEXT(ccfg->interp->perl);
/* modperl_thx_interp_set() is not called here because the interp
* already belongs to the perl interpreter
*/
return ccfg->interp;
"found interp 0x%lx (perl=0x%pp) in r->pool config, refcnt=%d",
(unsigned long)interp, interp->perl, interp->refcnt);
PERL_SET_CONTEXT(interp->perl);
return interp;
}

MP_TRACE_i(MP_FUNC,
Expand All @@ -442,19 +469,37 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
++interp->num_requests; /* should only get here once per request */
interp->refcnt = 1;

/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp->perl);
/* let the perl interpreter point back to its interp */
modperl_thx_interp_set(interp->perl, interp);

/* make sure ccfg is initialized */
/* make sure ccfg/rcfg is initialized */
modperl_config_con_init(c, ccfg);
ccfg->interp = interp;
interp->ccfg = ccfg;

if (ccfg && ccfg->interp == NULL)
ccfg->interp = interp;
if (interp->ccfg == NULL)
interp->ccfg = ccfg;

MP_TRACE_i(MP_FUNC,
"pulled interp %pp (perl=%pp) from mip, num_requests is %d",
interp, interp->perl, interp->num_requests);
if (r)
/* it is correct to bump the refcnt below, assuming mod_http2's h2_stream.c is patched:


@@ -659,16 +659,16 @@ apr_status_t h2_stream_set_request_rec(h2_stream *stream,
if (stream->rst_error) {
return APR_ECONNRESET;
}
- status = h2_request_rcreate(&req, stream->pool, r,
+ status = h2_request_rcreate(&req, r->pool, r,
&stream->session->hd_scratch);
if (status == APR_SUCCESS) {



*/
interp->refcnt++, set_interp(p), interp->pool = p;

return interp;
}
Expand All @@ -466,7 +511,10 @@ void modperl_interp_mip_walk(PerlInterpreter *current_perl,
modperl_interp_mip_walker_t walker,
void *data)
{
modperl_list_t *head = mip->tipool ? mip->tipool->idle : NULL;
if (mip->tipool)
modperl_tipool_lock(mip->tipool);

volatile modperl_list_t *head = mip->tipool ? mip->tipool->idle : NULL;

if (!current_perl) {
current_perl = PERL_GET_CONTEXT;
Expand All @@ -484,6 +532,9 @@ void modperl_interp_mip_walk(PerlInterpreter *current_perl,
head = head->next;
}

if (mip->tipool)
modperl_tipool_unlock(mip->tipool);

PERL_SET_CONTEXT(current_perl);
}

Expand Down
Loading