Stas Bekman wrote:
>>>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)
>
For some reason my patch program (from cygwin) doesn't like this patch
at all! All hunks fail in all files. Not my day.
I applied it by hand instead, but it makes no difference :(
With just this patch, the <Perl> conf file causes the "free to wrong
pool" error even doing a "-t" syntax check. Adding your earlier patch
as well (to save and restore the context within
MP_CMD_SRV_DECLARE(perldo)) fixes that as before, but the vhost test
still breaks as usual.
- Steve
>
>--- 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
>
>
>
>------------------------------------------------
>This email has been scanned for viruses and content by the Radan Computational
>Webshield Appliances.
>
>
>
>
>
------------------------------------------------
Radan Computational Ltd.
The information contained in this message and any files transmitted with it are
confidential and intended for the addressee(s) only. If you have received this
message in error or there are any problems, please notify the sender immediately. The
unauthorized use, disclosure, copying or alteration of this message is strictly
forbidden. Note that any views or opinions presented in this email are solely those
of the author and do not necessarily represent those of Radan Computational Ltd. The
recipient(s) of this message should check it and any attached files for viruses: Radan
Computational will accept no liability for any damage caused by any virus transmitted
by this email.
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
