dougm 00/06/11 20:30:59
Modified: lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_config.c
modperl_interp.c
Log:
allow VirtualHosts to have their own PerlInterpreter and/or mip
Revision Changes Path
1.27 +3 -2 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.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- Code.pm 2000/06/09 04:30:42 1.26
+++ Code.pm 2000/06/12 03:30:50 1.27
@@ -82,9 +82,10 @@
}
my %flags = (
- Srv => [qw(NONE PERL_TAINT_CHECK PERL_WARN FRESH_RESTART)],
+ Srv => [qw(NONE PERL_TAINT_CHECK PERL_WARN FRESH_RESTART
+ PERL_CLONE PERL_ALLOC)],
Dir => [qw(NONE INCPUSH SENDHDR SENTHDR ENV CLEANUP RCLEANUP)],
- Interp => [qw(NONE IN_USE PUTBACK CLONED)],
+ Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
Handler => [qw(NONE PARSED METHOD OBJECT ANON)],
);
1.15 +51 -3 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.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- mod_perl.c 2000/05/23 20:54:44 1.14
+++ mod_perl.c 2000/06/12 03:30:51 1.15
@@ -1,6 +1,6 @@
#include "mod_perl.h"
-void modperl_startup(server_rec *s, ap_pool_t *p)
+PerlInterpreter *modperl_startup(server_rec *s, ap_pool_t *p)
{
MP_dSCFG(s);
PerlInterpreter *perl;
@@ -39,12 +39,60 @@
);
#endif
- modperl_interp_init(s, p, perl);
+ return perl;
}
void modperl_init(server_rec *s, ap_pool_t *p)
{
- modperl_startup(s, p);
+ server_rec *base_server = s;
+ server_rec *srvp;
+ PerlInterpreter *base_perl = modperl_startup(base_server, p);
+ modperl_interp_init(base_server, p, base_perl);
+
+ {
+ MP_dSCFG(base_server);
+ MpInterpBASE_On(scfg->mip->parent);
+ }
+
+ for (srvp=base_server->next; srvp; srvp=srvp->next) {
+ MP_dSCFG(srvp);
+ PerlInterpreter *perl = base_perl;
+
+ if (1) {
+ /* XXX: using getenv() just for testing here */
+ char *do_alloc = getenv("MP_SRV_ALLOC_TEST");
+ char *do_clone = getenv("MP_SRV_CLONE_TEST");
+ if (do_alloc && strEQ(do_alloc, srvp->server_hostname)) {
+ MpSrvPERL_ALLOC_On(scfg);
+ }
+ if (do_clone && strEQ(do_clone, srvp->server_hostname)) {
+ MpSrvPERL_CLONE_On(scfg);
+ }
+ }
+
+ /* if alloc flags is On, virtual host gets its own parent perl */
+ if (MpSrvPERL_ALLOC(scfg)) {
+ perl = modperl_startup(srvp, p);
+ MP_TRACE_i(MP_FUNC, "modperl_startup() server=%s\n",
+ srvp->server_hostname);
+ }
+
+#ifdef USE_ITHREADS
+ /* if alloc flags is On or clone flag is On,
+ * virtual host gets its own mip
+ */
+ if (MpSrvPERL_ALLOC(scfg) || MpSrvPERL_CLONE(scfg)) {
+ MP_TRACE_i(MP_FUNC, "modperl_interp_init() server=%s\n",
+ srvp->server_hostname);
+ modperl_interp_init(srvp, p, perl);
+ }
+
+ /* if we allocated a parent perl, mark it to be destroyed */
+ if (MpSrvPERL_ALLOC(scfg)) {
+ MpInterpBASE_On(scfg->mip->parent);
+ }
+#endif
+ }
}
void modperl_hook_init(ap_pool_t *pconf, ap_pool_t *plog,
1.11 +20 -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.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- modperl_config.c 2000/05/23 20:54:44 1.10
+++ modperl_config.c 2000/06/12 03:30:52 1.11
@@ -136,19 +136,36 @@
#define merge_item(item) \
mrg->item = add->item ? add->item : base->item
+/* XXX: this is not complete */
void *modperl_merge_srv_config(ap_pool_t *p, void *basev, void *addv)
{
-#if 0
modperl_srv_config_t
*base = (modperl_srv_config_t *)basev,
*add = (modperl_srv_config_t *)addv,
*mrg = modperl_srv_config_new(p);
-#endif
MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
(unsigned long)basev, (unsigned long)addv);
+
+#ifdef USE_ITHREADS
+ merge_item(mip);
+ merge_item(interp_pool_cfg);
+#else
+ merge_item(perl);
+#endif
- return addv;
+ merge_item(files_cfg);
+ merge_item(process_cfg);
+ merge_item(connection_cfg);
+
+ { /* XXX: should do a proper merge of the arrays */
+ int i;
+ for (i=0; i<MP_PER_SRV_NUM_HANDLERS; i++) {
+ merge_item(handlers[i]);
+ }
+ }
+
+ return mrg;
}
#define MP_CONFIG_BOOTSTRAP(parms) \
@@ -174,7 +191,6 @@
MP_DECLARE_SRV_CMD(switches)
{
MP_dSCFG(parms->server);
- MP_SRV_CMD_CHECK;
scfg_push_argv(arg);
return NULL;
}
@@ -187,8 +203,6 @@
{ \
MP_dSCFG(parms->server); \
int item = atoi(arg); \
- const char *err = ap_check_cmd_context(parms, GLOBAL_ONLY); \
- if (err) return err; \
scfg->interp_pool_cfg->##item = item; \
MP_TRACE_d(MP_FUNC, "%s %d\n", parms->cmd->name, item); \
return NULL; \
1.15 +9 -3 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.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- modperl_interp.c 2000/05/28 01:44:47 1.14
+++ modperl_interp.c 2000/06/12 03:30:56 1.15
@@ -106,10 +106,16 @@
modperl_tipool_destroy(mip->tipool);
mip->tipool = NULL;
- MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
- (unsigned long)mip->parent);
+ if (MpInterpBASE(mip->parent)) {
+ /* multiple mips might share the same parent
+ * make sure its only destroyed once
+ */
+ MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
+ (unsigned long)mip->parent);
- modperl_interp_destroy(mip->parent);
+ modperl_interp_destroy(mip->parent);
+ }
+
mip->parent->perl = NULL;
return APR_SUCCESS;
