Pratik wrote:
Yup. The patch is working nice and solving all the issues related to PerlPassEnv & PerlSetEnv.
I wrote a more extensive test and there are lots of problems with this patch. The first is that %ENV values weren't making back into PerlSetEnv table. I've fixed that (and revamped things a lot). But there is one more problem remaining - that patch was syncing only server-level PerlSetEnv table. So after all the syncs, dir-level PerlSetEnv was out of sync, so at run-time the %ENV hash is having wrong values. I'm looking at it.
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.
Pratik, I've totally rewritten your test to cover all the cases, but your original test still passes.
Index: src/modules/perl/modperl_config.c =================================================================== --- src/modules/perl/modperl_config.c (revision 123523) +++ src/modules/perl/modperl_config.c (working copy) @@ -453,6 +453,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,53 @@
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++) {
+ MP_TRACE_e(MP_FUNC, "(Set|Pass)Env KEY: '%s'", elts[i].key);
+
+ 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;
+}
+
+/* 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 +623,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-29 23:34:04.649710475 -0500
@@ -0,0 +1,133 @@
+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";
+ }
+
+ return Apache::OK;
+}
+
+1;
+__END__
+
+# APACHE_TEST_CONFIG_ORDER 950
+
+<Base>
+ 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"
+ # at request time the directory config will see this value
+ # ("conf7") 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". The
+ # only way to see value set by PerlPostConfigRequire is by calling
+ # dir_config on the server object
+
+</Base>
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/modperl/setupenv2.t 2004-12-29 23:34:11.154832308 -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 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]
