Skip to content

Commit 0c087d5

Browse files
author
Steve Hay
committed
Merged revision(s) 1075807, 1241583, 1241983-1241984, 1241987, 1242010, 1242050, 1242068 from perl/modperl/branches/threading:
reintroduce MP_dTHX macro ........ modperl_interp_pool_select() when used to create or merge dir-configs at runtime may pull the interpreter from the wrong pool if the request's server is a vhost with a separate interpreter pool. ........ improve MP_TRACE output a bit: include current perl context for threaded perls ........ rename assert() => ap_assert() ........ similar to r1241583: make sure r->server is used to identify the interpreter pool to pull from at runtime. ........ comment added ........ remove a bit of code complexity modperl_module.c contains these 2 lines: interp = modperl_interp_pool_select(p, s); MP_PERL_CONTEXT_STORE_OVERRIDE(interp->perl); The latter decodes as orig_perl = PERL_GET_CONTEXT; aTHX = interp->perl; PERL_SET_CONTEXT(aTHX); Now, modperl_interp_pool_select() already calls PERL_SET_CONTEXT with the newly allocated interpreter. So, we get PERL_SET_CONTEXT(interp->perl); orig_perl = PERL_GET_CONTEXT; aTHX = interp->perl; PERL_SET_CONTEXT(aTHX); But this is the same as interp = modperl_interp_pool_select(p, s); aTHX = interp->perl; ........ ap_assert => MP_ASSERT (depends on MP_DEBUG) ........ git-svn-id: https://svn.apache.org/repos/asf/perl/modperl/branches/httpd24threading@1537772 13f79535-47bb-0310-9956-ffa450edef68
1 parent a5163c7 commit 0c087d5

8 files changed

+72
-49
lines changed

‎Changes

+6
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,12 @@ Also refer to the Apache::Test changes log file, at Apache-Test/Changes
1212

1313
=item 2.0.9-dev
1414

15+
Make sure modperl_interp_select uses r->server rather than the passed s
16+
parameter to find the interpreter pool to pull an interpreter from. This
17+
fixes an issue with vhosts with a separate interpreter pool and runtime
18+
dir-config merges that used to pull the interpreter from the wrong pool.
19+
[Torsten Foertsch]
20+
1521
PerlInterpScope is now more advisory. Using $(c|r)->pnotes will bind
1622
the current interpreter to that object for it's lifetime.
1723
$(c|r)->pnotes_kill() can be used to prematurely drop pnotes and

‎src/modules/perl/mod_perl.c

+11-5
Original file line numberDiff line numberDiff line change
@@ -742,11 +742,17 @@ static int modperl_hook_create_request(request_rec *r)
742742
MP_dRCFG;
743743

744744
#ifdef USE_ITHREADS
745-
if (modperl_threaded_mpm()) {
746-
MP_TRACE_i(MP_FUNC, "setting userdata MODPERL_R in pool %#lx to %lx",
747-
(unsigned long)r->pool, (unsigned long)r);
748-
(void)apr_pool_userdata_set((void *)r, "MODPERL_R", NULL, r->pool);
749-
}
745+
/* XXX: this is necessary to make modperl_interp_pool_select() work
746+
* which is used at runtime only to merge dir-configs by
747+
* modperl_module_config_merge().
748+
*
749+
* Since most requests won't need it it would be good to add some logic
750+
* (cheaper logic in terms of CPU cycles) to identify those cases and
751+
* avoid the hash operation.
752+
*/
753+
MP_TRACE_i(MP_FUNC, "setting userdata MODPERL_R in pool %#lx to %lx",
754+
(unsigned long)r->pool, (unsigned long)r);
755+
(void)apr_pool_userdata_set((void *)r, "MODPERL_R", NULL, r->pool);
750756
#endif
751757

752758
modperl_config_req_init(r, rcfg);

‎src/modules/perl/modperl_common_log.c

+18-5
Original file line numberDiff line numberDiff line change
@@ -49,14 +49,27 @@ void modperl_trace(const char *func, const char *fmt, ...)
4949
return;
5050
}
5151

52+
/* for more information on formatting codes see
53+
http://apr.apache.org/docs/apr/1.4/group__apr__lib.html#gad2cd3594aeaafd45931d1034965f48c1
54+
*/
5255
if (modperl_threaded_mpm()) {
53-
apr_file_printf(logfile, "[%lu/%lu] ", (unsigned long)getpid(),
54-
modperl_threads_started()
55-
? (unsigned long)apr_os_thread_current()
56-
: 0);
56+
if (modperl_threads_started()) {
57+
apr_file_printf(logfile, "[pid=%lu, tid=%pt, perl=%pp] ",
58+
(unsigned long)getpid(),
59+
(void*)apr_os_thread_current(), PERL_GET_CONTEXT);
60+
}
61+
else {
62+
apr_file_printf(logfile, "[pid=%lu, perl=%pp] ",
63+
(unsigned long)getpid(), PERL_GET_CONTEXT);
64+
}
5765
}
5866
else {
59-
apr_file_printf(logfile, "[%lu] ", (unsigned long)getpid());
67+
#ifdef USE_ITHREADS
68+
apr_file_printf(logfile, "[pid=%lu, perl=%pp] ",
69+
(unsigned long)getpid(), PERL_GET_CONTEXT);
70+
#else
71+
apr_file_printf(logfile, "[pid=%lu] ", (unsigned long)getpid());
72+
#endif
6073
}
6174

6275
if (func && *func) {

‎src/modules/perl/modperl_config.h

+17-15
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ void *modperl_config_srv_merge(apr_pool_t *p, void *basev, void *addv);
3636
char **modperl_config_srv_argv_init(modperl_config_srv_t *scfg, int *argc);
3737

3838
#define modperl_config_srv_argv_push(arg) \
39-
*(const char **)apr_array_push(scfg->argv) = arg
39+
*(const char **)apr_array_push(scfg->argv) = (arg)
4040

4141
apr_status_t modperl_config_request_cleanup(pTHX_ request_rec *r);
4242

@@ -49,9 +49,9 @@ apr_status_t modperl_config_req_cleanup(void *data);
4949
#define modperl_config_req_cleanup_register(r, rcfg) \
5050
if (r && !MpReqCLEANUP_REGISTERED(rcfg)) { \
5151
apr_pool_t *p; \
52-
apr_pool_create(&p, r->pool); \
52+
apr_pool_create(&p, (r)->pool); \
5353
apr_pool_cleanup_register(p, \
54-
(void*)r, \
54+
(void*)(r), \
5555
modperl_config_req_cleanup, \
5656
apr_pool_cleanup_null); \
5757
MpReqCLEANUP_REGISTERED_On(rcfg); \
@@ -64,49 +64,49 @@ void modperl_set_perl_module_config(ap_conf_vector_t *cv, void *cfg);
6464
# define modperl_get_module_config(v) \
6565
modperl_get_perl_module_config(v)
6666

67-
# define modperl_set_module_config(v, c) \
68-
modperl_set_perl_module_config(v, c)
67+
# define modperl_set_module_config((v), c) \
68+
modperl_set_perl_module_config((v), (c))
6969
#else
7070
# define modperl_get_module_config(v) \
71-
ap_get_module_config(v, &perl_module)
71+
ap_get_module_config((v), &perl_module)
7272

7373
# define modperl_set_module_config(v, c) \
74-
ap_set_module_config(v, &perl_module, c)
74+
ap_set_module_config((v), &perl_module, (c))
7575
#endif
7676

7777
#define modperl_config_req_init(r, rcfg) \
78-
if (!rcfg) { \
79-
rcfg = modperl_config_req_new(r); \
80-
modperl_set_module_config(r->request_config, rcfg); \
78+
if (!(rcfg)) { \
79+
(rcfg) = modperl_config_req_new(r); \
80+
modperl_set_module_config((r)->request_config, (rcfg)); \
8181
}
8282

8383
#define modperl_config_req_get(r) \
8484
(r ? (modperl_config_req_t *) \
85-
modperl_get_module_config(r->request_config) : NULL)
85+
modperl_get_module_config((r)->request_config) : NULL)
8686

8787
#define MP_dRCFG \
8888
modperl_config_req_t *rcfg = modperl_config_req_get(r)
8989

9090
#define modperl_config_con_init(c, ccfg) \
9191
if (!ccfg) { \
9292
ccfg = modperl_config_con_new(c); \
93-
modperl_set_module_config(c->conn_config, ccfg); \
93+
modperl_set_module_config((c)->conn_config, (ccfg)); \
9494
}
9595

9696
#define modperl_config_con_get(c) \
9797
(c ? (modperl_config_con_t *) \
98-
modperl_get_module_config(c->conn_config) : NULL)
98+
modperl_get_module_config((C)->conn_config) : NULL)
9999

100100
#define MP_dCCFG \
101101
modperl_config_con_t *ccfg = modperl_config_con_get(c)
102102

103103
#define modperl_config_dir_get(r) \
104104
(r ? (modperl_config_dir_t *) \
105-
modperl_get_module_config(r->per_dir_config) : NULL)
105+
modperl_get_module_config((r)->per_dir_config) : NULL)
106106

107107
#define modperl_config_dir_get_defaults(s) \
108108
(modperl_config_dir_t *) \
109-
modperl_get_module_config(s->lookup_defaults)
109+
modperl_get_module_config((s)->lookup_defaults)
110110

111111
#define MP_dDCFG \
112112
modperl_config_dir_t *dcfg = modperl_config_dir_get(r)
@@ -132,8 +132,10 @@ void modperl_set_perl_module_config(ap_conf_vector_t *cv, void *cfg);
132132
modperl_interp_t *interp = \
133133
modperl_interp_select(r, r->connection, r->server); \
134134
dTHXa(interp->perl)
135+
# define MP_uTHX modperl_interp_unselect(interp)
135136
#else
136137
# define MP_dTHX dNOOP
138+
# define MP_uTHX dNOOP
137139
#endif
138140

139141
int modperl_config_apply_PerlModule(server_rec *s,

‎src/modules/perl/modperl_debug.h

+6
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,12 @@
1919

2020
#include "mod_perl.h"
2121

22+
#ifdef MP_DEBUG
23+
#define MP_ASSERT(exp) ap_assert(exp)
24+
#else
25+
#define MP_ASSERT(exp) ((void)0)
26+
#endif
27+
2228
char *modperl_server_desc(server_rec *s, apr_pool_t *p);
2329

2430
#ifdef MP_TRACE

‎src/modules/perl/modperl_interp.c

+10-18
Original file line numberDiff line numberDiff line change
@@ -285,7 +285,7 @@ apr_status_t modperl_interp_unselect(void *data)
285285

286286
if (interp == mip->parent) return APR_SUCCESS;
287287

288-
ap_assert(interp && MpInterpIN_USE(interp));
288+
MP_ASSERT(interp && MpInterpIN_USE(interp));
289289
MP_TRACE_i(MP_FUNC, "unselect(interp=0x%lx): refcnt=%d",
290290
(unsigned long)interp, interp->refcnt);
291291
if (interp->refcnt != 0) {
@@ -345,10 +345,10 @@ modperl_interp_t *modperl_interp_pool_select(apr_pool_t *p,
345345
server_rec *s)
346346
{
347347
int is_startup = (p == s->process->pconf);
348-
MP_dSCFG(s);
349348
modperl_interp_t *interp = NULL;
350349

351350
if (is_startup) {
351+
MP_dSCFG(s);
352352
if (scfg) {
353353
MP_TRACE_i(MP_FUNC, "using parent interpreter at startup");
354354

@@ -389,31 +389,20 @@ modperl_interp_t *modperl_interp_pool_select(apr_pool_t *p,
389389

390390
return interp;
391391
}
392-
else if (!modperl_threaded_mpm()) {
393-
MP_TRACE_i(MP_FUNC, "using parent interpreter in non-threaded mode");
394-
395-
/* since we are not running in threaded mode PERL_SET_CONTEXT
396-
* is not necessary */
397-
/* PERL_SET_CONTEXT(scfg->mip->parent->perl); */
398-
/* let the perl interpreter point back to its interp */
399-
MP_THX_INTERP_SET(scfg->mip->parent->perl, scfg->mip->parent);
400-
401-
return scfg->mip->parent;
402-
}
403392
else {
404393
request_rec *r;
405394
apr_pool_userdata_get((void **)&r, "MODPERL_R", p);
406-
ap_assert(r);
395+
MP_ASSERT(r);
407396
MP_TRACE_i(MP_FUNC, "found userdata MODPERL_R in pool %#lx as %lx",
408397
(unsigned long)r->pool, (unsigned long)r);
409-
return modperl_interp_select(r, NULL, s);
398+
return modperl_interp_select(r, NULL, NULL);
410399
}
411400
}
412401

413402
modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
414403
server_rec *s)
415404
{
416-
MP_dSCFG(s);
405+
MP_dSCFG((r ? s=r->server : s ? s : NULL));
417406
MP_dDCFG;
418407
modperl_config_con_t *ccfg;
419408
const char *desc = NULL;
@@ -450,7 +439,10 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
450439
return ccfg->interp;
451440
}
452441

453-
interp = modperl_interp_get(s ? s : r->server);
442+
MP_TRACE_i(MP_FUNC,
443+
"fetching interp for (%s:%d)", s->server_hostname, s->port);
444+
interp = modperl_interp_get(s);
445+
MP_TRACE_i(MP_FUNC, " --> got %pp", interp);
454446
++interp->num_requests; /* should only get here once per request */
455447
interp->refcnt = 0;
456448

@@ -505,7 +497,7 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
505497
}
506498
}
507499

508-
ap_assert(p);
500+
MP_ASSERT(p);
509501

510502
#ifdef MP_TRACE
511503
apr_pool_cleanup_register(p, (void *)interp,

‎src/modules/perl/modperl_module.c

+2-4
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,7 @@ static void *modperl_module_config_merge(apr_pool_t *p,
168168
SV *mrg_obj = (SV *)NULL, *base_obj, *add_obj;
169169
#ifdef USE_ITHREADS
170170
modperl_interp_t *interp;
171-
MP_PERL_CONTEXT_DECLARE;
171+
pTHX;
172172
#endif
173173

174174
/* if the module is loaded in vhost, base==NULL */
@@ -184,7 +184,7 @@ static void *modperl_module_config_merge(apr_pool_t *p,
184184

185185
#ifdef USE_ITHREADS
186186
interp = modperl_interp_pool_select(p, s);
187-
MP_PERL_CONTEXT_STORE_OVERRIDE(interp->perl);
187+
aTHX = interp->perl;
188188
#endif
189189

190190
table = modperl_module_config_table_get(aTHX_ TRUE);
@@ -196,7 +196,6 @@ static void *modperl_module_config_merge(apr_pool_t *p,
196196
MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
197197
interp, interp->refcnt);
198198
modperl_interp_unselect(interp);
199-
MP_PERL_CONTEXT_RESTORE;
200199
#endif
201200
return addv;
202201
}
@@ -250,7 +249,6 @@ static void *modperl_module_config_merge(apr_pool_t *p,
250249
MP_TRACE_i(MP_FUNC, "unselecting: (0x%lx)->refcnt=%ld",
251250
interp, interp->refcnt);
252251
modperl_interp_unselect(interp);
253-
MP_PERL_CONTEXT_RESTORE;
254252
#endif
255253

256254
return (void *)mrg;

‎src/modules/perl/modperl_svptr_table.c

+2-2
Original file line numberDiff line numberDiff line change
@@ -184,7 +184,7 @@ modperl_svptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
184184
{
185185
PTR_TBL_ENT_t *tblent;
186186
UV hash = PTR2UV(sv);
187-
assert(tbl);
187+
MP_ASSERT(tbl);
188188
tblent = tbl->tbl_ary[hash & tbl->tbl_max];
189189
for (; tblent; tblent = tblent->next) {
190190
if (tblent->oldval == sv)
@@ -205,7 +205,7 @@ modperl_svptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
205205
UV hash = PTR2UV(oldv);
206206
bool i = 1;
207207

208-
assert(tbl);
208+
MP_ASSERT(tbl);
209209
otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
210210
for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
211211
if (tblent->oldval == oldv) {

0 commit comments

Comments
 (0)