dougm 00/04/27 14:42:26
Modified: lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_callback.c
modperl_callback.h modperl_config.c
modperl_config.h modperl_interp.c modperl_interp.h
modperl_types.h
Log:
stash selected interp object in the given pool (c->pool or r->pool),
rather than r->request_config, required for Perl*ConnectionHandlers
hookup PerlOpenLogsHandler and PerlChildInitHandler
Revision Changes Path
1.19 +16 -7 modperl-2.0/lib/ModPerl/Code.pm
Index: Code.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- Code.pm 2000/04/26 07:29:24 1.18
+++ Code.pm 2000/04/27 21:42:24 1.19
@@ -8,7 +8,7 @@
#XXX Init, PreConfig
my %handlers = (
Process => [qw(ChildInit ChildExit Restart)],
- Files => [qw(OpenLog PostConfig)],
+ Files => [qw(OpenLogs PostConfig)],
PerSrv => [qw(PostReadRequest Trans)],
PerDir => [qw(HeaderParser
Access Authen Authz
@@ -30,6 +30,8 @@
Log => 'log_transaction',
PreConnection => 'pre_connection',
ProcessConnection => 'process_connection',
+ OpenLogs => 'open_logs',
+ ChildInit => 'child_init',
);
my %hook_proto = (
@@ -60,13 +62,14 @@
my $dcfg_get =
'modperl_dir_config_t *dcfg = (modperl_dir_config_t *)dummy';
+my $scfg_get = 'MP_dSCFG(parms->server)';
+
my %directive_proto = (
PerSrv => {
args => [{type => 'cmd_parms', name => 'parms'},
{type => 'void', name => 'dummy'},
{type => 'char', name => 'arg'}],
- cfg => {get => 'MP_dSCFG(parms->server)',
- name => 'scfg'},
+ cfg => {get => $scfg_get, name => 'scfg'},
scope => 'RSRC_CONF',
},
PerDir => {
@@ -78,12 +81,18 @@
},
);
-while (my($k,$v) = each %directive_proto) {
- $directive_proto{$k}->{ret} = 'const char *';
+for my $class (qw(Process Connection Files)) {
+ my $lc_class = lc $class;
+ $directive_proto{$class}->{cfg}->{name} = "scfg->${lc_class}_cfg";
+ $directive_proto{$class}->{cfg}->{get} = $scfg_get;
+
+ for (qw(args scope)) {
+ $directive_proto{$class}->{$_} = $directive_proto{PerSrv}->{$_};
+ }
}
-for (qw(Process Connection Files)) {
- $directive_proto{$_} = $directive_proto{PerSrv};
+while (my($k,$v) = each %directive_proto) {
+ $directive_proto{$k}->{ret} = 'const char *';
}
my %flags = (
1.12 +1 -1 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- mod_perl.c 2000/04/26 07:29:25 1.11
+++ mod_perl.c 2000/04/27 21:42:25 1.12
@@ -61,7 +61,7 @@
void modperl_register_hooks(void)
{
/* XXX: should be pre_config hook or 1.xx logic */
- ap_hook_open_logs(modperl_hook_init, NULL, NULL, AP_HOOK_MIDDLE);
+ ap_hook_open_logs(modperl_hook_init, NULL, NULL, AP_HOOK_FIRST);
modperl_register_handler_hooks();
}
1.6 +52 -24 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_callback.c 2000/04/25 05:57:48 1.5
+++ modperl_callback.c 2000/04/27 21:42:25 1.6
@@ -39,8 +39,7 @@
ap_status_t modperl_handler_cleanup(void *data)
{
modperl_handler_t *handler = (modperl_handler_t *)data;
- dTHXa(handler->perl);
- modperl_handler_unparse(aTHX_ handler);
+ modperl_handler_unparse(handler);
return APR_SUCCESS;
}
@@ -112,8 +111,9 @@
return 0;
}
-void modperl_handler_unparse(pTHX_ modperl_handler_t *handler)
+void modperl_handler_unparse(modperl_handler_t *handler)
{
+ dTHXa(handler->perl);
int was_parsed = handler->args || handler->cv || handler->obj;
if (!MpHandlerPARSED(handler)) {
@@ -153,6 +153,10 @@
char *tmp;
CV *cv;
+#ifdef USE_ITHREADS
+ handler->perl = aTHX;
+#endif
+
if (strnEQ(name, "sub ", 4)) {
handler->cv = eval_pv(name, FALSE);
MP_TRACE_h(MP_FUNC, "handler is anonymous\n");
@@ -279,27 +283,46 @@
#define MP_HANDLER_TYPE_DIR 1
#define MP_HANDLER_TYPE_SRV 2
+#define MP_HANDLER_TYPE_CONN 3
+#define MP_HANDLER_TYPE_PROC 4
+#define MP_HANDLER_TYPE_FILE 5
-int modperl_run_handlers(int idx, request_rec *r, server_rec *s, int type)
+int modperl_run_handlers(int idx, request_rec *r, conn_rec *c,
+ server_rec *s, int type)
{
#ifdef USE_ITHREADS
pTHX;
#endif
MP_dSCFG(s);
+ MP_dDCFG;
modperl_handler_t **handlers;
- MpAV *av;
+ modperl_interp_t *interp = NULL;
+ MpAV *av = NULL;
int i, status = OK;
const char *desc = NULL;
- if (type == MP_HANDLER_TYPE_DIR) {
- MP_dDCFG;
+ switch (type) {
+ case MP_HANDLER_TYPE_DIR:
av = dcfg->handlers[idx];
MP_TRACE_a_do(desc = modperl_per_dir_handler_desc(idx));
- }
- else {
+ break;
+ case MP_HANDLER_TYPE_SRV:
av = scfg->handlers[idx];
MP_TRACE_a_do(desc = modperl_per_srv_handler_desc(idx));
- }
+ break;
+ case MP_HANDLER_TYPE_CONN:
+ av = scfg->connection_cfg->handlers[idx];
+ MP_TRACE_a_do(desc = modperl_connection_handler_desc(idx));
+ break;
+ case MP_HANDLER_TYPE_FILE:
+ av = scfg->files_cfg->handlers[idx];
+ MP_TRACE_a_do(desc = modperl_files_handler_desc(idx));
+ break;
+ case MP_HANDLER_TYPE_PROC:
+ av = scfg->process_cfg->handlers[idx];
+ MP_TRACE_a_do(desc = modperl_process_handler_desc(idx));
+ break;
+ };
if (!av) {
MP_TRACE_h(MP_FUNC, "no %s handlers configured (%s)\n",
@@ -307,19 +330,13 @@
return DECLINED;
}
- if (r) {
- MP_dRCFG;
- if (!rcfg) {
- rcfg = modperl_request_config_new(r);
- ap_set_module_config(r->request_config, &perl_module, rcfg);
- }
#ifdef USE_ITHREADS
- aTHX = rcfg->interp->perl;
-#endif
+ if (r || c) {
+ interp = modperl_interp_select(r, c, s);
+ aTHX = interp->perl;
}
-#ifdef USE_ITHREADS
else {
- /* Child{Init,Exit} */
+ /* Child{Init,Exit}, OpenLogs */
aTHX = scfg->mip->parent->perl;
}
#endif
@@ -334,31 +351,42 @@
handlers[i]->name, status);
}
+#ifdef USE_ITHREADS
+ if (interp && MpInterpPUTBACK_On(interp)) {
+ /* XXX: might want to put interp back into available pool
+ * rather than have it marked as in_use for the lifetime of
+ * a request
+ */
+ }
+#endif
+
return status;
}
int modperl_per_dir_callback(int idx, request_rec *r)
{
- return modperl_run_handlers(idx, r, r->server, MP_HANDLER_TYPE_DIR);
+ return modperl_run_handlers(idx, r, NULL, r->server, MP_HANDLER_TYPE_DIR);
}
int modperl_per_srv_callback(int idx, request_rec *r)
{
- return modperl_run_handlers(idx, r, r->server, MP_HANDLER_TYPE_SRV);
+ return modperl_run_handlers(idx, r, NULL, r->server, MP_HANDLER_TYPE_SRV);
}
int modperl_connection_callback(int idx, conn_rec *c)
{
- return modperl_run_handlers(idx, NULL, c->base_server,
- MP_HANDLER_TYPE_SRV);
+ return modperl_run_handlers(idx, NULL, c, c->base_server,
+ MP_HANDLER_TYPE_CONN);
}
void modperl_process_callback(int idx, ap_pool_t *p, server_rec *s)
{
+ modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_PROC);
}
void modperl_files_callback(int idx,
ap_pool_t *pconf, ap_pool_t *plog,
ap_pool_t *ptemp, server_rec *s)
{
+ modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_FILE);
}
1.4 +1 -1 modperl-2.0/src/modules/perl/modperl_callback.h
Index: modperl_callback.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_callback.h 2000/04/18 22:59:15 1.3
+++ modperl_callback.h 2000/04/27 21:42:25 1.4
@@ -10,7 +10,7 @@
int modperl_handler_lookup(pTHX_ modperl_handler_t *handler,
char *class, char *name);
-void modperl_handler_unparse(pTHX_ modperl_handler_t *handler);
+void modperl_handler_unparse(modperl_handler_t *handler);
int modperl_handler_parse(pTHX_ modperl_handler_t *handler);
1.9 +16 -6 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_config.c 2000/04/21 05:25:31 1.8
+++ modperl_config.c 2000/04/27 21:42:25 1.9
@@ -43,11 +43,6 @@
modperl_request_config_t *rcfg =
(modperl_request_config_t *)ap_pcalloc(r->pool, sizeof(*rcfg));
-#ifdef USE_ITHREADS
- rcfg->interp = modperl_interp_select(r);
- PERL_SET_INTERP(rcfg->interp->perl);
-#endif
-
MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)rcfg);
return rcfg;
@@ -59,11 +54,26 @@
modperl_srv_config_t *modperl_srv_config_new(ap_pool_t *p)
{
modperl_srv_config_t *scfg = (modperl_srv_config_t *)
- ap_pcalloc(p, sizeof(modperl_srv_config_t));
+ ap_pcalloc(p, sizeof(*scfg));
scfg->argv = ap_make_array(p, 2, sizeof(char *));
scfg_push_argv((char *)ap_server_argv0);
+
+#ifdef MP_CONNECTION_NUM_HANDLERS
+ scfg->connection_cfg = (modperl_connection_config_t *)
+ ap_pcalloc(p, sizeof(*scfg->connection_cfg));
+#endif
+
+#ifdef MP_FILES_NUM_HANDLERS
+ scfg->files_cfg = (modperl_files_config_t *)
+ ap_pcalloc(p, sizeof(*scfg->files_cfg));
+#endif
+
+#ifdef MP_PROCESS_NUM_HANDLERS
+ scfg->process_cfg = (modperl_process_config_t *)
+ ap_pcalloc(p, sizeof(*scfg->process_cfg));
+#endif
MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)scfg);
1.9 +2 -2 modperl-2.0/src/modules/perl/modperl_config.h
Index: modperl_config.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_config.h 2000/04/21 05:25:31 1.8
+++ modperl_config.h 2000/04/27 21:42:25 1.9
@@ -47,8 +47,8 @@
#define MP_dDCFG \
modperl_dir_config_t *dcfg = \
- (modperl_dir_config_t *) \
- ap_get_module_config(r->per_dir_config, &perl_module)
+ (r ? (modperl_dir_config_t *) \
+ ap_get_module_config(r->per_dir_config, &perl_module) : NULL)
#define MP_dSCFG(s) \
modperl_srv_config_t *scfg = \
1.9 +72 -5 modperl-2.0/src/modules/perl/modperl_interp.c
Index: modperl_interp.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_interp.c 2000/04/21 05:25:31 1.8
+++ modperl_interp.c 2000/04/27 21:42:25 1.9
@@ -110,7 +110,6 @@
(unsigned long)pthread_self());
#endif
MpInterpIN_USE_On(interp);
- MpInterpPUTBACK_On(interp);
mip->in_use++;
break;
}
@@ -121,6 +120,13 @@
}
}
+ /* XXX: this should never happen */
+ if (!interp) {
+ MP_TRACE_i(MP_FUNC, "PANIC: no interpreter found, %d of %d in use\n",
+ mip->in_use, mip->size);
+ abort();
+ }
+
MUTEX_UNLOCK(&mip->mip_lock);
return interp;
@@ -282,13 +288,74 @@
return APR_SUCCESS;
}
+
+/* XXX:
+ * interp is marked as in_use for the lifetime of the pool it is
+ * stashed in. this is done to avoid the mip->mip_lock whenever
+ * possible. neither approach is ideal.
+ */
+#define MP_INTERP_KEY "MODPERL_INTERP"
-modperl_interp_t *modperl_interp_select(request_rec *r)
+modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
+ server_rec *s)
{
- modperl_interp_t *interp = modperl_interp_get(r->server);
+ modperl_interp_t *interp;
+ ap_pool_t *p = NULL;
+ const char *desc = NULL;
+
+ if (c) {
+ desc = "conn_rec pool";
+ (void)ap_get_userdata((void **)&interp, MP_INTERP_KEY, c->pool);
+
+ if (interp) {
+ MP_TRACE_i(MP_FUNC,
+ "found interp 0x%lx in %s 0x%lx\n",
+ (unsigned long)interp, desc, (unsigned long)c->pool);
+ return interp;
+ }
+
+ p = c->pool;
+ }
+ else if (r) {
+ desc = "request_rec pool";
+ (void)ap_get_userdata((void **)&interp, MP_INTERP_KEY, r->pool);
+
+ if (interp) {
+ MP_TRACE_i(MP_FUNC,
+ "found interp 0x%lx in %s 0x%lx\n",
+ (unsigned long)interp, desc, (unsigned long)r->pool);
+ return interp;
+ }
+
+ /* might have already been set by a ConnectionHandler */
+ (void)ap_get_userdata((void **)&interp, MP_INTERP_KEY,
+ r->connection->pool);
+ if (interp) {
+ desc = "r->connection pool";
+ MP_TRACE_i(MP_FUNC,
+ "found interp 0x%lx in %s 0x%lx\n",
+ (unsigned long)interp, desc,
+ (unsigned long)r->connection->pool);
+ return interp;
+ }
+
+ p = r->pool;
+ }
+
+ if (!p) {
+ /* should never happen */
+ MP_TRACE_i(MP_FUNC, "no pool\n");
+ return NULL;
+ }
+
+ interp = modperl_interp_get(s ? s : r->server);
+
+ (void)ap_set_userdata((void *)interp, MP_INTERP_KEY,
+ modperl_interp_unselect,
+ p);
- ap_register_cleanup(r->pool, (void*)interp,
- modperl_interp_unselect, ap_null_cleanup);
+ MP_TRACE_i(MP_FUNC, "set interp 0x%lx in %s 0x%lx\n",
+ (unsigned long)interp, desc, (unsigned long)p);
return interp;
}
1.6 +2 -1 modperl-2.0/src/modules/perl/modperl_interp.h
Index: modperl_interp.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_interp.h 2000/04/21 05:25:31 1.5
+++ modperl_interp.h 2000/04/27 21:42:25 1.6
@@ -18,7 +18,8 @@
ap_status_t modperl_interp_unselect(void *data);
-modperl_interp_t *modperl_interp_select(request_rec *r);
+modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
+ server_rec *s);
ap_status_t modperl_interp_pool_destroy(void *data);
1.10 +1 -3 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- modperl_types.h 2000/04/21 05:25:31 1.9
+++ modperl_types.h 2000/04/27 21:42:25 1.10
@@ -73,6 +73,7 @@
MpAV *PassEnv;
MpAV *PerlRequire, *PerlModule;
MpAV *handlers[MP_PER_SRV_NUM_HANDLERS];
+ modperl_files_config_t *files_cfg;
modperl_process_config_t *process_cfg;
modperl_connection_config_t *connection_cfg;
#ifdef USE_ITHREADS
@@ -98,9 +99,6 @@
} modperl_dir_config_t;
typedef struct {
-#ifdef USE_ITHREADS
- modperl_interp_t *interp;
-#endif
HV *pnotes;
} modperl_request_config_t;
