dougm 00/06/12 12:37:28
Modified: lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_callback.c
Log:
allow vhosts to disable mod_perl
Revision Changes Path
1.29 +9 -4 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.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- Code.pm 2000/06/12 04:41:09 1.28
+++ Code.pm 2000/06/12 19:37:25 1.29
@@ -45,11 +45,11 @@
$hook_proto{PerDir} = $hook_proto{PerSrv};
-my $dcfg_get =
- 'modperl_dir_config_t *dcfg = (modperl_dir_config_t *)dummy';
-
my $scfg_get = 'MP_dSCFG(parms->server)';
+my $dcfg_get = "$scfg_get;\n" .
+ 'modperl_dir_config_t *dcfg = (modperl_dir_config_t *)dummy';
+
my %directive_proto = (
PerSrv => {
args => [{type => 'cmd_parms', name => 'parms'},
@@ -83,7 +83,7 @@
my %flags = (
Srv => [qw(NONE PERL_TAINT_CHECK PERL_WARN FRESH_RESTART
- PERL_CLONE PERL_ALLOC UNSET)],
+ PERL_CLONE PERL_ALLOC PERL_OFF UNSET)],
Dir => [qw(NONE INCPUSH SENDHDR SENTHDR ENV CLEANUP RCLEANUP)],
Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
Handler => [qw(NONE PARSED METHOD OBJECT ANON)],
@@ -223,6 +223,11 @@
$protostr
{
$prototype->{cfg}->{get};
+ if (MpSrvPERL_OFF(scfg)) {
+ return ap_pstrcat(parms->pool,
+ "Perl is disabled for server ",
+ parms->server->server_hostname, NULL);
+ }
MP_TRACE_d(MP_FUNC, "push \@%s, %s\\n", parms->cmd->name, arg);
return modperl_cmd_push_handlers(&($av), arg, parms->pool);
}
1.17 +16 -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.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- mod_perl.c 2000/06/12 18:20:55 1.16
+++ mod_perl.c 2000/06/12 19:37:26 1.17
@@ -48,8 +48,14 @@
modperl_srv_config_t *base_scfg =
(modperl_srv_config_t *)
ap_get_module_config(base_server->module_config, &perl_module);
- PerlInterpreter *base_perl = modperl_startup(base_server, p);
+ PerlInterpreter *base_perl;
+ if (MpSrvPERL_OFF(base_scfg)) {
+ /* how silly */
+ return;
+ }
+
+ base_perl = modperl_startup(base_server, p);
modperl_interp_init(base_server, p, base_perl);
MpInterpBASE_On(base_scfg->mip->parent);
@@ -61,12 +67,16 @@
/* XXX: using getenv() just for testing here */
char *do_alloc = getenv("MP_SRV_ALLOC_TEST");
char *do_clone = getenv("MP_SRV_CLONE_TEST");
+ char *do_off = getenv("MP_SRV_OFF_TEST");
if (do_alloc && strEQ(do_alloc, s->server_hostname)) {
MpSrvPERL_ALLOC_On(scfg);
}
if (do_clone && strEQ(do_clone, s->server_hostname)) {
MpSrvPERL_CLONE_On(scfg);
}
+ if (do_off && strEQ(do_off, s->server_hostname)) {
+ MpSrvPERL_OFF_On(scfg);
+ }
}
/* if alloc flags is On, virtual host gets its own parent perl */
@@ -74,6 +84,11 @@
perl = modperl_startup(s, p);
MP_TRACE_i(MP_FUNC, "modperl_startup() server=%s\n",
s->server_hostname);
+ }
+
+ if (MpSrvPERL_OFF(scfg)) {
+ scfg->mip = NULL;
+ continue;
}
#ifdef USE_ITHREADS
1.11 +6 -0 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.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- modperl_callback.c 2000/05/26 20:34:49 1.10
+++ modperl_callback.c 2000/06/12 19:37:27 1.11
@@ -316,6 +316,12 @@
int i, status = OK;
const char *desc = NULL;
+ if (MpSrvPERL_OFF(scfg)) {
+ MP_TRACE_h(MP_FUNC, "PerlOff for server %s\n",
+ s->server_hostname);
+ return DECLINED;
+ }
+
switch (type) {
case MP_HANDLER_TYPE_DIR:
av = dcfg->handlers[idx];
