I don't think this problem can be fixed. That means that if someone mixes and matches PerlSetEnv (or PerlPassEnv) in httpd.conf and %ENV of the same key in PerlRequire, PerlConfigRequire, PerlPostConfigRequire and <Perl> sections. Whatever was the last value of that key before <Location> or <Directory> was encountered, that will be the value that any post-post_config handler will see when called for that container.
Let me know if that's OK with you.
Yeah ! That's great :)
I'm not happy about this. I've extended the test a bit more and I see weird things. With the following patch and when running the test as:
env MOD_PERL_TRACE=all t/TEST -v t/modperl/setupenv2.t > & mylog
I get (mylog):
modperl_config_srv_merge: basev==0x8160ad8, addv==0x94142a0
modperl_apr_table_dump: *** Contents of table 'base scfg->SetEnv' *** modperl_apr_table_dump: TestDirective__env_srv1 => env_srv1 modperl_apr_table_dump: TestDirective__env_srv2 => env_srv2 modperl_apr_table_dump: EnvChangeMixedTest => perlmodule modperl_apr_table_dump: modperl_apr_table_dump: *** Contents of table 'add scfg->SetEnv' *** modperl_apr_table_dump: [...] modperl_config_dir_new: new dcfg: 0x9489700
modperl_config_dir_merge: basev==0x81616d0, addv==0x941c000
modperl_apr_table_dump: *** Contents of table 'base dcfg->SetEnv' *** modperl_apr_table_dump: TestDirective__env_srv1 => env_srv1 modperl_apr_table_dump: TestDirective__env_srv2 => env_srv2 modperl_apr_table_dump: EnvChangeMixedTest => conf4 modperl_apr_table_dump: modperl_apr_table_dump: *** Contents of table 'add dcfg->SetEnv' *** modperl_apr_table_dump:
so the server's merge sees 'perlmodule' set by PerlModule (and resynced into scfg->SetEnv), but the dir config sees the last value set by PerlSetEnv. I don't understand why the 'base->SetEnv' in modperl_config_dir_merge is not the same as the server. That looks like a bug or something.
Index: src/modules/perl/modperl_debug.c =================================================================== --- src/modules/perl/modperl_debug.c (revision 123523) +++ src/modules/perl/modperl_debug.c (working copy) @@ -43,22 +43,32 @@
#ifdef MP_TRACE -/* any non-false value for MOD_PERL_TRACE/PerlTrace enables this function */ void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name) { - int i; - const apr_array_header_t *array; - apr_table_entry_t *elts; + int i, tmp_len, len = 0; + char *fmt; + const apr_array_header_t *array = apr_table_elts(table); + apr_table_entry_t *elts = (apr_table_entry_t *)array->elts;
- array = apr_table_elts(table);
- elts = (apr_table_entry_t *)array->elts;
- modperl_trace(MP_FUNC, "Contents of table %s", name);
+ modperl_trace(MP_FUNC, "*** Contents of table '%s' ***", name);
for (i = 0; i < array->nelts; i++) {
+ if (elts[i].key && elts[i].val) {
+ tmp_len = strlen(elts[i].key);
+ if (tmp_len > len) {
+ len = tmp_len;
+ }
+ }
+ }
+ /* dump the table with keys aligned */
+ fmt = Perl_form(aTHX_ "%%-%ds => %%s", len);
+
+ for (i = 0; i < array->nelts; i++) {
if (!elts[i].key || !elts[i].val) {
continue;
}
- modperl_trace(MP_FUNC, "%s => %s", elts[i].key, elts[i].val);
+ modperl_trace(MP_FUNC, fmt, elts[i].key, elts[i].val);
}
+ modperl_trace(MP_FUNC, "");
}
#endifIndex: src/modules/perl/modperl_config.c =================================================================== --- src/modules/perl/modperl_config.c (revision 123523) +++ src/modules/perl/modperl_config.c (working copy) @@ -118,6 +118,12 @@
merge_item(location);
+ dTHX;
+ modperl_apr_table_dump(aTHX_ (apr_table_t *)base->SetEnv,
+ "base dcfg->SetEnv");
+ modperl_apr_table_dump(aTHX_ (apr_table_t *)add->SetEnv,
+ "add dcfg->SetEnv");
+
merge_table_overlap_item(SetEnv); /* this is where we merge PerlSetVar and PerlAddVar together */
@@ -288,6 +294,12 @@
merge_item(PerlRequire);
merge_item(PerlPostConfigRequire);+ dTHX;
+ modperl_apr_table_dump(aTHX_ (apr_table_t *)base->SetEnv,
+ "base scfg->SetEnv");
+ modperl_apr_table_dump(aTHX_ (apr_table_t *)add->SetEnv,
+ "add scfg->SetEnv");
+
merge_table_overlap_item(SetEnv);
merge_table_overlap_item(PassEnv);@@ -453,6 +465,7 @@
MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
retval = modperl_require_file(aTHX_ requires[i], TRUE);
+ modperl_env_sync_env_hash2table(aTHX_ p, s);
MP_PERL_CONTEXT_RESTORE; if (retval) {
Index: src/modules/perl/modperl_env.c
===================================================================
--- src/modules/perl/modperl_env.c (revision 123523)
+++ src/modules/perl/modperl_env.c (working copy)
@@ -28,23 +28,27 @@
#endif
}-static MP_INLINE
-void modperl_env_hv_store(pTHX_ HV *hv, apr_table_entry_t *elt)
+#define MP_ENV_HV_STORE(hv, key, val) STMT_START { \
+ I32 klen = strlen(key); \
+ SV **svp = hv_fetch(hv, key, klen, FALSE); \
+ \
+ if (svp) { \
+ sv_setpv(*svp, val); \
+ } \
+ else { \
+ SV *sv = newSVpv(val, 0); \
+ hv_store(hv, key, klen, sv, FALSE); \
+ modperl_envelem_tie(sv, key, klen); \
+ svp = &sv; \
+ } \
+ MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", key, val); \
+ \
+ SvTAINTED_on(*svp); \
+ } STMT_END
+
+void modperl_env_hv_store(pTHX_ const char *key, const char *val)
{
- I32 klen = strlen(elt->key);
- SV **svp = hv_fetch(hv, elt->key, klen, FALSE);
-
- if (svp) {
- sv_setpv(*svp, elt->val);
- }
- else {
- SV *sv = newSVpv(elt->val, 0);
- hv_store(hv, elt->key, klen, sv, FALSE);
- modperl_envelem_tie(sv, elt->key, klen);
- svp = &sv;
- }
-
- SvTAINTED_on(*svp);
+ MP_ENV_HV_STORE(ENVHV, key, val);
} static MP_INLINE
@@ -98,6 +102,9 @@
modperl_env_tie(mg_flags);
}+#define MP_ENV_HV_STORE_TABLE_ENTRY(hv, elt) \
+ MP_ENV_HV_STORE(hv, elt.key, elt.val);
+
static void modperl_env_table_populate(pTHX_ apr_table_t *table)
{
HV *hv = ENVHV;
@@ -115,9 +122,7 @@
if (!elts[i].key || !elts[i].val) {
continue;
}
- modperl_env_hv_store(aTHX_ hv, &elts[i]);
-
- MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", elts[i].key, elts[i].val);
+ MP_ENV_HV_STORE_TABLE_ENTRY(hv, elts[i]);
} modperl_env_tie(mg_flags);
@@ -141,13 +146,51 @@
continue;
}
modperl_env_hv_delete(aTHX_ hv, elts[i].key);
-
MP_TRACE_e(MP_FUNC, "delete $ENV{%s};", elts[i].key);
- }
+ }modperl_env_tie(mg_flags); }
+/* see the comment in modperl_env_sync_env_hash2table */
+static void modperl_env_sync_table(pTHX_ apr_table_t *table)
+{
+ int i;
+ const apr_array_header_t *array;
+ apr_table_entry_t *elts;
+ HV *hv = ENVHV;
+ SV **svp;
+
+ array = apr_table_elts(table);
+ elts = (apr_table_entry_t *)array->elts;
+
+ for (i = 0; i < array->nelts; i++) {
+ if (!elts[i].key) {
+ continue;
+ }
+ svp = hv_fetch(hv, elts[i].key, strlen(elts[i].key), FALSE);
+ if (svp) {
+ apr_table_set(table, elts[i].key, SvPV_nolen(*svp));
+ MP_TRACE_e(MP_FUNC, "(Set|Pass)Env '%s' '%s'", elts[i].key,
+ SvPV_nolen(*svp));
+ }
+ }
+ TAINT_NOT; /* SvPV_* causes the taint issue */
+}
+
+/* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV at
+ * config time (if perl is running), by copying %ENV values to the
+ * PerlSetEnv and PerlPassEnv tables (only for keys which are already
+ * in those tables)
+ */
+void modperl_env_sync_env_hash2table(pTHX_ apr_pool_t *p, server_rec *s)
+{
+ MP_dSCFG(s);
+
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
/* list of environment variables to pass by default */
static const char *MP_env_pass_defaults[] = {
"PATH", "TZ", NULL
@@ -578,7 +621,7 @@
0
};-static MGVTBL MP_vtbl_envelem = {
+static MGVTBL MP_vtbl_envelem = {
0,
MEMBER_TO_FPTR(modperl_env_magic_set),
0,
Index: src/modules/perl/modperl_env.h
===================================================================
--- src/modules/perl/modperl_env.h (revision 123523)
+++ src/modules/perl/modperl_env.h (working copy)
@@ -33,6 +33,10 @@void modperl_env_clear(pTHX);
+void modperl_env_hv_store(pTHX_ const char *key, const char *val); + +void modperl_env_sync_env_hash2table(pTHX_ apr_pool_t *p, server_rec *s); + void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s);
void modperl_env_configure_request_srv(pTHX_ request_rec *r);
Index: src/modules/perl/modperl_cmd.c
===================================================================
--- src/modules/perl/modperl_cmd.c (revision 123523)
+++ src/modules/perl/modperl_cmd.c (working copy)
@@ -186,6 +186,9 @@
if (!modperl_require_module(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_env_hash2table(aTHX_ parms->pool, parms->server);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -219,6 +222,9 @@
if (!modperl_require_file(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_env_hash2table(aTHX_ parms->pool, parms->server);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -331,6 +337,12 @@
if (!parms->path) {
/* will be propagated to environ */
apr_table_setn(scfg->SetEnv, arg1, arg2);
+ if (modperl_is_running()) {
+ MP_PERL_CONTEXT_DECLARE;
+ MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
+ modperl_env_hv_store(aTHX_ arg1, arg2);
+ MP_PERL_CONTEXT_RESTORE;
+ }
}apr_table_setn(dcfg->SetEnv, arg1, arg2); @@ -353,6 +365,12 @@
if (val) {
apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val));
+ if (modperl_is_running()) {
+ MP_PERL_CONTEXT_DECLARE;
+ MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
+ modperl_env_hv_store(aTHX_ arg, val);
+ MP_PERL_CONTEXT_RESTORE;
+ }
MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val);
}
else {
@@ -541,6 +559,7 @@
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
eval_pv(arg, FALSE);
+ modperl_env_sync_env_hash2table(aTHX_ p, s);
FREETMPS;LEAVE;
}--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/response/TestModperl/setupenv2.pm 2004-12-30 01:08:32.119169453 -0500
@@ -0,0 +1,150 @@
+package TestModperl::setupenv2;
+
+# Test the mixing of PerlSetEnv in httpd.conf and %ENV of the same
+# key in PerlRequire, PerlConfigRequire, PerlPostConfigRequire and
+# <Perl> sections
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Const -compile => qw(OK OR_ALL NO_ARGS);
+
+use Apache::CmdParms ();
+use Apache::Module ();
+use Apache::RequestIO ();
+use Apache::RequestRec ();
+use Apache::RequestUtil ();
+use Apache::ServerUtil ();
+
+use Apache::TestTrace;
+
+my @directives = (
+ {
+ name => 'MyEnvRegister',
+ func => __PACKAGE__ . '::MyEnvRegister',
+ req_override => Apache::OR_ALL,
+ args_how => Apache::NO_ARGS,
+ errmsg => 'cannot fail :)',
+ },
+);
+
+Apache::Module::add(__PACKAGE__, [EMAIL PROTECTED]);
+
+# testing PerlLoadModule
+$ENV{EnvChangeMixedTest} = 'loadmodule';
+$ENV{EnvChangePerlTest} = 'loadmodule';
+
+sub MyEnvRegister {
+ register_mixed();
+}
+
+sub register_mixed {
+ push @TestModperl::setupenv2::EnvChangeMixedTest,
+ $ENV{EnvChangeMixedTest} || 'undef';
+}
+
+sub register_perl {
+ push @TestModperl::setupenv2::EnvChangePerlTest,
+ $ENV{EnvChangePerlTest} || 'undef';
+}
+
+sub get_config {
+ my($self, $s) = (shift, shift);
+ Apache::Module::get_config($self, $s, @_);
+}
+
+sub handler {
+ my($r) = @_;
+
+ # what's the latest env value
+ register_mixed();
+ register_perl();
+
+ my $args = $r->args || '';
+
+ $r->content_type('text/plain');
+
+ if ($args eq 'mixed') {
+ $r->print( join " ", @TestModperl::setupenv2::EnvChangeMixedTest);
+ }
+ elsif ($args eq 'perl') {
+ $r->print( join " ", @TestModperl::setupenv2::EnvChangePerlTest);
+
+ }
+ else {
+ die "no such case";
+ }
+
+ warn "KEY: *******", $r->subprocess_env->get('EnvChangeMixedTest'), "******\n";
+
+ return Apache::OK;
+}
+
+1;
+__END__
+
+# APACHE_TEST_CONFIG_ORDER 950
+
+<NoAutoConfig>
+PerlLoadModule TestModperl::setupenv2
+MyEnvRegister
+
+PerlSetEnv EnvChangeMixedTest "conf1"
+
+<Perl>
+TestModperl::setupenv2::register_mixed();
+TestModperl::setupenv2::register_perl();
+$ENV{EnvChangeMixedTest} = "<perl>";
+$ENV{EnvChangePerlTest} = "<perl>";
+</Perl>
+MyEnvRegister
+
+PerlSetEnv EnvChangeMixedTest "conf2"
+
+PerlRequire "@documentroot@/modperl/setupenv2/require.pl"
+MyEnvRegister
+
+PerlSetEnv EnvChangeMixedTest "conf3"
+
+PerlConfigRequire "@documentroot@/modperl/setupenv2/config_require.pl"
+MyEnvRegister
+
+PerlSetEnv EnvChangeMixedTest "conf4"
+
+PerlModule htdocs::modperl::setupenv2::module
+MyEnvRegister
+
+#PerlSetEnv EnvChangeMixedTest "conf5"
+MyEnvRegister
+
+PerlPostConfigRequire "@documentroot@/modperl/setupenv2/post_config_require.pl"
+MyEnvRegister
+
+#PerlSetEnv EnvChangeMixedTest "conf6"
+MyEnvRegister
+
+#PerlSetEnv EnvChangeMixedTest "conf7"
+MyEnvRegister
+
+<Location /TestModperl__setupenv2>
+ SetHandler modperl
+ PerlResponseHandler TestModperl::setupenv2
+</Location>
+
+#PerlSetEnv EnvChangeMixedTest "conf8"
+
+# at request time a request for <Location /TestModperl__setupenv2>
+# will see this value ("conf8") and
+
+# - not the value set by PerlPostConfigRequire (which is run the very
+# last from all these directives. That's because the PerlSetEnv table
+# for dir <Location /TestModperl__setupenv2> is set right after
+# EnvChangeMixedTest is set to "conf7".
+
+# even though conf8 is the latest setting (before
+# PerlPostConfigRequire) the response handler from <Location
+# /TestModperl__setupenv2> will see conf7, since it was the latest
+# value before that container was encountered
+
+
+</NoAutoConfig>
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/modperl/setupenv2.t 2004-12-29 23:47:33.977528198 -0500
@@ -0,0 +1,35 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my $location = "/TestModperl__setupenv2";
+
+my %expected = (
+ mixed => [qw(loadmodule conf1 <perl> conf2 require conf3
+ config_require conf4 perlmodule conf5 conf5
+ conf6 conf7 conf8 conf7)],
+ perl => [qw(loadmodule <perl> require config_require
+ perlmodule post_config_require)],
+);
+
+plan tests => 2 + scalar(@{ $expected{mixed} }) + scalar(@{ $expected{perl} });
+
+while (my($k, $v) = each %expected) {
+ my @expected = @$v;
+ my $elements = scalar @expected;
+ my $received = GET_BODY "$location?$k";
+ t_debug "$k: $received";
+ my @received = split / /, $received;
+
+ ok t_cmp $received[$_], $expected[$_] for 0..$#expected;
+
+ ok t_cmp scalar(@received), scalar(@expected), "elements";
+ if (@received > @expected) {
+ t_debug "unexpected elements: " .
+ join " ", @received[$elements..$#received];
+ }
+}
+
-- __________________________________________________________________ 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]
