stas 2004/01/22 13:55:50
Modified: src/modules/perl modperl_cmd.c
. Changes
Added: t/htdocs/vhost startup.pl
t/vhost config.t
t/response/TestVhost config.pm
Log:
fix context problems in <perl> sections and
PerlModule/PerlLoadModule/PerlRequre under threaded mpms w/
PerlOptions +Parent/+Clone in Vhosts + TestVhost::config test.
Revision Changes Path
1.53 +65 -24 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -u -r1.52 -r1.53
--- modperl_cmd.c 19 Dec 2003 01:17:31 -0000 1.52
+++ modperl_cmd.c 22 Jan 2004 21:55:49 -0000 1.53
@@ -1,5 +1,41 @@
#include "mod_perl.h"
+#ifdef USE_ITHREADS
+
+/*
+ * perl context overriding and restoration is required when
+ * PerlOptions +Parent/+Clone is used in vhosts, and perl is used to
+ * at the server startup. So that <Perl> sections, PerlLoadModule,
+ * PerlModule and PerlRequire are all run using the right perl context
+ * and restore to the original context when they are done.
+ *
+ * As of perl-5.8.3 it's unfortunate that it uses PERL_GET_CONTEXT and
+ * doesn't rely on the passed pTHX internally. When and if perl is
+ * fixed to always use pTHX if available, this context switching mess
+ * can be removed.
+ */
+
+#define MP_PERL_DECLARE_CONTEXT \
+ PerlInterpreter *orig_perl; \
+ pTHX;
+
+/* XXX: .htaccess support cannot use this perl with threaded MPMs */
+#define MP_PERL_OVERRIDE_CONTEXT \
+ orig_perl = PERL_GET_CONTEXT; \
+ aTHX = scfg->mip->parent->perl; \
+ PERL_SET_CONTEXT(aTHX);
+
+#define MP_PERL_RESTORE_CONTEXT \
+ PERL_SET_CONTEXT(orig_perl);
+
+#else
+
+#define MP_PERL_DECLARE_CONTEXT
+#define MP_PERL_OVERRIDE_CONTEXT
+#define MP_PERL_RESTORE_CONTEXT
+
+#endif
+
static char *modperl_cmd_unclosed_directive(cmd_parms *parms)
{
return apr_pstrcat(parms->pool, parms->cmd->name,
@@ -105,6 +141,7 @@
MP_CMD_SRV_DECLARE(modules)
{
MP_dSCFG(parms->server);
+ MP_PERL_DECLARE_CONTEXT;
if (modperl_is_running() &&
modperl_init_vhost(parms->server, parms->pool, NULL) != OK)
@@ -113,27 +150,29 @@
}
if (modperl_is_running()) {
-#ifdef USE_ITHREADS
- /* XXX: .htaccess support cannot use this perl with threaded MPMs */
- dTHXa(scfg->mip->parent->perl);
-#endif
- MP_TRACE_d(MP_FUNC, "load PerlModule %s\n", arg);
+ char *error = NULL;
+ MP_TRACE_d(MP_FUNC, "load PerlModule %s\n", arg);
+
+ MP_PERL_OVERRIDE_CONTEXT;
if (!modperl_require_module(aTHX_ arg, FALSE)) {
- return SvPVX(ERRSV);
+ error = SvPVX(ERRSV);
}
+ MP_PERL_RESTORE_CONTEXT;
+
+ return error;
}
else {
MP_TRACE_d(MP_FUNC, "push PerlModule %s\n", arg);
*(const char **)apr_array_push(scfg->PerlModule) = arg;
+ return NULL;
}
-
- return NULL;
}
MP_CMD_SRV_DECLARE(requires)
{
MP_dSCFG(parms->server);
+ MP_PERL_DECLARE_CONTEXT;
if (modperl_is_running() &&
modperl_init_vhost(parms->server, parms->pool, NULL) != OK)
@@ -142,23 +181,23 @@
}
if (modperl_is_running()) {
-#ifdef USE_ITHREADS
- /* XXX: .htaccess support cannot use this perl with threaded MPMs */
- dTHXa(scfg->mip->parent->perl);
-#endif
+ char *error = NULL;
MP_TRACE_d(MP_FUNC, "load PerlRequire %s\n", arg);
+ MP_PERL_OVERRIDE_CONTEXT;
if (!modperl_require_file(aTHX_ arg, FALSE)) {
- return SvPVX(ERRSV);
+ error = SvPVX(ERRSV);
}
+ MP_PERL_RESTORE_CONTEXT;
+
+ return error;
}
else {
MP_TRACE_d(MP_FUNC, "push PerlRequire %s\n", arg);
*(const char **)apr_array_push(scfg->PerlRequire) = arg;
+ return NULL;
}
-
- return NULL;
}
static MP_CMD_SRV_DECLARE2(handle_vars)
@@ -332,7 +371,7 @@
/*XXX: Less than optimal */
code = apr_pstrcat(p, code, line, "\n", NULL);
}
-
+
/* Here, we have to replace our current config node for the next pass */
if (!*current) {
*current = apr_pcalloc(p, sizeof(**current));
@@ -372,7 +411,7 @@
int dollar_zero_tainted;
#ifdef USE_ITHREADS
MP_dSCFG(s);
- pTHX;
+ MP_PERL_DECLARE_CONTEXT;
#endif
if (!(arg && *arg)) {
@@ -386,10 +425,7 @@
return "init mod_perl vhost failed";
}
-#ifdef USE_ITHREADS
- /* XXX: .htaccess support cannot use this perl with threaded MPMs */
- aTHX = scfg->mip->parent->perl;
-#endif
+ MP_PERL_OVERRIDE_CONTEXT;
/* data will be set by a <Perl> section */
if ((options = parms->directive->data)) {
@@ -443,7 +479,9 @@
if (SvTRUE(ERRSV)) {
SV *strict;
if ((strict = MP_STRICT_PERLSECTIONS_SV) && SvTRUE(strict)) {
- return SvPVX(ERRSV);
+ char *error = SvPVX(ERRSV);
+ MP_PERL_RESTORE_CONTEXT;
+ return error;
}
else {
modperl_log_warn(s, apr_psprintf(p, "Syntax error at %s:%d %s",
@@ -473,12 +511,15 @@
}
if (status != OK) {
- return SvTRUE(ERRSV) ? SvPVX(ERRSV) :
+ char *error = SvTRUE(ERRSV) ? SvPVX(ERRSV) :
apr_psprintf(p, "<Perl> handler %s failed with status=%d",
handler->name, status);
+ MP_PERL_RESTORE_CONTEXT;
+ return error;
}
}
+ MP_PERL_RESTORE_CONTEXT;
return NULL;
}
@@ -515,7 +556,7 @@
char line[MAX_STRING_LEN];
while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) {
- /* soak up rest of the file */
+ /* soak up rest of the file */
}
return NULL;
1.1 modperl-2.0/t/htdocs/vhost/startup.pl
Index: startup.pl
===================================================================
use warnings;
use strict;
use Apache2;
use Apache::ServerUtil ();
use Apache::Server ();
use File::Spec::Functions qw(catdir);
# base server
# XXX: at the moment this is wrong, since it return the base server $s and not the
vhost's one. needs to be fixed.
my $s = Apache->server;
my $vhost_doc_root = catdir Apache::Server::server_root, qw(htdocs vhost);
# testing $s->add_config() in vhost
my $conf = <<"EOC";
# must use PerlModule here to check for segfaults
# and that the module is loaded by vhost
PerlModule TestVhost::config
PerlSetVar DocumentRootCheck $vhost_doc_root
<Location /TestVhost__config>
SetHandler modperl
PerlResponseHandler TestVhost::config::my_handler
</Location>
EOC
$s->add_config([split /\n/, $conf]);
# this used to have problems on win32
$s->add_config(['<Perl >', '1;', '</Perl>']);
1;
1.1 modperl-2.0/t/vhost/config.t
Index: config.t
===================================================================
# the handler is configured in modperl_extra.pl via
# Apache->server->add_config
use Apache::TestUtil;
use Apache::TestRequest 'GET';
my $config = Apache::Test::config();
my $vars = $config->{vars};
my $module = 'TestVhost::config';
my $path = Apache::TestRequest::module2path($module);
Apache::TestRequest::module($module);
my $hostport = Apache::TestRequest::hostport($config);
t_debug("connecting to $hostport");
my $res = GET "http://$hostport/$path";;
if ($res->is_success) {
print $res->content;
}
else {
if ($res->code == 404) {
my $documentroot = $vars->{documentroot};
die "this test gets its <Location> configuration added via " .
"$documentroot/vhost/startup.pl, this could be the cause " .
"of the failure";
}
else {
die "server side has failed (response code: ", $res->code, "),\n",
"see t/logs/error_log for more details\n";
}
}
1.1 modperl-2.0/t/response/TestVhost/config.pm
Index: config.pm
===================================================================
package TestVhost::config;
# Test whether under threaded mpms (and not) a vhost with 'PerlOptions
# +Parent', can run <Perl> sections, which call into config again via
# add_config().
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::RequestUtil ();
use APR::Table ();
use File::Spec::Functions qw(catdir);
use Apache::Const -compile => 'OK';
# using a different from 'handler' name on purpose, to make sure
# that the module is preloaded at the server startup
sub my_handler {
my $r = shift;
plan $r, tests => 1;
{
my $expected = $r->document_root;
my $received = $r->dir_config->get('DocumentRootCheck');
ok t_cmp($expected, $received, "DocumentRoot");
}
Apache::OK;
}
1;
__END__
<NoAutoConfig>
<VirtualHost TestVhost::config>
DocumentRoot @documentroot@/vhost
<IfDefine PERL_USEITHREADS>
# a new interpreter pool
PerlOptions +Parent
</IfDefine>
# use test system's @INC
PerlSwitches [EMAIL PROTECTED]@
# mp2 modules
PerlRequire "@serverroot@/conf/modperl_inc.pl"
# private to this vhost stuff
PerlRequire "@documentroot@/vhost/startup.pl"
# <Location /TestVhost__config> container is added via add_config
# in t/htdocs/vhost/startup.pl
</VirtualHost>
</NoAutoConfig>
1.307 +4 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.306
retrieving revision 1.307
diff -u -u -r1.306 -r1.307
--- Changes 19 Jan 2004 20:00:17 -0000 1.306
+++ Changes 22 Jan 2004 21:55:50 -0000 1.307
@@ -12,6 +12,10 @@
=item 1.99_13-dev
+fix context problems in <perl> sections and
+PerlModule/PerlLoadModule/PerlRequre under threaded mpms w/
+PerlOptions +Parent/+Clone in Vhosts + TestVhost::config test. [Stas]
+
moved many functions out of the Apache:: namespace:
Apache::unescape_url() is now Apache::URI::unescape_url()
Apache::log_pid() is now Apache::Log::log_pid()
