I'll post later a better patch. That one was just a proof of concept.
Ok, so here is a proper patch for modperl_cmd.c. Please try it (attached as well), it's a bit different from the previous one. Plus added some macros to make the code more readable.
I should add another test that dies if it finds TestVhost::basic loaded by the main server. Which is the case now and it's broken due to a problem with Apache->server as I've explained in the other thread.
Index: src/modules/perl/modperl_cmd.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v retrieving revision 1.52 diff -u -r1.52 modperl_cmd.c --- src/modules/perl/modperl_cmd.c 19 Dec 2003 01:17:31 -0000 1.52 +++ src/modules/perl/modperl_cmd.c 22 Jan 2004 10:47:13 -0000 @@ -1,5 +1,28 @@ #include "mod_perl.h"
+#ifdef USE_ITHREADS
+
+#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 +128,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,22 +137,23 @@
} 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);
}
- }
- else {
- MP_TRACE_d(MP_FUNC, "push PerlModule %s\n", arg);
- *(const char **)apr_array_push(scfg->PerlModule) = arg;
+ MP_PERL_RESTORE_CONTEXT;
+
+ return error;
}+ MP_TRACE_d(MP_FUNC, "push PerlModule %s\n", arg);
+ *(const char **)apr_array_push(scfg->PerlModule) = arg;
return NULL;
+
} MP_CMD_SRV_DECLARE(requires)
@@ -372,9 +397,9 @@
int dollar_zero_tainted;
#ifdef USE_ITHREADS
MP_dSCFG(s);
- pTHX;
+ MP_PERL_DECLARE_CONTEXT;
#endif
-
+
if (!(arg && *arg)) {
return NULL;
}
@@ -386,10 +411,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 +465,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 +497,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 +542,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;
__________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
Index: src/modules/perl/modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.52
diff -u -r1.52 modperl_cmd.c
--- src/modules/perl/modperl_cmd.c 19 Dec 2003 01:17:31 -0000 1.52
+++ src/modules/perl/modperl_cmd.c 22 Jan 2004 10:47:13 -0000
@@ -1,5 +1,28 @@
#include "mod_perl.h"
+#ifdef USE_ITHREADS
+
+#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 +128,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,22 +137,23 @@
}
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);
}
- }
- else {
- MP_TRACE_d(MP_FUNC, "push PerlModule %s\n", arg);
- *(const char **)apr_array_push(scfg->PerlModule) = arg;
+ MP_PERL_RESTORE_CONTEXT;
+
+ return error;
}
+ MP_TRACE_d(MP_FUNC, "push PerlModule %s\n", arg);
+ *(const char **)apr_array_push(scfg->PerlModule) = arg;
return NULL;
+
}
MP_CMD_SRV_DECLARE(requires)
@@ -372,9 +397,9 @@
int dollar_zero_tainted;
#ifdef USE_ITHREADS
MP_dSCFG(s);
- pTHX;
+ MP_PERL_DECLARE_CONTEXT;
#endif
-
+
if (!(arg && *arg)) {
return NULL;
}
@@ -386,10 +411,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 +465,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 +497,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 +542,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;--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
