Stas Bekman wrote:
Steve Hay wrote:
Stas Bekman wrote:
Steve, Randy, can you please try with this patch. This is against the conf file with:
<VirtualHost _default_:8542> PerlOptions +Parent <Perl> 1; </Perl> </Virtualhost>
The Good News: The patch below fixes *both* of the short conf files that we've been playing with. Running "apache.exe -t ..." was previously enough to produce the crash; now I can even start the server up (i.e. without the "-t" option) without error.
Great. So it was a wrong context issue after all.
Could you try remove the last chunk of this patch. i.e. remove the part that 'restore the original perl context; and see if it still works.
With the last hunk of the patch removed, the short conf file with the <Perl> section does still work with Apache's "-t" option, but the server won't start up without it: It produces an access violation via the usual bit of "free to wrong pool" code (although I didn't actually see the message in the console this time).
So the whole patch is required.
OK, thanks for testing, Steve.
The Bad News: The vhost test that originally didn't work way back at the start of this thread (excuse the pun) still doesn't work.
heh, I forgot what was the original one ;)
It's been a long hard slog, hasn't it?
;)
can't you pin-point which part of that patch causes the problem? I assume the problem is the same, right?
It is indeed the usual problem. I'll try produce another shortened .conf file which reproduces the bug that's still lurking. Oh joy.
The problem is that it doesn't bite you on unix, so I have to run a state machine in my head moving through the code and try to make sure that the context is right. (i'm sure you remember my woes about this unneeded context thing to p5p). So about a month ago I just tried to add these contextes everywhere we have redefined THX. I'm not sure it'll do any good, but try this patch against the current cvs (i'm not sure if your compiler will agree with // comments, but this is just some work in the middle, i may try to clean it up if you think it will do some good)
--- src/modules/perl/mod_perl.c 10 Jan 2004 05:01:04 -0000 1.206 +++ src/modules/perl/mod_perl.c 21 Jan 2004 09:56:02 -0000 @@ -107,7 +107,10 @@
static void set_taint_var(PerlInterpreter *perl)
{
- dTHXa(perl);
+#ifdef USE_ITHREADS
+ pTHX;
+ PERL_SET_CONTEXT(aTHX = perl);
+#endif /* 5.7.3+ has a built-in special ${^TAINT}, backport it to 5.6.0+ */
#if PERL_REVISION == 5 && \
@@ -186,7 +189,7 @@
}#ifdef USE_ITHREADS - aTHX = perl; + PERL_SET_CONTEXT(aTHX = perl); #endif
perl_construct(perl);
@@ -561,9 +564,9 @@
{
#ifdef USE_ITHREADS
MP_dSCFG(s);
- dTHXa(scfg->mip->parent->perl);
+ MP_dSCFG_dTHX;
#endif
-
+
#ifdef MP_TRACE
/* httpd core open_logs handler re-opens s->error_log, which might
* change, even though it still points to the same physical file
@@ -861,7 +864,7 @@ #ifdef USE_ITHREADS
interp = modperl_interp_select(r, r->connection, r->server);
- aTHX = interp->perl;
+ PERL_SET_CONTEXT(aTHX = interp->perl);
if (MpInterpPUTBACK(interp)) {
rcfg->interp = interp;
}
Index: src/modules/perl/modperl_callback.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.65
diff -u -r1.65 modperl_callback.c
--- src/modules/perl/modperl_callback.c 9 Jan 2004 04:59:18 -0000 1.65
+++ src/modules/perl/modperl_callback.c 21 Jan 2004 09:56:02 -0000
@@ -165,6 +165,7 @@
if (r || c) {
interp = modperl_interp_select(r, c, s);
aTHX = interp->perl;
+ //PERL_SET_CONTEXT(aTHX);
}
else {
/* Child{Init,Exit}, OpenLogs */
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 21 Jan 2004 09:56:02 -0000
@@ -254,6 +254,8 @@
apr_pool_t *p = parms->pool;
const char *error;+ MP_TRACE_d(MP_FUNC, "%s:%d", parms->directive->filename,
+ parms->directive->line_num);
MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
if ((error = modperl_options_set(p, opts, arg)) && !is_per_dir) {
/* maybe a per-directory option outside of a container */
@@ -380,8 +382,16 @@
} /* we must init earlier than normal */
- modperl_run();
-
+ if (!modperl_is_running()) {
+ /* preload Apache::PerlSections in the case when <Perl>
+ * triggers a server startup */
+ MP_TRACE_d(MP_FUNC, "push PerlModule %s\n",
+ MP_DEFAULT_PERLSECTION_HANDLER);
+ //*(const char **)apr_array_push(scfg->PerlModule) =
+ // MP_DEFAULT_PERLSECTION_HANDLER;
+ modperl_run();
+ }
+
if (modperl_init_vhost(s, p, NULL) != OK) {
return "init mod_perl vhost failed";
}
@@ -389,6 +399,12 @@
#ifdef USE_ITHREADS
/* XXX: .htaccess support cannot use this perl with threaded MPMs */
aTHX = scfg->mip->parent->perl;
+ //PERL_SET_CONTEXT(scfg->mip->parent->perl);
+
+ MP_TRACE_i(MP_FUNC, "perl == 0x%lx, PERL_GET_CONTEXT == 0x%lx\n",
+ (unsigned long)scfg->mip->parent->perl,
+ (unsigned long)PERL_GET_CONTEXT);
+
#endif /* data will be set by a <Perl> section */
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.74
diff -u -r1.74 modperl_config.c
--- src/modules/perl/modperl_config.c 10 Jan 2004 02:52:20 -0000 1.74
+++ src/modules/perl/modperl_config.c 21 Jan 2004 09:56:02 -0000
@@ -308,7 +308,9 @@
{
request_rec *r = (request_rec *)data;
MP_dTHX;
-
+#ifdef USE_ITHREADS
+ PERL_SET_CONTEXT(aTHX);
+#endif
return modperl_config_request_cleanup(aTHX_ r);
}@@ -328,8 +330,11 @@
{
char **entries;
int i;
+#ifdef USE_ITHREADS
dTHXa(perl);
-
+ PERL_SET_CONTEXT(aTHX);
+#endif
+
entries = (char **)scfg->PerlModule->elts;
for (i = 0; i < scfg->PerlModule->nelts; i++){
if (modperl_require_module(aTHX_ entries[i], TRUE)){
@@ -353,8 +358,11 @@
{
char **entries;
int i;
+#ifdef USE_ITHREADS
dTHXa(perl);
-
+ PERL_SET_CONTEXT(aTHX);
+#endif
+
entries = (char **)scfg->PerlRequire->elts;
for (i = 0; i < scfg->PerlRequire->nelts; i++){
if (modperl_require_file(aTHX_ entries[i], TRUE)){
@@ -381,11 +389,14 @@
static void *svav_getstr(void *buf, size_t bufsiz, void *param)
{
svav_param_t *svav_param = (svav_param_t *)param;
- dTHXa(svav_param->perl);
AV *av = svav_param->av;
SV *sv;
STRLEN n_a;
-
+#ifdef USE_ITHREADS
+ dTHXa(svav_param->perl);
+ PERL_SET_CONTEXT(aTHX);
+#endif
+
if (svav_param->ix > AvFILL(av)) {
return NULL;
}
Index: src/modules/perl/modperl_config.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.32
diff -u -r1.32 modperl_config.h
--- src/modules/perl/modperl_config.h 10 Jan 2004 02:52:20 -0000 1.32
+++ src/modules/perl/modperl_config.h 21 Jan 2004 09:56:02 -0000
@@ -91,8 +91,8 @@ /* hopefully this macro will not need to be used often */
#ifdef USE_ITHREADS
-# define MP_dTHX \
- modperl_interp_t *interp = \
+# define MP_dTHX \
+ modperl_interp_t *interp = \
modperl_interp_select(r, r->connection, r->server); \
dTHXa(interp->perl)
#else
Index: src/modules/perl/modperl_handler.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.c,v
retrieving revision 1.19
diff -u -r1.19 modperl_handler.c
--- src/modules/perl/modperl_handler.c 18 Sep 2003 07:55:52 -0000 1.19
+++ src/modules/perl/modperl_handler.c 21 Jan 2004 09:56:02 -0000
@@ -58,7 +58,7 @@
duped ? "current" : "server conf",
(unsigned long)rp);- if (!modperl_mgv_resolve(aTHX_ handler, rp, handler->name, FALSE)) {
+ if (!modperl_mgv_resolve(aTHX_ handler, rp, handler->name, TRUE)) {
ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
"failed to resolve handler `%s'",
handler->name);
Index: src/modules/perl/modperl_interp.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
retrieving revision 1.60
diff -u -r1.60 modperl_interp.c
--- src/modules/perl/modperl_interp.c 18 Oct 2003 23:45:29 -0000 1.60
+++ src/modules/perl/modperl_interp.c 21 Jan 2004 09:56:02 -0000
@@ -18,12 +18,11 @@ void modperl_interp_clone_init(modperl_interp_t *interp)
{
- dTHXa(interp->perl);
+ pTHX;
+ PERL_SET_CONTEXT(aTHX = interp->perl);MpInterpCLONED_On(interp);
- PERL_SET_CONTEXT(aTHX);
-
/* XXX: hack for bug fixed in 5.6.1 */
if (PL_scopestack_ix == 0) {
ENTER;
@@ -59,10 +58,20 @@
clone_flags |= CLONEf_CLONE_HOST;
#endif- PERL_SET_CONTEXT(perl);
-
+ //PERL_SET_CONTEXT(perl);
interp->perl = perl_clone(perl, clone_flags);
+ /* 5.8.2 sets internall the context to the parent perl so we
+ * need to restore it
+ */
+ PERL_SET_CONTEXT(interp->perl);
+
+ MP_TRACE_i(MP_FUNC, "interp->perl == 0x%lx, PERL_GET_CONTEXT == 0x%lx,"
+ " interp->mip->parent->perl == 0x%lx\n",
+ (unsigned long)interp->perl,
+ (unsigned long)PERL_GET_CONTEXT,
+ (unsigned long)interp->mip->parent->perl);+
#if PERL_REVISION == 5 && PERL_VERSION == 8 && PERL_SUBVERSION == 0 && \
defined(USE_REENTRANT_API) && defined(HAS_CRYPT_R) && defined(__GLIBC__)
{
@@ -88,14 +97,15 @@
* within modperl_svptr_table_clone.
*/
if ((clone_flags & CLONEf_KEEP_PTR_TABLE)) {
- dTHXa(interp->perl);
+ pTHX;
+ PERL_SET_CONTEXT(aTHX = interp->perl);
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
}modperl_interp_clone_init(interp);
- PERL_SET_CONTEXT(perl); + //PERL_SET_CONTEXT(perl);
#ifdef MP_USE_GTOP
MP_TRACE_m_do(
@@ -112,12 +122,17 @@
void modperl_interp_destroy(modperl_interp_t *interp)
{
void **handles;
- dTHXa(interp->perl);
-
- PERL_SET_CONTEXT(interp->perl);
+ pTHX;
+ PERL_SET_CONTEXT(aTHX = interp->perl);- MP_TRACE_i(MP_FUNC, "interp == 0x%lx\n",
- (unsigned long)interp);
+ /* this interp was created when the global PERL_GET_CONTEXT was set to
+ * its parent perl so PERL_GET_CONTEXT must be set to the same value
+ * for the destruction */
+// PERL_SET_CONTEXT(interp->mip->parent->perl);
+
+ MP_TRACE_i(MP_FUNC, "interp == 0x%lx, perl == 0x%lx, PERL_GET_CONTEXT == 0x%lx\n",
+ (unsigned long)interp, (unsigned long)interp->perl,
+ (unsigned long)PERL_GET_CONTEXT);
if (MpInterpIN_USE(interp)) {
MP_TRACE_i(MP_FUNC, "*error - still in use!*\n");
@@ -238,7 +253,7 @@ mip->server = s;
mip->parent = modperl_interp_new(mip, NULL);
- aTHX = mip->parent->perl = perl;
+ PERL_SET_CONTEXT(aTHX = mip->parent->perl = perl); /* this happens post-config in mod_perl.c:modperl_init_clones() */
/* modperl_tipool_init(tipool); */
Index: src/modules/perl/modperl_options.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_options.c,v
retrieving revision 1.10
diff -u -r1.10 modperl_options.c
--- src/modules/perl/modperl_options.c 28 Sep 2001 15:16:06 -0000 1.10
+++ src/modules/perl/modperl_options.c 21 Jan 2004 09:56:02 -0000
@@ -42,9 +42,24 @@
options->opts = options->unset =
(type == MpSrvType ? MpSrv_f_UNSET : MpDir_f_UNSET);+ MP_TRACE_d(MP_FUNC, "opts: %d", options->opts);
+
return options;
}+
+static void modperl_options_dump(modperl_options_t *o, const char *str)
+{
+ const char *type = type_lookup(o);
+ MP_TRACE_d(MP_FUNC, "option '%s', type: %s", str, type);
+ MP_TRACE_d(MP_FUNC, "opts_add %d", o->opts_add);
+ MP_TRACE_d(MP_FUNC, "opts_remove %d", o->opts_remove);
+ MP_TRACE_d(MP_FUNC, "opts_override %d", o->opts_override);
+ MP_TRACE_d(MP_FUNC, "opts_seen %d", o->opts_seen);
+ MP_TRACE_d(MP_FUNC, "unset %d\n", o->unset);
+}
+
+
const char *modperl_options_set(apr_pool_t *p, modperl_options_t *o,
const char *str)
{
@@ -56,6 +71,8 @@
action = *(str++);
}+ modperl_options_dump(o, str);
+
if (!(opt = flags_lookup(o, str))) {
error = apr_pstrcat(p, "Invalid per-", type_lookup(o),
" PerlOption: ", str, NULL);
Index: src/modules/perl/modperl_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.c,v
retrieving revision 1.20
diff -u -r1.20 modperl_perl.c
--- src/modules/perl/modperl_perl.c 3 Nov 2003 23:31:19 -0000 1.20
+++ src/modules/perl/modperl_perl.c 21 Jan 2004 09:56:02 -0000
@@ -101,10 +101,15 @@
{
char **orig_environ = NULL;
PTR_TBL_t *module_commands;
- dTHXa(perl);
-
- PERL_SET_CONTEXT(perl);
+ PerlInterpreter *parent_perl;
+#ifdef USE_ITHREADS
+ pTHX;+ PERL_SET_CONTEXT(aTHX = perl);
+#endif
+ parent_perl = PERL_GET_CONTEXT;
+// PERL_SET_CONTEXT(perl);
+//PERL_SET_CONTEXT(parent_perl);
PL_perl_destruct_level = modperl_perl_destruct_level(); #ifdef USE_ENVIRON_ARRAY
@@ -134,13 +139,19 @@
} {
- dTHXa(perl);
+ //dTHXa(perl); if ((module_commands = modperl_module_config_table_get(aTHX_ FALSE))) {
modperl_svptr_table_destroy(aTHX_ module_commands);
}
}+ //PERL_SET_CONTEXT(perl);
+ //PERL_SET_CONTEXT(parent_perl);
+ MP_TRACE_i(MP_FUNC, "perl == 0x%lx, PERL_GET_CONTEXT == 0x%lx\n",
+ (unsigned long)perl,
+ (unsigned long)PERL_GET_CONTEXT);
+
perl_destruct(perl);/* XXX: big bug in 5.6.1 fixed in 5.7.2+ @@ -150,9 +161,13 @@ # define MP_NO_PERL_FREE #endif
+ //PERL_SET_CONTEXT(parent_perl);
#ifndef MP_NO_PERL_FREE
perl_free(perl);
#endif
+
+ MP_TRACE_i(MP_FUNC, "after: PERL_GET_CONTEXT== 0x%lx\n",
+ (unsigned long)PERL_GET_CONTEXT); #ifdef USE_ENVIRON_ARRAY
if (orig_environ) {
Index: src/modules/perl/modperl_perl.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.h,v
retrieving revision 1.14
diff -u -r1.14 modperl_perl.h
--- src/modules/perl/modperl_perl.h 7 Nov 2003 09:04:01 -0000 1.14
+++ src/modules/perl/modperl_perl.h 21 Jan 2004 09:56:02 -0000
@@ -29,4 +29,13 @@void modperl_hash_seed_set(pTHX);
+#ifdef USE_ITHREADS +#define MP_THXa(perl) \ + PERL_SET_CONTEXT(aTHX = perl) +#else +#define MP_THXa(perl) +#endif + +#define dTHXCTXa + #endif /* MODPERL_PERL_H */
__________________________________________________________________ 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
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
