You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Pratik <pr...@gmail.com> on 2004/12/14 18:47:57 UTC
[mp2 bug] Perl*Env issues
I am having the following apache configuration file.
==============================
% cat ~/lab/mp2/test/httpd.conf
ServerRoot "/home/pvnaik/lab/mp2/test"
Timeout 300
DocumentRoot "/home/pvnaik/lab/mp2/test/webdocs"
ErrorLog logs/error_log
Listen 44951
PerlModule Apache2
<Perl>
;
</Perl>
PerlSetEnv MyVar "Hello"
<Perl>
print "HELLO = ", $ENV{MyVar}, "\n";
</Perl>
==============================
Now, the output is :
==============================
% ~/lab/mymp2/mp2/bin/httpd -X -f ~/lab/mp2/test/httpd.conf
HELLO =
HELLO =
==============================
This is happening because, initialization of %ENV will take place when
the first <Perl>..</Perl>. And all the subsequent PerlPassEnv and
PerlSetEnv values will be stored only in scfg->SetEnv table and won't
be copied to %ENV.
This issue was previously discussed at
http://gossamer-threads.com/lists/modperl/dev/7256
The same patch would be something like below now :
==============================
% diff -u modperl_cmd.c~ modperl_cmd.c
--- modperl_cmd.c~ 2004-12-14 03:12:14.000000000 -0800
+++ modperl_cmd.c 2004-12-14 09:35:47.000000000 -0800
@@ -545,6 +545,8 @@
ENTER;SAVETMPS;
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
+ /* Populate %ENV */
+ modperl_env_configure_server(aTHX_ p, s);
eval_pv(arg, FALSE);
FREETMPS;LEAVE;
}
==============================
This patch seems to be working fine for me. But probably, calling
modperl_env_configure_server() for every eval_pv would be a bit
costly.
Another option may be to call modperl_env_hv_store():modperl_env.c
from MP_CMD_SRV_DECLARE2(set_env) and MP_CMD_SRV_DECLARE(pass_env) of
modperl_cmd.c.
Regards,
Pratik
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Stas Bekman wrote:
> Pratik wrote:
>
>> Looks like this patch is solving all the problems :)
>
>
> Thanks Pratik, I'll wait till monday before I commit it, in case someone
> has an input. And then we can get a new RC out.
In fact I said it wrong. I wanted to get it out after RC3 is released so
we can test better the new change. It's now committed.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> Looks like this patch is solving all the problems :)
Thanks Pratik, I'll wait till monday before I commit it, in case someone
has an input. And then we can get a new RC out.
> Happy New year !
Thanks, Happy New Year.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
Looks like this patch is solving all the problems :)
Happy New year !
Thanks,
Pratik
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
The nightly smoke has found a few problems in the code and the test, which
are fixed in the patch below.
Index: src/modules/perl/modperl_config.c
===================================================================
--- src/modules/perl/modperl_config.c (revision 123523)
+++ src/modules/perl/modperl_config.c (working copy)
@@ -21,6 +21,8 @@
dcfg->location = dir;
+ MP_TRACE_d(MP_FUNC, "dir %s\n", dir);
+
#ifdef USE_ITHREADS
/* defaults to per-server scope */
dcfg->interp_scope = MP_INTERP_SCOPE_UNDEF;
@@ -107,8 +109,9 @@
*add = (modperl_config_dir_t *)addv,
*mrg = modperl_config_dir_new(p);
- MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
- (unsigned long)basev, (unsigned long)addv);
+ MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx\n",
+ (unsigned long)basev, (unsigned long)addv,
+ (unsigned long)mrg);
#ifdef USE_ITHREADS
merge_item(interp_scope);
@@ -155,7 +158,8 @@
scfg->PerlModule = apr_array_make(p, 2, sizeof(char *));
scfg->PerlRequire = apr_array_make(p, 2, sizeof(char *));
- scfg->PerlPostConfigRequire = apr_array_make(p, 1, sizeof(char *));
+ scfg->PerlPostConfigRequire =
+ apr_array_make(p, 1, sizeof(modperl_require_file_t *));
scfg->argv = apr_array_make(p, 2, sizeof(char *));
@@ -280,8 +284,9 @@
*add = (modperl_config_srv_t *)addv,
*mrg = modperl_config_srv_new(p);
- MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
- (unsigned long)basev, (unsigned long)addv);
+ MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx\n",
+ (unsigned long)basev, (unsigned long)addv,
+ (unsigned long)mrg);
merge_item(modules);
merge_item(PerlModule);
@@ -443,26 +448,28 @@
modperl_config_srv_t *scfg,
apr_pool_t *p)
{
- char **requires;
+ modperl_require_file_t **requires;
int i;
MP_PERL_CONTEXT_DECLARE;
- requires = (char **)scfg->PerlPostConfigRequire->elts;
+ requires = (modperl_require_file_t **)scfg->PerlPostConfigRequire->elts;
for (i = 0; i < scfg->PerlPostConfigRequire->nelts; i++){
int retval;
MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
- retval = modperl_require_file(aTHX_ requires[i], TRUE);
+ retval = modperl_require_file(aTHX_ requires[i]->file, TRUE);
+ modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ p, requires[i]->dcfg);
MP_PERL_CONTEXT_RESTORE;
if (retval) {
MP_TRACE_d(MP_FUNC, "loaded Perl file: %s for server %s\n",
- requires[i], modperl_server_desc(s, p));
+ requires[i]->file, modperl_server_desc(s, p));
}
else {
ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
"Can't load Perl file: %s for server %s,
exiting...",
- requires[i], modperl_server_desc(s, p));
+ requires[i]->file, modperl_server_desc(s, p));
return FALSE;
}
Index: src/modules/perl/modperl_types.h
===================================================================
--- src/modules/perl/modperl_types.h (revision 123523)
+++ src/modules/perl/modperl_types.h (working copy)
@@ -165,6 +165,11 @@
#endif
} modperl_config_dir_t;
+typedef struct {
+ const char *file;
+ modperl_config_dir_t *dcfg;
+} modperl_require_file_t;
+
typedef struct modperl_mgv_t modperl_mgv_t;
struct modperl_mgv_t {
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,60 @@
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_srv_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_srv_t *scfg)
+{
+ MP_TRACE_d(MP_FUNC, "******* scfg==0x%lx, scfg->SetEnv==0x%lx\n",
+ (unsigned long)scfg, (unsigned long)scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
+void modperl_env_sync_dir_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_dir_t *dcfg)
+{
+ MP_TRACE_d(MP_FUNC, "******* dcfg==0x%lx, dcfg->SetEnv==0x%lx\n",
+ (unsigned long)dcfg, (unsigned long)dcfg->SetEnv);
+ modperl_env_sync_table(aTHX_ dcfg->SetEnv);
+}
+
/* list of environment variables to pass by default */
static const char *MP_env_pass_defaults[] = {
"PATH", "TZ", NULL
@@ -578,7 +630,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,14 @@
void modperl_env_clear(pTHX);
+void modperl_env_hv_store(pTHX_ const char *key, const char *val);
+
+void modperl_env_sync_srv_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_srv_t *scfg);
+
+void modperl_env_sync_dir_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_dir_t *dcfg);
+
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)
@@ -133,30 +133,26 @@
return NULL;
}
+/* this test shows whether the perl for the current s is running
+ * (either base or vhost) */
static int modperl_vhost_is_running(server_rec *s)
{
#ifdef USE_ITHREADS
- MP_dSCFG(s);
- int is_vhost = (s != modperl_global_get_server_rec());
+ if (s->is_virtual){
+ MP_dSCFG(s);
+ return scfg->mip ? TRUE : FALSE;
+ }
+#endif
- if (is_vhost && scfg->mip) {
- return TRUE;
- }
- else {
- return FALSE;
- }
-#else
return modperl_is_running();
-#endif
+
}
MP_CMD_SRV_DECLARE(switches)
{
server_rec *s = parms->server;
MP_dSCFG(s);
- if (s->is_virtual
- ? modperl_vhost_is_running(s)
- : modperl_is_running() ) {
+ if (modperl_vhost_is_running(s)) {
return modperl_cmd_too_late(parms);
}
MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
@@ -167,6 +163,7 @@
MP_CMD_SRV_DECLARE(modules)
{
MP_dSCFG(parms->server);
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
MP_PERL_CONTEXT_DECLARE;
MP_CHECK_SERVER_OR_HTACCESS_CONTEXT;
@@ -186,6 +183,10 @@
if (!modperl_require_module(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -200,6 +201,7 @@
MP_CMD_SRV_DECLARE(requires)
{
MP_dSCFG(parms->server);
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
MP_PERL_CONTEXT_DECLARE;
MP_CHECK_SERVER_OR_HTACCESS_CONTEXT;
@@ -219,6 +221,10 @@
if (!modperl_require_file(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -244,15 +250,19 @@
MP_CMD_SRV_DECLARE(post_config_requires)
{
apr_pool_t *p = parms->pool;
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
apr_finfo_t finfo;
MP_dSCFG(parms->server);
if (APR_SUCCESS == apr_stat(&finfo, arg, APR_FINFO_TYPE, p)) {
if (finfo.filetype != APR_NOFILE) {
MP_TRACE_d(MP_FUNC, "push PerlPostConfigRequire for %s\n", arg);
-
- *(const char **)
- apr_array_push(scfg->PerlPostConfigRequire) = arg;
+ modperl_require_file_t *require = apr_pcalloc(p,
sizeof(*require));
+ require->file = arg;
+ require->dcfg = dcfg;
+
+ *(modperl_require_file_t **)
+ apr_array_push(scfg->PerlPostConfigRequire) = require;
}
}
else {
@@ -331,6 +341,13 @@
if (!parms->path) {
/* will be propagated to environ */
apr_table_setn(scfg->SetEnv, arg1, arg2);
+ /* sync SetEnv => %ENV only for the top-level values */
+ if (modperl_vhost_is_running(parms->server)) {
+ 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 +370,12 @@
if (val) {
apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val));
+ if (modperl_vhost_is_running(parms->server)) {
+ 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 {
@@ -475,14 +498,13 @@
{
apr_pool_t *p = parms->pool;
server_rec *s = parms->server;
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
apr_table_t *options;
modperl_handler_t *handler = NULL;
const char *pkg_name = NULL;
ap_directive_t *directive = parms->directive;
-#ifdef USE_ITHREADS
MP_dSCFG(s);
MP_PERL_CONTEXT_DECLARE;
-#endif
if (!(arg && *arg)) {
return NULL;
@@ -541,6 +563,8 @@
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
eval_pv(arg, FALSE);
+ modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ p, dcfg);
FREETMPS;LEAVE;
}
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/response/TestModperl/setupenv2.pm 2004-12-31 13:44:56.070872298 -0500
@@ -0,0 +1,134 @@
+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 ();
+
+my @directives = (
+ {
+ name => 'MyEnvRegister',
+ func => __PACKAGE__ . '::MyEnvRegister',
+ req_override => Apache::OR_ALL,
+ args_how => Apache::NO_ARGS,
+ errmsg => 'cannot fail :)',
+ },
+);
+
+Apache::Module::add(__PACKAGE__, \@directives);
+
+# testing PerlLoadModule
+$ENV{EnvChangeMixedTest} = 'loadmodule';
+$ENV{EnvChangePerlTest} = 'loadmodule';
+
+sub MyEnvRegister {
+ register_mixed();
+}
+
+sub register_mixed {
+ push @TestModperl::setupenv2::EnvChangeMixedTest,
+ $ENV{EnvChangeMixedTest} || 'notset';
+}
+
+sub register_perl {
+ push @TestModperl::setupenv2::EnvChangePerlTest,
+ $ENV{EnvChangePerlTest} || 'notset';
+}
+
+sub get_config {
+ my($self, $s) = (shift, shift);
+ Apache::Module::get_config($self, $s, @_);
+}
+
+sub handler {
+ my($r) = @_;
+
+ my $args = $r->args || '';
+
+ $r->content_type('text/plain');
+
+ if ($args eq 'mixed') {
+ # what's the latest env value
+ register_mixed();
+ $r->print( join " ", @TestModperl::setupenv2::EnvChangeMixedTest);
+ }
+ elsif ($args eq 'perl') {
+ # what's the latest env value
+ register_perl();
+ $r->print( join " ", @TestModperl::setupenv2::EnvChangePerlTest);
+ }
+ else {
+ die "no such case";
+ }
+
+ 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"
+
+# Since PerlPostConfigRequire runs in the post-config phase it will
+# see 'conf8'. And when it sets that value to 'post_config_require' at
+# request time $ENV{EnvChangeMixedTest} will see the value set by
+# PerlPostConfigRequire.
+
+</NoAutoConfig>
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/modperl/setupenv2.t 2004-12-30 16:26:32.000000000 -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 post_config_require)],
+ 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:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
I have finally figured it out. One needed to sync top-level dcfg too. Now
PerlSetEnv Foo Bar
and
$ENV{Foo} = "Bar";
are really interchangable for the *server* level config. So perl sees what
PerlSetEnv (or PerlPassEnv) set and vice versa.
On the way I've found a few more problems and resolved them.
Please take a look (especially at the new test) and let me know if you see
any problems.
You can enabled tracing to see what's going on:
MOD_PERL_TRACE=de t/modperl/setupenv2.t
to see what's going on (note that some things will go to the console
others to error_log).
Index: src/modules/perl/modperl_config.c
===================================================================
--- src/modules/perl/modperl_config.c (revision 123523)
+++ src/modules/perl/modperl_config.c (working copy)
@@ -21,6 +21,8 @@
dcfg->location = dir;
+ MP_TRACE_d(MP_FUNC, "dir %s\n", dir);
+
#ifdef USE_ITHREADS
/* defaults to per-server scope */
dcfg->interp_scope = MP_INTERP_SCOPE_UNDEF;
@@ -107,8 +109,9 @@
*add = (modperl_config_dir_t *)addv,
*mrg = modperl_config_dir_new(p);
- MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
- (unsigned long)basev, (unsigned long)addv);
+ MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx\n",
+ (unsigned long)basev, (unsigned long)addv,
+ (unsigned long)mrg);
#ifdef USE_ITHREADS
merge_item(interp_scope);
@@ -155,7 +158,8 @@
scfg->PerlModule = apr_array_make(p, 2, sizeof(char *));
scfg->PerlRequire = apr_array_make(p, 2, sizeof(char *));
- scfg->PerlPostConfigRequire = apr_array_make(p, 1, sizeof(char *));
+ scfg->PerlPostConfigRequire =
+ apr_array_make(p, 1, sizeof(modperl_require_file_t *));
scfg->argv = apr_array_make(p, 2, sizeof(char *));
@@ -280,8 +284,9 @@
*add = (modperl_config_srv_t *)addv,
*mrg = modperl_config_srv_new(p);
- MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
- (unsigned long)basev, (unsigned long)addv);
+ MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx\n",
+ (unsigned long)basev, (unsigned long)addv,
+ (unsigned long)mrg);
merge_item(modules);
merge_item(PerlModule);
@@ -443,26 +448,28 @@
modperl_config_srv_t *scfg,
apr_pool_t *p)
{
- char **requires;
+ modperl_require_file_t **requires;
int i;
MP_PERL_CONTEXT_DECLARE;
- requires = (char **)scfg->PerlPostConfigRequire->elts;
+ requires = (modperl_require_file_t **)scfg->PerlPostConfigRequire->elts;
for (i = 0; i < scfg->PerlPostConfigRequire->nelts; i++){
int retval;
MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
- retval = modperl_require_file(aTHX_ requires[i], TRUE);
+ retval = modperl_require_file(aTHX_ requires[i]->file, TRUE);
+ modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ p, requires[i]->dcfg);
MP_PERL_CONTEXT_RESTORE;
if (retval) {
MP_TRACE_d(MP_FUNC, "loaded Perl file: %s for server %s\n",
- requires[i], modperl_server_desc(s, p));
+ requires[i]->file, modperl_server_desc(s, p));
}
else {
ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
"Can't load Perl file: %s for server %s,
exiting...",
- requires[i], modperl_server_desc(s, p));
+ requires[i]->file, modperl_server_desc(s, p));
return FALSE;
}
Index: src/modules/perl/modperl_types.h
===================================================================
--- src/modules/perl/modperl_types.h (revision 123523)
+++ src/modules/perl/modperl_types.h (working copy)
@@ -165,6 +165,11 @@
#endif
} modperl_config_dir_t;
+typedef struct {
+ const char *file;
+ modperl_config_dir_t *dcfg;
+} modperl_require_file_t;
+
typedef struct modperl_mgv_t modperl_mgv_t;
struct modperl_mgv_t {
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,60 @@
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_srv_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_srv_t *scfg)
+{
+ MP_TRACE_d(MP_FUNC, "******* scfg==0x%lx, scfg->SetEnv==0x%lx\n",
+ (unsigned long)scfg, (unsigned long)scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
+void modperl_env_sync_dir_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_dir_t *dcfg)
+{
+ MP_TRACE_d(MP_FUNC, "******* dcfg==0x%lx, dcfg->SetEnv==0x%lx\n",
+ (unsigned long)dcfg, (unsigned long)dcfg->SetEnv);
+ modperl_env_sync_table(aTHX_ dcfg->SetEnv);
+}
+
/* list of environment variables to pass by default */
static const char *MP_env_pass_defaults[] = {
"PATH", "TZ", NULL
@@ -578,7 +630,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,14 @@
void modperl_env_clear(pTHX);
+void modperl_env_hv_store(pTHX_ const char *key, const char *val);
+
+void modperl_env_sync_srv_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_srv_t *scfg);
+
+void modperl_env_sync_dir_env_hash2table(pTHX_ apr_pool_t *p,
+ modperl_config_dir_t *dcfg);
+
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)
@@ -133,30 +133,26 @@
return NULL;
}
+/* this test shows whether the perl for the current s is running
+ * (either base or vhost) */
static int modperl_vhost_is_running(server_rec *s)
{
#ifdef USE_ITHREADS
- MP_dSCFG(s);
- int is_vhost = (s != modperl_global_get_server_rec());
+ if (s->is_virtual){
+ MP_dSCFG(s);
+ return scfg->mip ? TRUE : FALSE;
+ }
+#endif
- if (is_vhost && scfg->mip) {
- return TRUE;
- }
- else {
- return FALSE;
- }
-#else
return modperl_is_running();
-#endif
+
}
MP_CMD_SRV_DECLARE(switches)
{
server_rec *s = parms->server;
MP_dSCFG(s);
- if (s->is_virtual
- ? modperl_vhost_is_running(s)
- : modperl_is_running() ) {
+ if (modperl_vhost_is_running(s)) {
return modperl_cmd_too_late(parms);
}
MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
@@ -167,6 +163,7 @@
MP_CMD_SRV_DECLARE(modules)
{
MP_dSCFG(parms->server);
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
MP_PERL_CONTEXT_DECLARE;
MP_CHECK_SERVER_OR_HTACCESS_CONTEXT;
@@ -186,6 +183,10 @@
if (!modperl_require_module(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -200,6 +201,7 @@
MP_CMD_SRV_DECLARE(requires)
{
MP_dSCFG(parms->server);
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
MP_PERL_CONTEXT_DECLARE;
MP_CHECK_SERVER_OR_HTACCESS_CONTEXT;
@@ -219,6 +221,10 @@
if (!modperl_require_file(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -244,15 +250,19 @@
MP_CMD_SRV_DECLARE(post_config_requires)
{
apr_pool_t *p = parms->pool;
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
apr_finfo_t finfo;
MP_dSCFG(parms->server);
if (APR_SUCCESS == apr_stat(&finfo, arg, APR_FINFO_TYPE, p)) {
if (finfo.filetype != APR_NOFILE) {
MP_TRACE_d(MP_FUNC, "push PerlPostConfigRequire for %s\n", arg);
-
- *(const char **)
- apr_array_push(scfg->PerlPostConfigRequire) = arg;
+ modperl_require_file_t *require = apr_pcalloc(p,
sizeof(*require));
+ require->file = arg;
+ require->dcfg = dcfg;
+
+ *(modperl_require_file_t **)
+ apr_array_push(scfg->PerlPostConfigRequire) = require;
}
}
else {
@@ -331,6 +341,13 @@
if (!parms->path) {
/* will be propagated to environ */
apr_table_setn(scfg->SetEnv, arg1, arg2);
+ /* sync SetEnv => %ENV only for the top-level values */
+ if (modperl_vhost_is_running(parms->server)) {
+ 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 +370,12 @@
if (val) {
apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val));
+ if (modperl_vhost_is_running(parms->server)) {
+ 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 {
@@ -475,6 +498,7 @@
{
apr_pool_t *p = parms->pool;
server_rec *s = parms->server;
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
apr_table_t *options;
modperl_handler_t *handler = NULL;
const char *pkg_name = NULL;
@@ -541,6 +565,8 @@
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
eval_pv(arg, FALSE);
+ modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg);
+ modperl_env_sync_dir_env_hash2table(aTHX_ p, dcfg);
FREETMPS;LEAVE;
}
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/response/TestModperl/setupenv2.pm 2004-12-30 17:33:51.740555289 -0500
@@ -0,0 +1,135 @@
+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 ();
+
+my @directives = (
+ {
+ name => 'MyEnvRegister',
+ func => __PACKAGE__ . '::MyEnvRegister',
+ req_override => Apache::OR_ALL,
+ args_how => Apache::NO_ARGS,
+ errmsg => 'cannot fail :)',
+ },
+);
+
+Apache::Module::add(__PACKAGE__, \@directives);
+
+# testing PerlLoadModule
+$ENV{EnvChangeMixedTest} = 'loadmodule';
+$ENV{EnvChangePerlTest} = 'loadmodule';
+
+sub MyEnvRegister {
+ register_mixed();
+}
+
+sub register_mixed {
+ push @TestModperl::setupenv2::EnvChangeMixedTest,
+ $ENV{EnvChangeMixedTest} || 'notset';
+}
+
+sub register_perl {
+ push @TestModperl::setupenv2::EnvChangePerlTest,
+ $ENV{EnvChangePerlTest} || 'notset';
+}
+
+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
+
+<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"
+
+# Since PerlPostConfigRequire runs in the post-config phase it will
+# see 'conf8'. And when it sets that value to 'post_config_require' at
+# request time $ENV{EnvChangeMixedTest} will see the value set by
+# PerlPostConfigRequire.
+
+</NoAutoConfig>
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/modperl/setupenv2.t 2004-12-30 16:26:32.995140510 -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 post_config_require)],
+ 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:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
>>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, "");
}
#endif
Index: 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__, \@directives);
+
+# 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:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
> 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 :)
Thanks,
Pratik.
--
http://pratik.syslock.org
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Stas Bekman wrote:
> 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__, \@directives);
+
+# 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:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
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.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
Yup. The patch is working nice and solving all the issues related to
PerlPassEnv & PerlSetEnv.
Thanks,
Pratik
On Tue, 28 Dec 2004 15:34:11 -0500, Stas Bekman <st...@stason.org> wrote:
> Pratik wrote:
> > I've been trying get this patch working. The basic idea behind the patch is :
> >
> > 1. Populate %ENV on occurrence of PerlPassEnv & PerlSetEnv.
> > 2. After every <Perl>..</Perl>, PerlRequire, PerlModule &
> > PerlLoadModule - sync server tables - scfg->SetEnv & scfg->PassEnv -
> > with %ENV.
> >
> > I believe it's failing because I am not checking if perl is
> > initialized or not before calling modperl_env_hv_populate(). But I
> > couldn't figure out how exactly the context switching ( use of
> > MP_PERL_CONTEXT_STORE_OVERRIDE ) is done to make it work. I tried to
> > use modperl_is_running(), but it still failed.
> >
> > I have added one test in this patch, which is failing on latest mp2
> > cvs snapshot.
> >
> > I am just able to compile this patch. But "make test" is failing.
>
> OK, I've polished your patch and it both compiles and your test succeeds
> too. Is that all you need? I mean test-wise, so I can start looking at the
> proposed implementation logic.
>
> Index: src/modules/perl/modperl_env.c
> ===================================================================
> --- src/modules/perl/modperl_env.c (revision 123523)
> +++ src/modules/perl/modperl_env.c (working copy)
> @@ -47,6 +47,26 @@
> SvTAINTED_on(*svp);
> }
>
> +void modperl_env_hv_populate(pTHX_ apr_pool_t *p, server_rec *s,
> + const char *key, const char *val)
> +{
> + HV *hv = ENVHV;
> + 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;
> + }
> +
> + SvTAINTED_on(*svp);
> +}
> +
> static MP_INLINE
> void modperl_env_hv_delete(pTHX_ HV *hv, char *key)
> {
> @@ -116,7 +136,6 @@
> continue;
> }
> modperl_env_hv_store(aTHX_ hv, &elts[i]);
> -
> MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", elts[i].key, elts[i].val);
> }
>
> @@ -141,9 +160,8 @@
> 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);
> }
> @@ -153,6 +171,44 @@
> "PATH", "TZ", NULL
> };
>
> +static void modperl_env_sync_table(pTHX_ apr_table_t *table)
> +{
> + U32 mg_flags;
> + int i;
> + const apr_array_header_t *array;
> + apr_table_entry_t *elts;
> +
> + modperl_env_untie(mg_flags);
> +
> + array = apr_table_elts(table);
> + elts = (apr_table_entry_t *)array->elts;
> +
> + for (i = 0; i < array->nelts; i++) {
> + char *val;
> +
> + if (!elts[i].key || !elts[i].val) {
> + continue;
> + }
> + val = getenv(elts[i].key);
> + if (val && !apr_strnatcmp(elts[i].val, val)) {
> + apr_table_set(table, elts[i].key, val);
> + }
> + }
> +
> + modperl_env_tie(mg_flags);
> +}
> +
> +void modperl_env_sync_server(pTHX_ apr_pool_t *p, server_rec *s)
> +{
> + MP_dSCFG(s);
> +
> + /* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV
> + * at config time
> + */
> + modperl_env_sync_table(aTHX_ scfg->SetEnv);
> + modperl_env_sync_table(aTHX_ scfg->PassEnv);
> +}
> +
> void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
> {
> MP_dSCFG(s);
> @@ -578,7 +634,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,11 @@
>
> void modperl_env_clear(pTHX);
>
> +void modperl_env_hv_populate(pTHX_ apr_pool_t *p, server_rec *s,
> + const char *key, const char *val);
> +
> +void modperl_env_sync_server(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_server(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_server(aTHX_ parms->pool, parms->server);
> + }
> MP_PERL_CONTEXT_RESTORE;
>
> return error;
> @@ -331,6 +337,13 @@
> 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_populate(aTHX_ parms->pool, parms->server,
> + arg1, arg2);
> + MP_PERL_CONTEXT_RESTORE;
> + }
> }
>
> apr_table_setn(dcfg->SetEnv, arg1, arg2);
> @@ -353,6 +366,13 @@
>
> 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_populate(aTHX_ parms->pool, parms->server,
> + arg, val);
> + MP_PERL_CONTEXT_RESTORE;
> + }
> MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val);
> }
> else {
> @@ -541,6 +561,7 @@
> save_scalar(gv); /* local $0 */
> sv_setpv_mg(GvSV(gv), directive->filename);
> eval_pv(arg, FALSE);
> + modperl_env_sync_server(aTHX_ p, s);
> FREETMPS;LEAVE;
> }
>
> @@ -626,8 +647,10 @@
> */
> MP_CMD_SRV_DECLARE(load_module)
> {
> + MP_dSCFG(parms->server);
> const char *errmsg;
> -
> + MP_PERL_CONTEXT_DECLARE;
> +
> MP_TRACE_d(MP_FUNC, "PerlLoadModule %s\n", arg);
>
> /* we must init earlier than normal */
> @@ -637,6 +660,10 @@
> return errmsg;
> }
>
> + MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
> + modperl_env_sync_server(aTHX_ parms->pool, parms->server);
> + MP_PERL_CONTEXT_RESTORE;
> +
> return NULL;
> }
>
> --- /dev/null 2004-12-27 14:35:25.636826264 -0500
> +++ t/response/TestDirective/setupenv2.pm 2004-12-28 14:32:51.456803346 -0500
> @@ -0,0 +1,68 @@
> +package TestDirective::setupenv2;
> +
> +# This is test for checking PerlSetEnv in conf section
> +
> +use strict;
> +use warnings FATAL => 'all';
> +
> +use Apache::Const -compile => qw(OK OR_ALL TAKE1);
> +
> +use Apache::CmdParms ();
> +use Apache::Module ();
> +
> +my @directives = (
> + {
> + name => 'MyEnvTest',
> + func => __PACKAGE__ . '::MyEnvTest',
> + req_override => Apache::OR_ALL,
> + args_how => Apache::TAKE1,
> + errmsg => 'Env that will be stored.',
> + },
> +);
> +
> +Apache::Module::add(__PACKAGE__, \@directives);
> +
> +sub MyEnvTest {
> + my($self, $parms, $arg) = @_;
> + #warn "MyEnvTest: @{[$parms->path||'']}\n\t$arg\n";
> + push @{ $self->{MyEnvTest} }, $ENV{$arg};
> +
> + # store the top level srv values in the server struct as well
> + unless ($parms->path) {
> + my $srv_cfg = $self->get_config($parms->server);
> + push @{ $srv_cfg->{MyEnvTest} }, $ENV{$arg};
> + }
> +}
> +
> +sub get_config {
> + my($self, $s) = (shift, shift);
> + Apache::Module::get_config($self, $s, @_);
> +}
> +
> +sub handler : method {
> + my($self, $r) = @_;
> +
> + $r->content_type('text/plain');
> +
> + my $s = $r->server;
> + my $srv_cfg = $self->get_config($s);
> + $r->print("srv: @{ $srv_cfg->{MyEnvTest}||[] }");
> +
> + return Apache::OK;
> +}
> +
> +1;
> +__END__
> +
> +# APACHE_TEST_CONFIG_ORDER 950
> +
> +<Base>
> + PerlLoadModule TestDirective::setupenv2
> + PerlSetEnv FooEnv "one"
> + MyEnvTest "FooEnv"
> + <Perl>
> + 1;
> + </Perl>
> + PerlSetEnv BarEnv "two"
> + MyEnvTest "BarEnv"
> +</Base>
>
> --- /dev/null 2004-12-27 14:35:25.636826264 -0500
> +++ t/directive/setupenv2.t 2004-12-28 14:32:51.432806617 -0500
> @@ -0,0 +1,17 @@
> +use strict;
> +use warnings FATAL => 'all';
> +
> +use Apache::Test;
> +use Apache::TestUtil;
> +use Apache::TestRequest;
> +
> +my $url = "/TestDirective__setupenv2";
> +
> +plan tests => 1;
> +
> +{
> + my $location = "$url";
> + my $expected = "srv: one two";
> + my $received = GET_BODY $location;
> + ok t_cmp($received, $expected, "access env variable");
> +}
>
> --
> __________________________________________________________________
> Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/ mod_perl Guide ---> http://perl.apache.org
> mailto:stas@stason.org http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org http://ticketmaster.com
>
--
http://pratik.syslock.org
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> I've been trying get this patch working. The basic idea behind the patch is :
>
> 1. Populate %ENV on occurrence of PerlPassEnv & PerlSetEnv.
> 2. After every <Perl>..</Perl>, PerlRequire, PerlModule &
> PerlLoadModule - sync server tables - scfg->SetEnv & scfg->PassEnv -
> with %ENV.
>
> I believe it's failing because I am not checking if perl is
> initialized or not before calling modperl_env_hv_populate(). But I
> couldn't figure out how exactly the context switching ( use of
> MP_PERL_CONTEXT_STORE_OVERRIDE ) is done to make it work. I tried to
> use modperl_is_running(), but it still failed.
>
> I have added one test in this patch, which is failing on latest mp2
> cvs snapshot.
>
> I am just able to compile this patch. But "make test" is failing.
OK, I've polished your patch and it both compiles and your test succeeds
too. Is that all you need? I mean test-wise, so I can start looking at the
proposed implementation logic.
Index: src/modules/perl/modperl_env.c
===================================================================
--- src/modules/perl/modperl_env.c (revision 123523)
+++ src/modules/perl/modperl_env.c (working copy)
@@ -47,6 +47,26 @@
SvTAINTED_on(*svp);
}
+void modperl_env_hv_populate(pTHX_ apr_pool_t *p, server_rec *s,
+ const char *key, const char *val)
+{
+ HV *hv = ENVHV;
+ 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;
+ }
+
+ SvTAINTED_on(*svp);
+}
+
static MP_INLINE
void modperl_env_hv_delete(pTHX_ HV *hv, char *key)
{
@@ -116,7 +136,6 @@
continue;
}
modperl_env_hv_store(aTHX_ hv, &elts[i]);
-
MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", elts[i].key, elts[i].val);
}
@@ -141,9 +160,8 @@
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);
}
@@ -153,6 +171,44 @@
"PATH", "TZ", NULL
};
+static void modperl_env_sync_table(pTHX_ apr_table_t *table)
+{
+ U32 mg_flags;
+ int i;
+ const apr_array_header_t *array;
+ apr_table_entry_t *elts;
+
+ modperl_env_untie(mg_flags);
+
+ array = apr_table_elts(table);
+ elts = (apr_table_entry_t *)array->elts;
+
+ for (i = 0; i < array->nelts; i++) {
+ char *val;
+
+ if (!elts[i].key || !elts[i].val) {
+ continue;
+ }
+ val = getenv(elts[i].key);
+ if (val && !apr_strnatcmp(elts[i].val, val)) {
+ apr_table_set(table, elts[i].key, val);
+ }
+ }
+
+ modperl_env_tie(mg_flags);
+}
+
+void modperl_env_sync_server(pTHX_ apr_pool_t *p, server_rec *s)
+{
+ MP_dSCFG(s);
+
+ /* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV
+ * at config time
+ */
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
{
MP_dSCFG(s);
@@ -578,7 +634,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,11 @@
void modperl_env_clear(pTHX);
+void modperl_env_hv_populate(pTHX_ apr_pool_t *p, server_rec *s,
+ const char *key, const char *val);
+
+void modperl_env_sync_server(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_server(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_server(aTHX_ parms->pool, parms->server);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -331,6 +337,13 @@
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_populate(aTHX_ parms->pool, parms->server,
+ arg1, arg2);
+ MP_PERL_CONTEXT_RESTORE;
+ }
}
apr_table_setn(dcfg->SetEnv, arg1, arg2);
@@ -353,6 +366,13 @@
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_populate(aTHX_ parms->pool, parms->server,
+ arg, val);
+ MP_PERL_CONTEXT_RESTORE;
+ }
MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val);
}
else {
@@ -541,6 +561,7 @@
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
eval_pv(arg, FALSE);
+ modperl_env_sync_server(aTHX_ p, s);
FREETMPS;LEAVE;
}
@@ -626,8 +647,10 @@
*/
MP_CMD_SRV_DECLARE(load_module)
{
+ MP_dSCFG(parms->server);
const char *errmsg;
-
+ MP_PERL_CONTEXT_DECLARE;
+
MP_TRACE_d(MP_FUNC, "PerlLoadModule %s\n", arg);
/* we must init earlier than normal */
@@ -637,6 +660,10 @@
return errmsg;
}
+ MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
+ MP_PERL_CONTEXT_RESTORE;
+
return NULL;
}
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/response/TestDirective/setupenv2.pm 2004-12-28 14:32:51.456803346 -0500
@@ -0,0 +1,68 @@
+package TestDirective::setupenv2;
+
+# This is test for checking PerlSetEnv in conf section
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Const -compile => qw(OK OR_ALL TAKE1);
+
+use Apache::CmdParms ();
+use Apache::Module ();
+
+my @directives = (
+ {
+ name => 'MyEnvTest',
+ func => __PACKAGE__ . '::MyEnvTest',
+ req_override => Apache::OR_ALL,
+ args_how => Apache::TAKE1,
+ errmsg => 'Env that will be stored.',
+ },
+);
+
+Apache::Module::add(__PACKAGE__, \@directives);
+
+sub MyEnvTest {
+ my($self, $parms, $arg) = @_;
+ #warn "MyEnvTest: @{[$parms->path||'']}\n\t$arg\n";
+ push @{ $self->{MyEnvTest} }, $ENV{$arg};
+
+ # store the top level srv values in the server struct as well
+ unless ($parms->path) {
+ my $srv_cfg = $self->get_config($parms->server);
+ push @{ $srv_cfg->{MyEnvTest} }, $ENV{$arg};
+ }
+}
+
+sub get_config {
+ my($self, $s) = (shift, shift);
+ Apache::Module::get_config($self, $s, @_);
+}
+
+sub handler : method {
+ my($self, $r) = @_;
+
+ $r->content_type('text/plain');
+
+ my $s = $r->server;
+ my $srv_cfg = $self->get_config($s);
+ $r->print("srv: @{ $srv_cfg->{MyEnvTest}||[] }");
+
+ return Apache::OK;
+}
+
+1;
+__END__
+
+# APACHE_TEST_CONFIG_ORDER 950
+
+<Base>
+ PerlLoadModule TestDirective::setupenv2
+ PerlSetEnv FooEnv "one"
+ MyEnvTest "FooEnv"
+ <Perl>
+ 1;
+ </Perl>
+ PerlSetEnv BarEnv "two"
+ MyEnvTest "BarEnv"
+</Base>
--- /dev/null 2004-12-27 14:35:25.636826264 -0500
+++ t/directive/setupenv2.t 2004-12-28 14:32:51.432806617 -0500
@@ -0,0 +1,17 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my $url = "/TestDirective__setupenv2";
+
+plan tests => 1;
+
+{
+ my $location = "$url";
+ my $expected = "srv: one two";
+ my $received = GET_BODY $location;
+ ok t_cmp($received, $expected, "access env variable");
+}
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
I've been trying get this patch working. The basic idea behind the patch is :
1. Populate %ENV on occurrence of PerlPassEnv & PerlSetEnv.
2. After every <Perl>..</Perl>, PerlRequire, PerlModule &
PerlLoadModule - sync server tables - scfg->SetEnv & scfg->PassEnv -
with %ENV.
I believe it's failing because I am not checking if perl is
initialized or not before calling modperl_env_hv_populate(). But I
couldn't figure out how exactly the context switching ( use of
MP_PERL_CONTEXT_STORE_OVERRIDE ) is done to make it work. I tried to
use modperl_is_running(), but it still failed.
I have added one test in this patch, which is failing on latest mp2
cvs snapshot.
I am just able to compile this patch. But "make test" is failing.
Please Help.
Thanks,
Pratik
diff -ruN /home/pvnaik/lab/mp2src/modperl-2.0/src/modules/perl/modperl_cmd.c
modperl-2.0/src/modules/perl/modperl_cmd.c
--- /home/pvnaik/lab/mp2src/modperl-2.0/src/modules/perl/modperl_cmd.c 2004-12-22
21:38:28.000000000 -0800
+++ modperl-2.0/src/modules/perl/modperl_cmd.c 2004-12-28
09:13:13.000000000 -0800
@@ -186,6 +186,9 @@
if (!modperl_require_module(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ else {
+ modperl_env_sync_server(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_server(aTHX_ parms->pool, parms->server);
+ }
MP_PERL_CONTEXT_RESTORE;
return error;
@@ -331,6 +337,7 @@
if (!parms->path) {
/* will be propagated to environ */
apr_table_setn(scfg->SetEnv, arg1, arg2);
+ modperl_env_hv_populate(aTHX_ parms->pool, parms->server, arg1, arg2);
}
apr_table_setn(dcfg->SetEnv, arg1, arg2);
@@ -353,6 +360,7 @@
if (val) {
apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val));
+ modperl_env_hv_populate(aTHX_ parms->pool, parms->server, arg, val);
MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val);
}
else {
@@ -541,6 +549,7 @@
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
eval_pv(arg, FALSE);
+ modperl_env_sync_server(aTHX_ p, s);
FREETMPS;LEAVE;
}
@@ -636,6 +645,7 @@
if ((errmsg = modperl_cmd_modules(parms, mconfig, arg))) {
return errmsg;
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
return NULL;
}
diff -ruN /home/pvnaik/lab/mp2src/modperl-2.0/src/modules/perl/modperl_env.c
modperl-2.0/src/modules/perl/modperl_env.c
--- /home/pvnaik/lab/mp2src/modperl-2.0/src/modules/perl/modperl_env.c 2004-12-20
21:43:11.000000000 -0800
+++ modperl-2.0/src/modules/perl/modperl_env.c 2004-12-28
09:13:13.000000000 -0800
@@ -47,6 +47,30 @@
SvTAINTED_on(*svp);
}
+void modperl_env_hv_populate(pTHX_ apr_pool_t *p,
+ server_rec *s,
+ char *key,
+ char *val)
+{
+ MP_dSCFG(s);
+
+ HV *hv = ENVHV;
+ 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;
+ }
+
+ SvTAINTED_on(*svp);
+}
+
static MP_INLINE
void modperl_env_hv_delete(pTHX_ HV *hv, char *key)
{
@@ -153,6 +177,45 @@
"PATH", "TZ", NULL
};
+static void modperl_env_sync_table(pTHX_ apr_table_t *table)
+{
+ HV *hv = ENVHV;
+ U32 mg_flags;
+ int i;
+ const apr_array_header_t *array;
+ apr_table_entry_t *elts;
+
+ modperl_env_untie(mg_flags);
+
+ array = apr_table_elts(table);
+ elts = (apr_table_entry_t *)array->elts;
+
+ for (i = 0; i < array->nelts; i++) {
+ char *val;
+
+ if (!elts[i].key || !elts[i].val) {
+ continue;
+ }
+ val = getenv(elts[i].key);
+ if (!apr_strnatcmp(elts[i].val, val)) {
+ apr_table_set(table, elts[i].key, val);
+ }
+ }
+
+ modperl_env_tie(mg_flags);
+}
+
+void modperl_env_sync_server(pTHX_ apr_pool_t *p, server_rec *s)
+{
+ MP_dSCFG(s);
+
+ /* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV
+ * at config time
+ */
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
{
MP_dSCFG(s);
diff -ruN /home/pvnaik/lab/mp2src/modperl-2.0/src/modules/perl/modperl_env.h
modperl-2.0/src/modules/perl/modperl_env.h
--- /home/pvnaik/lab/mp2src/modperl-2.0/src/modules/perl/modperl_env.h 2004-12-01
01:20:06.000000000 -0800
+++ modperl-2.0/src/modules/perl/modperl_env.h 2004-12-28
09:13:13.000000000 -0800
@@ -33,6 +33,13 @@
void modperl_env_clear(pTHX);
+void modperl_env_hv_populate(pTHX_ apr_pool_t *p,
+ server_rec *s,
+ char *key,
+ char *val);
+
+void modperl_env_sync_server(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);
diff -ruN /home/pvnaik/lab/mp2src/modperl-2.0/t/directive/setupenv2.t
modperl-2.0/t/directive/setupenv2.t
--- /home/pvnaik/lab/mp2src/modperl-2.0/t/directive/setupenv2.t 1969-12-31
16:00:00.000000000 -0800
+++ modperl-2.0/t/directive/setupenv2.t 2004-12-28 05:06:49.000000000 -0800
@@ -0,0 +1,17 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+my $url = "/TestDirective__setupenv2";
+
+plan tests => 1;
+
+{
+ my $location = "$url";
+ my $expected = "srv: one two";
+ my $received = GET_BODY $location;
+ ok t_cmp($received, $expected, "access env variable");
+}
diff -ruN /home/pvnaik/lab/mp2src/modperl-2.0/t/response/TestDirective/setupenv2.pm
modperl-2.0/t/response/TestDirective/setupenv2.pm
--- /home/pvnaik/lab/mp2src/modperl-2.0/t/response/TestDirective/setupenv2.pm 1969-12-31
16:00:00.000000000 -0800
+++ modperl-2.0/t/response/TestDirective/setupenv2.pm 2004-12-28
08:36:22.000000000 -0800
@@ -0,0 +1,68 @@
+package TestDirective::setupenv2;
+
+# This is test for checking PerlSetEnv in conf section
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Const -compile => qw(OK OR_ALL TAKE1);
+
+use Apache::CmdParms ();
+use Apache::Module ();
+
+my @directives = (
+ {
+ name => 'MyEnvTest',
+ func => __PACKAGE__ . '::MyEnvTest',
+ req_override => Apache::OR_ALL,
+ args_how => Apache::TAKE1,
+ errmsg => 'Env that will be stored.',
+ },
+);
+
+Apache::Module::add(__PACKAGE__, \@directives);
+
+sub MyEnvTest {
+ my($self, $parms, $arg) = @_;
+ #warn "MyEnvTest: @{[$parms->path||'']}\n\t$arg\n";
+ push @{ $self->{MyEnvTest} }, $ENV{$arg};
+
+ # store the top level srv values in the server struct as well
+ unless ($parms->path) {
+ my $srv_cfg = $self->get_config($parms->server);
+ push @{ $srv_cfg->{MyEnvTest} }, $ENV{$arg};
+ }
+}
+
+sub get_config {
+ my($self, $s) = (shift, shift);
+ Apache::Module::get_config($self, $s, @_);
+}
+
+sub handler : method {
+ my($self, $r) = @_;
+
+ $r->content_type('text/plain');
+
+ my $s = $r->server;
+ my $srv_cfg = $self->get_config($s);
+ $r->print("srv: @{ $srv_cfg->{MyEnvTest}||[] }");
+
+ return Apache::OK;
+}
+
+1;
+__END__
+
+# APACHE_TEST_CONFIG_ORDER 950
+
+<Base>
+ PerlLoadModule TestDirective::setupenv2
+ PerlSetEnv FooEnv "one"
+ MyEnvTest "FooEnv"
+ <Perl>
+ 1;
+ </Perl>
+ PerlSetEnv BarEnv "two"
+ MyEnvTest "BarEnv"
+</Base>
--
http://pratik.syslock.org
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> On Thu, 23 Dec 2004 15:24:05 -0500, Stas Bekman <st...@stason.org> wrote:
>
>
>>I'm not sure I understand your question. Do you ask how can you test those
>>changes? For example by writing a new <Perl> section where you test that
>>some ENV var got set or not (e.g. die if it's not).
>
>
> In the previous patch that I posted, I am copying values of
> %ENV:getenv() to server tables after end of every <Perl>..</Perl>,
> PerlRequire & PerlModule, if the key is present in the server tables.
> I want to identify all the keys of %ENV whose value got changed during
> <Perl>..</Perl>, PerlRequire & PerlModule. So that only changed
> key-value can be updated in server tables.
>
>
>>where do you call it? Can you post the whole patch so I can try?
>
>
> This is the patch. I did "make install" ignoring the output of "make
> test" to debug the issue. And it is failing at "HV *hv = ENVHV" of
> modperl_env_hv_populate().
>
> The idea behind this patch is to make entry into %ENV() on the
> occurrence of PerlPassEnv and PerlSetEnv, at the same time making an
> entry into server table.
This patch doesn't apply. Mind to send one against svn or the latest snapshot?
http://perl.apache.org/download/source.html#Development_mod_perl_2_0_Source_Distribution
Also it lacks tests. In order to consider its application we need to have
tests. Normally the process of fixing the problem goes like this: you
write the tests first, make sure that they fail, then you go about fixing
those.
Thanks.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
On Thu, 23 Dec 2004 15:24:05 -0500, Stas Bekman <st...@stason.org> wrote:
> I'm not sure I understand your question. Do you ask how can you test those
> changes? For example by writing a new <Perl> section where you test that
> some ENV var got set or not (e.g. die if it's not).
In the previous patch that I posted, I am copying values of
%ENV:getenv() to server tables after end of every <Perl>..</Perl>,
PerlRequire & PerlModule, if the key is present in the server tables.
I want to identify all the keys of %ENV whose value got changed during
<Perl>..</Perl>, PerlRequire & PerlModule. So that only changed
key-value can be updated in server tables.
> where do you call it? Can you post the whole patch so I can try?
This is the patch. I did "make install" ignoring the output of "make
test" to debug the issue. And it is failing at "HV *hv = ENVHV" of
modperl_env_hv_populate().
The idea behind this patch is to make entry into %ENV() on the
occurrence of PerlPassEnv and PerlSetEnv, at the same time making an
entry into server table.
Thanks,
Pratik
diff -ru /home/pvnaik/lab/mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c
mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c
--- /home/pvnaik/lab/mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c 2004-12-12
13:49:11.000000000 -0800
+++ mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c 2004-12-27
07:40:59.000000000 -0800
@@ -219,9 +219,11 @@
MP_TRACE_d(MP_FUNC, "load PerlModule %s\n", arg);
MP_PERL_OVERRIDE_CONTEXT;
+
if (!modperl_require_module(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
MP_PERL_RESTORE_CONTEXT;
return error;
@@ -255,6 +257,7 @@
if (!modperl_require_file(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
MP_PERL_RESTORE_CONTEXT;
return error;
@@ -320,6 +323,7 @@
MP_CMD_SRV_DECLARE2(set_env)
{
MP_dSCFG(parms->server);
+
modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
#ifdef ENV_IS_CASELESS /* i.e. WIN32 */
@@ -335,6 +339,7 @@
if (!parms->path) {
/* will be propagated to environ */
apr_table_setn(scfg->SetEnv, arg1, arg2);
+ modperl_env_hv_populate(aTHX_ parms->pool, parms->server, arg1, arg2);
}
apr_table_setn(dcfg->SetEnv, arg1, arg2);
@@ -345,6 +350,7 @@
MP_CMD_SRV_DECLARE(pass_env)
{
MP_dSCFG(parms->server);
+
char *val = getenv(arg);
#ifdef ENV_IS_CASELESS /* i.e. WIN32 */
@@ -357,6 +363,7 @@
if (val) {
apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val));
+ modperl_env_hv_populate(aTHX_ parms->pool, parms->server,arg, val);
MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val);
}
else {
@@ -545,6 +552,7 @@
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
eval_pv(arg, FALSE);
+ modperl_env_sync_server(aTHX_ p, s);
FREETMPS;LEAVE;
}
@@ -640,6 +648,7 @@
if ((errmsg = modperl_cmd_modules(parms, mconfig, arg))) {
return errmsg;
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
return NULL;
}
diff -ru /home/pvnaik/lab/mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c
mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c
--- /home/pvnaik/lab/mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c 2004-12-12
13:49:11.000000000 -0800
+++ mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c 2004-12-27
07:41:06.000000000 -0800
@@ -47,6 +47,30 @@
SvTAINTED_on(*svp);
}
+void modperl_env_hv_populate(pTHX_ apr_pool_t *p,
+ server_rec *s,
+ char *key,
+ char *val)
+{
+ MP_dSCFG(s);
+
+ HV *hv = ENVHV;
+ 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;
+ }
+
+ SvTAINTED_on(*svp);
+}
+
static MP_INLINE
void modperl_env_hv_delete(pTHX_ HV *hv, char *key)
{
@@ -153,6 +177,45 @@
"PATH", "TZ", NULL
};
+static void modperl_env_sync_table(pTHX_ apr_table_t *table)
+{
+ HV *hv = ENVHV;
+ U32 mg_flags;
+ int i;
+ const apr_array_header_t *array;
+ apr_table_entry_t *elts;
+
+ modperl_env_untie(mg_flags);
+
+ array = apr_table_elts(table);
+ elts = (apr_table_entry_t *)array->elts;
+
+ for (i = 0; i < array->nelts; i++) {
+ char *val;
+
+ if (!elts[i].key || !elts[i].val) {
+ continue;
+ }
+ val = getenv(elts[i].key);
+ if (!apr_strnatcmp(elts[i].val, val)) {
+ apr_table_set(table, elts[i].key, val);
+ }
+ }
+
+ modperl_env_tie(mg_flags);
+}
+
+void modperl_env_sync_server(pTHX_ apr_pool_t *p, server_rec *s)
+{
+ MP_dSCFG(s);
+
+ /* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV
+ * at config time
+ */
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
{
MP_dSCFG(s);
diff -ru /home/pvnaik/lab/mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h
mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h
--- /home/pvnaik/lab/mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h 2004-12-12
13:49:11.000000000 -0800
+++ mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h 2004-12-27
07:41:12.000000000 -0800
@@ -33,6 +33,13 @@
void modperl_env_clear(pTHX);
+void modperl_env_hv_populate(pTHX_ apr_pool_t *p,
+ server_rec *s,
+ char *key,
+ char *val);
+
+void modperl_env_sync_server(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);
--
http://pratik.syslock.org
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
>>Very nice work, Pratik. The only problem is that it syncs SetEnv|PassEvn
>><=> %ENV completely twice for each <Perl>..</Perl>, PerlRequire and
>>PerlModule, which is not very effective. It would be nice to keep track of
>>just what keys have changed.
>>
>
>
> I need a little help here. MP2 directly uses Perl API call eval_pv()
> for <Perl>..</Perl>. Similarly, it uses Perl API for PerlRequire and
> PerlModule. How can I get the list of %ENV variables that got changed
> in <Perl>..</Perl>, PerlRequire or PerlModule ?
I'm not sure I understand your question. Do you ask how can you test those
changes? For example by writing a new <Perl> section where you test that
some ENV var got set or not (e.g. die if it's not).
>>Regardless, we need to have the tests, since it looks that what you need
>>is the right thing.
>>
>>Of course it'd be nice to have a more efficient solution.
>>
>
>
> I tried to populate %ENV on encountering PerlPassEnv & PerlSetEnv, but
> "HV *hv = ENVHV;" statement in the new procedure that I wrote ( and
> called it on PerlPassEnv and PerlSetEnv ) - gave me segmentation
> fault. The procedure was something like below :
>
> void modperl_env_hv_populate(pTHX_ char *key, char *val)
> {
> HV *hv = ENVHV;
> 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;
> }
>
> SvTAINTED_on(*svp);
> }
>
> Any idea ?
>
> If we populate %ENV on occurance of PerlPassEnv and PerlSetEnv, there
> won't be any need modperl_env_sync_tables2env() call and only
> modperl_env_sync_env2tables() will be required at the end of every
> <Perl>..</Perl>, PerlRequire & PerlModule.
where do you call it? Can you post the whole patch so I can try?
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
> Very nice work, Pratik. The only problem is that it syncs SetEnv|PassEvn
> <=> %ENV completely twice for each <Perl>..</Perl>, PerlRequire and
> PerlModule, which is not very effective. It would be nice to keep track of
> just what keys have changed.
>
I need a little help here. MP2 directly uses Perl API call eval_pv()
for <Perl>..</Perl>. Similarly, it uses Perl API for PerlRequire and
PerlModule. How can I get the list of %ENV variables that got changed
in <Perl>..</Perl>, PerlRequire or PerlModule ?
> Regardless, we need to have the tests, since it looks that what you need
> is the right thing.
>
> Of course it'd be nice to have a more efficient solution.
>
I tried to populate %ENV on encountering PerlPassEnv & PerlSetEnv, but
"HV *hv = ENVHV;" statement in the new procedure that I wrote ( and
called it on PerlPassEnv and PerlSetEnv ) - gave me segmentation
fault. The procedure was something like below :
void modperl_env_hv_populate(pTHX_ char *key, char *val)
{
HV *hv = ENVHV;
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;
}
SvTAINTED_on(*svp);
}
Any idea ?
If we populate %ENV on occurance of PerlPassEnv and PerlSetEnv, there
won't be any need modperl_env_sync_tables2env() call and only
modperl_env_sync_env2tables() will be required at the end of every
<Perl>..</Perl>, PerlRequire & PerlModule.
Thanks,
Pratik
---
http://pratik.syslock.org
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> I have written a small patch to solve this problem. Please have a look
> at it. If it looks good, I will write tests and submit the patch.
>
> The scheme is :
>
> 1. Populate %ENV before all <Perl>..</Perl>, PerlRequire and PerlModule.
> 2. After every <Perl>..</Perl>, PerlRequire and PerlModule, sync
> server tables ( scfg->SetEnv & scfg->PassEnv ) with %ENV.
Very nice work, Pratik. The only problem is that it syncs SetEnv|PassEvn
<=> %ENV completely twice for each <Perl>..</Perl>, PerlRequire and
PerlModule, which is not very effective. It would be nice to keep track of
just what keys have changed.
Regardless, we need to have the tests, since it looks that what you need
is the right thing.
Of course it'd be nice to have a more efficient solution.
also I think you shouldn't use modperl_env_configure_server() since it
does more than that (and that extra thing doesn't need to happen so many
times since it doesn't change). Instead I think there should be:
modperl_env_sync_env2tables
modperl_env_sync_tables2env
or something like that.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
I have written a small patch to solve this problem. Please have a look
at it. If it looks good, I will write tests and submit the patch.
The scheme is :
1. Populate %ENV before all <Perl>..</Perl>, PerlRequire and PerlModule.
2. After every <Perl>..</Perl>, PerlRequire and PerlModule, sync
server tables ( scfg->SetEnv & scfg->PassEnv ) with %ENV.
Thanks,
Pratik
diff -ru mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c
patches/mymp2/mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c
--- mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c 2004-12-12
13:49:11.000000000 -0800
+++ patches/mymp2/mod_perl-2.0.0-RC1/src/modules/perl/modperl_cmd.c 2004-12-22
09:12:22.000000000 -0800
@@ -219,9 +219,11 @@
MP_TRACE_d(MP_FUNC, "load PerlModule %s\n", arg);
MP_PERL_OVERRIDE_CONTEXT;
+ modperl_env_configure_server(aTHX_ parms->pool, parms->server);
if (!modperl_require_module(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
MP_PERL_RESTORE_CONTEXT;
return error;
@@ -250,11 +252,13 @@
char *error = NULL;
MP_TRACE_d(MP_FUNC, "load PerlRequire %s\n", arg);
+ modperl_env_configure_server(aTHX_ parms->pool, parms->server);
MP_PERL_OVERRIDE_CONTEXT;
if (!modperl_require_file(aTHX_ arg, FALSE)) {
error = SvPVX(ERRSV);
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
MP_PERL_RESTORE_CONTEXT;
return error;
@@ -544,7 +548,9 @@
ENTER;SAVETMPS;
save_scalar(gv); /* local $0 */
sv_setpv_mg(GvSV(gv), directive->filename);
+ modperl_env_configure_server(aTHX_ p, s);
eval_pv(arg, FALSE);
+ modperl_env_sync_server(aTHX_ p, s);
FREETMPS;LEAVE;
}
@@ -640,6 +646,7 @@
if ((errmsg = modperl_cmd_modules(parms, mconfig, arg))) {
return errmsg;
}
+ modperl_env_sync_server(aTHX_ parms->pool, parms->server);
return NULL;
}
diff -ru mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c
patches/mymp2/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c
--- mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c 2004-12-12
13:49:11.000000000 -0800
+++ patches/mymp2/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.c 2004-12-22
09:12:47.000000000 -0800
@@ -153,6 +153,43 @@
"PATH", "TZ", NULL
};
+static void modperl_env_sync_table(pTHX_ apr_table_t *table)
+{
+ HV *hv = ENVHV;
+ U32 mg_flags;
+ int i;
+ const apr_array_header_t *array;
+ apr_table_entry_t *elts;
+
+ modperl_env_untie(mg_flags);
+
+ array = apr_table_elts(table);
+ elts = (apr_table_entry_t *)array->elts;
+
+ for (i = 0; i < array->nelts; i++) {
+ char *val;
+
+ if (!elts[i].key || !elts[i].val) {
+ continue;
+ }
+ val = getenv(elts[i].key);
+ apr_table_set(table, elts[i].key, val);
+ }
+
+ modperl_env_tie(mg_flags);
+}
+
+void modperl_env_sync_server(pTHX_ apr_pool_t *p, server_rec *s)
+{
+ MP_dSCFG(s);
+
+ /* Make per-server PerlSetEnv and PerlPassEnv in sync with %ENV
+ * at config time
+ */
+ modperl_env_sync_table(aTHX_ scfg->SetEnv);
+ modperl_env_sync_table(aTHX_ scfg->PassEnv);
+}
+
void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
{
MP_dSCFG(s);
diff -ru mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h
patches/mymp2/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h
--- mp2src/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h 2004-12-12
13:49:11.000000000 -0800
+++ patches/mymp2/mod_perl-2.0.0-RC1/src/modules/perl/modperl_env.h 2004-12-22
09:12:34.000000000 -0800
@@ -33,6 +33,8 @@
void modperl_env_clear(pTHX);
+void modperl_env_sync_server(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);
--
http://pratik.syslock.org
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> I believe that if effect is not in sync with the order of occurrence,
> it can create confusions. Probably, one possible solution ( and
> probably the simplest one ) is to populate %ENV before any
> <Perl>..</Perl> block.
You mean, leave things as they are, but just enforce populating %ENV
before any <Perl>..</Perl> block. What about PerlModule/PerlRequire?
Shouldn't it be the same?
> I'd be interested in writing the patch for this if required. But it
> will be really great to have this issue sorted out. Becaue without it,
> we will not be able to upgrade to mp2 :(
We hear your pains, Pratik and would love get it fixed before 2.0.0 is
out. Patches are always welcome, but personally I prefer to spec things
out before spending any time on coding. But if you think that it'll
resolve your problem, then just go ahead and do it. But please also add
appropriate tests, so this feature is tested. Thanks.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
I believe that if effect is not in sync with the order of occurrence,
it can create confusions. Probably, one possible solution ( and
probably the simplest one ) is to populate %ENV before any
<Perl>..</Perl> block.
I'd be interested in writing the patch for this if required. But it
will be really great to have this issue sorted out. Becaue without it,
we will not be able to upgrade to mp2 :(
Thanks,
Pratik
On Thu, 16 Dec 2004 18:08:48 -0500, Stas Bekman <st...@stason.org> wrote:
>
> >>1) copy environ to %ENV and detach at the very beginning.
> >>
> >>now if a vhost with its own interpreter changes %ENV it won't affect the
> >>base server.
> >
> >
> > Each vhost will be able to have its own <Perl> sections and/or
> > PerlRequire, independent from the main server config, right?
>
> Oops, this is a problem. No, only vhosts with their own perl interpreter
> can have a different %ENV.
>
> In order to make those things independent per vhost,
>
> Perl(Pass|Set)Env will affect only the right vhost/base, but any
> manipulation in the perl code will affect them all, since there is only
> one %ENV.
>
> >>if you set $ENV{MYFOO} at startup it won't stay around, unless you
> >>explicitly asked to post it forward. What I don't like about it is that
> >>$ENV{PATH} is set in the perl code (e.g. startup), but needs to be
> >>marked in httpd.conf, that's ugly.
> >
> >
> > Yes, if you assume that setting something in %ENV at startup implies the
> > equivalent of PerlPassEnv, you shouldn't need to explicitly do the
> > PerlPassEnv for it. I think 99% of the time I've touched %ENV in startup
> > code, it was something that needed to be passed along, so it would be nice
> > if that happened automatically. If you needed something in %ENV at
> > startup but did *not* want it passed along, either do it in a localized
> > %ENV, or delete from %ENV after use in your startup code.
>
> right, that's the idea
>
> >>How about this solution:
> >
> > [... lots of steps ...]
> >
> >>How does that sound?
> >
> >
> > Sounds good to me - I think you're basically getting at:
> >
> > - Startup code %ENV initially contains copy of original environ from shell
> > - %ENV passed along to workers will contain only those keys that are:
> > 1) Specified in PerlPassEnv or PerlSetEnv directives, or
> > 2) Set/modified in unlocalized %ENV by startup code
>
> That's correct.
>
> In fact PerlPassEnv could be emulated from perl by:
>
> $ENV{FOO} = $ENV{FOO};
>
> since it performs a set operation.
>
> >>The only remaining problem that I see is PerlSetEnv, if there is a
> >>PerlRequire'd file and PerlSetEnv, and both try to set/modify the same
> >>entry, it's not the order in httpd.conf that will determine which is the
> >>latest value, but the order of evalution of PerlRequire vs. PerlSetEnv.
> >>
> >>Another thing to ensure is that PerlSetEnv is run before PerlRequire,
> >>since it's possible that the file will want to refer to the ENV var set
> >>by PerlSetEnv.
> >
> >
> > I don't think that is a problem, if the precedence rule is made clear that
> > all PerlSetEnv are always evaluated first regardless of position. If it
> > worked that way, you would still be able to have a PerlRequire or <Perl>
> > section that relied on the setting of a PerlSetEnv, e.g. these would do
> > the same thing:
> >
> > PerlSetEnv FOO 1
> > PerlRequire my::Module (internally uses $ENV{FOO})
> >
> > or (less obvious)
> >
> > PerlRequire my::Module (internally uses $ENV{FOO})
> > PerlSetEnv FOO 1
> >
> > What you would *not* be able to do is this:
> >
> > PerlRequire my::Module (internally sets $ENV{FOO})
> > PerlSetEnv FOO 1 (to override the module setting)
> >
> > But that is ok because instead you could do:
> >
> > PerlRequire my::Module (internally sets $ENV{FOO})
> > <Perl>
> > $ENV{FOO} = 1; (to override the module setting)
> > </Perl>
> >
> >
> > It is sounding like the rules would be:
> >
> > 1) Evaluate all PerlSetEnv first, in order of occurrence
> > 2) Evaluate all PerlRequire and <Perl> sections in main server config,
> > in order of occurrence
> > 3) Evaluate all PerlRequire and <Perl> sections in each vhost, in order of
> > occurrence (each vhost could have a different %ENV at this point)
> > 4) For each interpreter, clean up %ENV (according to delete list rules you
> > described) before passing to workers
> >
> > Is this what you mean?
>
> As you have raised the problem of vhosts, this is probably not a way to
> go. I think what we could do is having PerlSetEnv and PerlPassEnv have no
> effect at startup phase at all, so if you need to manipulate any env vars
> at startup, you just do it from Perl. when you are done with all the
> manipulations in perl and the post_config phase is over, we can now apply
> PerlSetEnv and PerlPassEnv, the former will override any settings done
> from Perl until this moment. And in which case things will work correctly
> across vhosts. i.e. you will be able to set two different values for the
> same key in two different hosts (but only for post_config phases). Is
> there a problem with this approach?
>
> --
> __________________________________________________________________
> Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/ mod_perl Guide ---> http://perl.apache.org
> mailto:stas@stason.org http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org http://ticketmaster.com
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
>
>
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
>>1) copy environ to %ENV and detach at the very beginning.
>>
>>now if a vhost with its own interpreter changes %ENV it won't affect the
>>base server.
>
>
> Each vhost will be able to have its own <Perl> sections and/or
> PerlRequire, independent from the main server config, right?
Oops, this is a problem. No, only vhosts with their own perl interpreter
can have a different %ENV.
In order to make those things independent per vhost,
Perl(Pass|Set)Env will affect only the right vhost/base, but any
manipulation in the perl code will affect them all, since there is only
one %ENV.
>>if you set $ENV{MYFOO} at startup it won't stay around, unless you
>>explicitly asked to post it forward. What I don't like about it is that
>>$ENV{PATH} is set in the perl code (e.g. startup), but needs to be
>>marked in httpd.conf, that's ugly.
>
>
> Yes, if you assume that setting something in %ENV at startup implies the
> equivalent of PerlPassEnv, you shouldn't need to explicitly do the
> PerlPassEnv for it. I think 99% of the time I've touched %ENV in startup
> code, it was something that needed to be passed along, so it would be nice
> if that happened automatically. If you needed something in %ENV at
> startup but did *not* want it passed along, either do it in a localized
> %ENV, or delete from %ENV after use in your startup code.
right, that's the idea
>>How about this solution:
>
> [... lots of steps ...]
>
>>How does that sound?
>
>
> Sounds good to me - I think you're basically getting at:
>
> - Startup code %ENV initially contains copy of original environ from shell
> - %ENV passed along to workers will contain only those keys that are:
> 1) Specified in PerlPassEnv or PerlSetEnv directives, or
> 2) Set/modified in unlocalized %ENV by startup code
That's correct.
In fact PerlPassEnv could be emulated from perl by:
$ENV{FOO} = $ENV{FOO};
since it performs a set operation.
>>The only remaining problem that I see is PerlSetEnv, if there is a
>>PerlRequire'd file and PerlSetEnv, and both try to set/modify the same
>>entry, it's not the order in httpd.conf that will determine which is the
>>latest value, but the order of evalution of PerlRequire vs. PerlSetEnv.
>>
>>Another thing to ensure is that PerlSetEnv is run before PerlRequire,
>>since it's possible that the file will want to refer to the ENV var set
>>by PerlSetEnv.
>
>
> I don't think that is a problem, if the precedence rule is made clear that
> all PerlSetEnv are always evaluated first regardless of position. If it
> worked that way, you would still be able to have a PerlRequire or <Perl>
> section that relied on the setting of a PerlSetEnv, e.g. these would do
> the same thing:
>
> PerlSetEnv FOO 1
> PerlRequire my::Module (internally uses $ENV{FOO})
>
> or (less obvious)
>
> PerlRequire my::Module (internally uses $ENV{FOO})
> PerlSetEnv FOO 1
>
> What you would *not* be able to do is this:
>
> PerlRequire my::Module (internally sets $ENV{FOO})
> PerlSetEnv FOO 1 (to override the module setting)
>
> But that is ok because instead you could do:
>
> PerlRequire my::Module (internally sets $ENV{FOO})
> <Perl>
> $ENV{FOO} = 1; (to override the module setting)
> </Perl>
>
>
> It is sounding like the rules would be:
>
> 1) Evaluate all PerlSetEnv first, in order of occurrence
> 2) Evaluate all PerlRequire and <Perl> sections in main server config,
> in order of occurrence
> 3) Evaluate all PerlRequire and <Perl> sections in each vhost, in order of
> occurrence (each vhost could have a different %ENV at this point)
> 4) For each interpreter, clean up %ENV (according to delete list rules you
> described) before passing to workers
>
> Is this what you mean?
As you have raised the problem of vhosts, this is probably not a way to
go. I think what we could do is having PerlSetEnv and PerlPassEnv have no
effect at startup phase at all, so if you need to manipulate any env vars
at startup, you just do it from Perl. when you are done with all the
manipulations in perl and the post_config phase is over, we can now apply
PerlSetEnv and PerlPassEnv, the former will override any settings done
from Perl until this moment. And in which case things will work correctly
across vhosts. i.e. you will be able to set two different values for the
same key in two different hosts (but only for post_config phases). Is
there a problem with this approach?
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Larry Leszczynski <la...@emailplus.org>.
On Thu, 16 Dec 2004, Stas Bekman wrote:
> In fact this will do exactly the same:
>
> PerlPassEnv PATH
> <Perl>
> $ENV{PATH} = $ENV{INSTANCE} eq 'development'
> ? "$ENV{PATH}:/extra/devl/path/needed/by/my/modules"
> : "$ENV{PATH}:/extra/prod/path/needed/by/my/modules";
> </Perl>
Yes, I was not trying to imply that order in httpd.conf mattered, only
order of evaluation.
> 1) copy environ to %ENV and detach at the very beginning.
>
> now if a vhost with its own interpreter changes %ENV it won't affect the
> base server.
Each vhost will be able to have its own <Perl> sections and/or
PerlRequire, independent from the main server config, right?
> if you set $ENV{MYFOO} at startup it won't stay around, unless you
> explicitly asked to post it forward. What I don't like about it is that
> $ENV{PATH} is set in the perl code (e.g. startup), but needs to be
> marked in httpd.conf, that's ugly.
Yes, if you assume that setting something in %ENV at startup implies the
equivalent of PerlPassEnv, you shouldn't need to explicitly do the
PerlPassEnv for it. I think 99% of the time I've touched %ENV in startup
code, it was something that needed to be passed along, so it would be nice
if that happened automatically. If you needed something in %ENV at
startup but did *not* want it passed along, either do it in a localized
%ENV, or delete from %ENV after use in your startup code.
> How about this solution:
[... lots of steps ...]
> How does that sound?
Sounds good to me - I think you're basically getting at:
- Startup code %ENV initially contains copy of original environ from shell
- %ENV passed along to workers will contain only those keys that are:
1) Specified in PerlPassEnv or PerlSetEnv directives, or
2) Set/modified in unlocalized %ENV by startup code
> The only remaining problem that I see is PerlSetEnv, if there is a
> PerlRequire'd file and PerlSetEnv, and both try to set/modify the same
> entry, it's not the order in httpd.conf that will determine which is the
> latest value, but the order of evalution of PerlRequire vs. PerlSetEnv.
>
> Another thing to ensure is that PerlSetEnv is run before PerlRequire,
> since it's possible that the file will want to refer to the ENV var set
> by PerlSetEnv.
I don't think that is a problem, if the precedence rule is made clear that
all PerlSetEnv are always evaluated first regardless of position. If it
worked that way, you would still be able to have a PerlRequire or <Perl>
section that relied on the setting of a PerlSetEnv, e.g. these would do
the same thing:
PerlSetEnv FOO 1
PerlRequire my::Module (internally uses $ENV{FOO})
or (less obvious)
PerlRequire my::Module (internally uses $ENV{FOO})
PerlSetEnv FOO 1
What you would *not* be able to do is this:
PerlRequire my::Module (internally sets $ENV{FOO})
PerlSetEnv FOO 1 (to override the module setting)
But that is ok because instead you could do:
PerlRequire my::Module (internally sets $ENV{FOO})
<Perl>
$ENV{FOO} = 1; (to override the module setting)
</Perl>
It is sounding like the rules would be:
1) Evaluate all PerlSetEnv first, in order of occurrence
2) Evaluate all PerlRequire and <Perl> sections in main server config,
in order of occurrence
3) Evaluate all PerlRequire and <Perl> sections in each vhost, in order of
occurrence (each vhost could have a different %ENV at this point)
4) For each interpreter, clean up %ENV (according to delete list rules you
described) before passing to workers
Is this what you mean?
Larry Leszczynski
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Larry Leszczynski wrote:
> Hi Stas -
>
>
>>I propose the following "simple" solution:
>>
>>1) Keep %ENV intact at the server startup, so anything set in the shell is
>>seen from perl
>>2) PerlPassEnv and PerlSetEnv aren't run yet but postponed to until after
>>post_config.
>>3) just before starting workers, detach %ENV from environ, cleaning it up
>>completely. now run PerlPassEnv and PerlSetEnv from (2)
>>
>>That way we don't have to deal with the painful timing of PerlPassEnv and
>>PerlSetEnv. We simply document that those have an affect *only*
>>post-post_config phase, i.e. starting from child_init phase. If someone
>>wants to modify %ENV as it's seen from shell, they can just do that with
>><Perl> sections.
>
>
> I like it a lot, it should be easy for people to understand the flow.
>
> Just want to make sure I understand something: I think in #3 above when
> you say "cleaning it up completely", you mean cleaning up environ
> completely (so workers don't inherit) but keeping %ENV available for
> PerlPassEnv, right? So I should be able to do something like this:
>
> (assume shell env has PATH and INSTANCE variables set)
>
> <Perl>
> $ENV{PATH} = $ENV{INSTANCE} eq 'development'
> ? "$ENV{PATH}:/extra/devl/path/needed/by/my/modules"
> : "$ENV{PATH}:/extra/prod/path/needed/by/my/modules";
> </Perl>
>
> PerlPassEnv PATH
>
> (now worker %ENV contains modified PATH, but not INSTANCE)
>
>
> Yes?
Yes. Good thinking, Larry.
In fact this will do exactly the same:
PerlPassEnv PATH
<Perl>
$ENV{PATH} = $ENV{INSTANCE} eq 'development'
? "$ENV{PATH}:/extra/devl/path/needed/by/my/modules"
: "$ENV{PATH}:/extra/prod/path/needed/by/my/modules";
</Perl>
It will just keep the latest %ENV value, if you ever called: PerlPassEnv
or PerlSetEnv.
There is one tricky issue though. There is only one %ENV, so a vhost with
its own interpreter changing %ENV will affect the base server too. So may
be a better solution is this:
1) copy environ to %ENV and detach at the very beginning.
now if a vhost with its own interpreter changes %ENV it won't affect the
base server.
2) when the post_config phases ends we clear all %ENV fields, which
weren't mentioned in PerlPassEnv or PerlSetEnv.
But, that will mean that if you set $ENV{MYFOO} at startup it won't stay
around, unless you explicitly asked to post it forward. What I don't like
about it is that $ENV{PATH} is set in the perl code (e.g. startup), but
needs to be marked in httpd.conf, that's ugly.
How about this solution:
1) at the beginning make a copy of the keys of original environ, which is
maintained as a delete list:
delete_list: HOME USER SHELL PATH
%ENV{qw(HOME USER SHELL PATH);
2) if any of the existing keys is modified, let's say PATH, it gets
removed from the delete list, so:
$ENV{PATH} = "/tmp";
results in:
delete_list: HOME USER SHELL
%ENV{qw(HOME USER SHELL PATH);
3) if PerlPassEnv is called, the delete_list is adjusted to remove that
key. So if:
PerlPassEnv USER
is called we now have:
delete_list: HOME SHELL
%ENV{qw(HOME USER SHELL PATH);
4) if a new key/value pair is added (or deleted) w/o localizing %ENV (via
perl code or PerlSetEnv), it's added to %ENV, e.g. if:
PerlSetEnv FOO 1
<Perl> $ENV{BAR}
results in:
delete_list: HOME SHELL
%ENV{qw(HOME USER SHELL PATH FOO BAR);
5) finally after the post_config phase and before child_init phase, we
cleanup %ENV using the delete_list, which leaves us with:
delete_list:
%ENV{qw(USER PATH FOO BAR);
How does that sound?
The only remaining problem that I see is PerlSetEnv, if there is a
PerlRequire'd file and PerlSetEnv, and both try to set/modify the same
entry, it's not the order in httpd.conf that will determine which is the
latest value, but the order of evalution of PerlRequire vs. PerlSetEnv.
Another thing to ensure is that PerlSetEnv is run before PerlRequire,
since it's possible that the file will want to refer to the ENV var set by
PerlSetEnv.
Oh boy, I'm sure you can find lots of holes in this proposal :( That's a
tricky business.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Larry Leszczynski <la...@emailplus.org>.
Hi Stas -
> I propose the following "simple" solution:
>
> 1) Keep %ENV intact at the server startup, so anything set in the shell is
> seen from perl
> 2) PerlPassEnv and PerlSetEnv aren't run yet but postponed to until after
> post_config.
> 3) just before starting workers, detach %ENV from environ, cleaning it up
> completely. now run PerlPassEnv and PerlSetEnv from (2)
>
> That way we don't have to deal with the painful timing of PerlPassEnv and
> PerlSetEnv. We simply document that those have an affect *only*
> post-post_config phase, i.e. starting from child_init phase. If someone
> wants to modify %ENV as it's seen from shell, they can just do that with
> <Perl> sections.
I like it a lot, it should be easy for people to understand the flow.
Just want to make sure I understand something: I think in #3 above when
you say "cleaning it up completely", you mean cleaning up environ
completely (so workers don't inherit) but keeping %ENV available for
PerlPassEnv, right? So I should be able to do something like this:
(assume shell env has PATH and INSTANCE variables set)
<Perl>
$ENV{PATH} = $ENV{INSTANCE} eq 'development'
? "$ENV{PATH}:/extra/devl/path/needed/by/my/modules"
: "$ENV{PATH}:/extra/prod/path/needed/by/my/modules";
</Perl>
PerlPassEnv PATH
(now worker %ENV contains modified PATH, but not INSTANCE)
Yes?
Thanks,
Larry Leszczynski
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Geoffrey Young wrote:
>>>PerlPassEnv HOME
>>>PerlPassEnv PORT
>>><Perl>
>>>$ServerRoot = $ENV{HOME} . "/web";
>>>$DocumentRoot = $ENV{HOME} . "/web/public" ;
>>>$Listen = $ENV{PORT};
>>></Perl>
>>
>>
>>Thanks for the example, Pratik. Now it's more clear to me.
>>
>>I propose the following "simple" solution:
>>
>>1) Keep %ENV intact at the server startup, so anything set in the shell
>>is seen from perl
>
>
> which would make the above PerlPassEnv directives unnecessary, right? at
> least insofar as <Perl> sections are concerned? that sounds fine to me.
Right. You will still want them if you need to get them after post_config
phase.
>>2) PerlPassEnv and PerlSetEnv aren't run yet but postponed to until
>>after post_config.
>>3) just before starting workers, detach %ENV from environ, cleaning it
>>up completely. now run PerlPassEnv and PerlSetEnv from (2)
>
>
> nice.
I just need to check that Apache doesn't already nuke environ somewhere on
the way.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Geoffrey Young <ge...@modperlcookbook.org>.
>> PerlPassEnv HOME
>> PerlPassEnv PORT
>> <Perl>
>> $ServerRoot = $ENV{HOME} . "/web";
>> $DocumentRoot = $ENV{HOME} . "/web/public" ;
>> $Listen = $ENV{PORT};
>> </Perl>
>
>
> Thanks for the example, Pratik. Now it's more clear to me.
>
> I propose the following "simple" solution:
>
> 1) Keep %ENV intact at the server startup, so anything set in the shell
> is seen from perl
which would make the above PerlPassEnv directives unnecessary, right? at
least insofar as <Perl> sections are concerned? that sounds fine to me.
> 2) PerlPassEnv and PerlSetEnv aren't run yet but postponed to until
> after post_config.
> 3) just before starting workers, detach %ENV from environ, cleaning it
> up completely. now run PerlPassEnv and PerlSetEnv from (2)
nice.
--Geoff
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
>
> Thanks for the example, Pratik. Now it's more clear to me.
>
> I propose the following "simple" solution:
>
> 1) Keep %ENV intact at the server startup, so anything set in the shell is
> seen from perl
> 2) PerlPassEnv and PerlSetEnv aren't run yet but postponed to until after
> post_config.
> 3) just before starting workers, detach %ENV from environ, cleaning it up
> completely. now run PerlPassEnv and PerlSetEnv from (2)
>
This sounds very good.
Regards,
Pratik
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> The sample configuration file which I assume to be pretty common, can
> be something like below :
>
> ==============================
> PerlPassEnv APP_HOME
> <Perl>
> @Include = "$ENV{APP_HOME}/conf/common.conf";
> </Perl>
>
> PerlPassEnv HOME
> PerlPassEnv PORT
> <Perl>
> $ServerRoot = $ENV{HOME} . "/web";
> $DocumentRoot = $ENV{HOME} . "/web/public" ;
> $Listen = $ENV{PORT};
> </Perl>
Thanks for the example, Pratik. Now it's more clear to me.
I propose the following "simple" solution:
1) Keep %ENV intact at the server startup, so anything set in the shell is
seen from perl
2) PerlPassEnv and PerlSetEnv aren't run yet but postponed to until after
post_config.
3) just before starting workers, detach %ENV from environ, cleaning it up
completely. now run PerlPassEnv and PerlSetEnv from (2)
That way we don't have to deal with the painful timing of PerlPassEnv and
PerlSetEnv. We simply document that those have an affect *only*
post-post_config phase, i.e. starting from child_init phase. If someone
wants to modify %ENV as it's seen from shell, they can just do that with
<Perl> sections.
Opinions?
So Pratiks example will become just:
<Perl>
@Include = "$ENV{APP_HOME}/conf/common.conf";
</Perl>
<Perl>
$ServerRoot = $ENV{HOME} . "/web";
$DocumentRoot = $ENV{HOME} . "/web/public" ;
$Listen = $ENV{PORT};
</Perl>
assuming that you don't need any of those ENV vars after config phase.
In fact this makes %ENV even smaller.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
> PerlSetEnv was originally designed to make Env setting be visible before
> the response phase (which is what SetEnv did). So I think you are simply
> misusing this feature and the doc should just say, that PerlSetEnv takes
> effect only in post_config phase and drop any semi-complete support in
> <Perl> sections (i.e. dropping modperl_env_configure_server() completely).
I don't think that droping modperl_env_configure_server() completely
is a good idea. As it will also disable the use of PerlPassEnv in
config phase. And I am pretty sure that would break a lot of large
setups based on mod perl including ours.
We have a large setup based on mod perl. We are running a couple of
different applications which share common configuration file.
The sample configuration file which I assume to be pretty common, can
be something like below :
==============================
PerlPassEnv APP_HOME
<Perl>
@Include = "$ENV{APP_HOME}/conf/common.conf";
</Perl>
PerlPassEnv HOME
PerlPassEnv PORT
<Perl>
$ServerRoot = $ENV{HOME} . "/web";
$DocumentRoot = $ENV{HOME} . "/web/public" ;
$Listen = $ENV{PORT};
</Perl>
==============================
There could be certain operations dealing with $ENV{PATH} and
$ENV{LD_LIBRARY_PATH} in the commong.conf file.
Regards,
Pratik
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Pratik <pr...@gmail.com>.
> Another option is not to use <Perl> sections for anything but Apache
> config. do you need to have this <Perl> section that you've the problem
> with during config phase? If not move it into post_config phase and your
> problem is solved.
Actually, I need to use %ENV variables for Apache config. So, it won't
be possible for me to move it into post_config phase. Also, I can't
have all PerlPassEnv statements before the first <Perl>..</Perl>
section with some minor modifications..
>
> Another alternative is to drop:
>
> PerlSetEnv MyVar "Hello"
>
> and instead use:
>
> <Perl>
> $ENV{MyVar} = "Hello";
> </Perl>
The issue is there with PerlPassEnv as well.
>
> PerlSetEnv was originally designed to make Env setting be visible before
> the response phase (which is what SetEnv did). So I think you are simply
> misusing this feature and the doc should just say, that PerlSetEnv takes
> effect only in post_config phase and drop any semi-complete support in
> <Perl> sections (i.e. dropping modperl_env_configure_server() completely).
>
Any suggestions / workarounds ?
Regards,
Pratik
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: [mp2 bug] Perl*Env issues
Posted by Stas Bekman <st...@stason.org>.
Pratik wrote:
> I am having the following apache configuration file.
>
> ==============================
> % cat ~/lab/mp2/test/httpd.conf
> ServerRoot "/home/pvnaik/lab/mp2/test"
> Timeout 300
> DocumentRoot "/home/pvnaik/lab/mp2/test/webdocs"
> ErrorLog logs/error_log
> Listen 44951
>
> PerlModule Apache2
>
> <Perl>
> ;
> </Perl>
>
> PerlSetEnv MyVar "Hello"
>
> <Perl>
> print "HELLO = ", $ENV{MyVar}, "\n";
> </Perl>
>
> ==============================
>
> Now, the output is :
>
> ==============================
> % ~/lab/mymp2/mp2/bin/httpd -X -f ~/lab/mp2/test/httpd.conf
> HELLO =
> HELLO =
> ==============================
>
> This is happening because, initialization of %ENV will take place when
> the first <Perl>..</Perl>. And all the subsequent PerlPassEnv and
> PerlSetEnv values will be stored only in scfg->SetEnv table and won't
> be copied to %ENV.
>
> This issue was previously discussed at
> http://gossamer-threads.com/lists/modperl/dev/7256
>
> The same patch would be something like below now :
>
> ==============================
> % diff -u modperl_cmd.c~ modperl_cmd.c
> --- modperl_cmd.c~ 2004-12-14 03:12:14.000000000 -0800
> +++ modperl_cmd.c 2004-12-14 09:35:47.000000000 -0800
> @@ -545,6 +545,8 @@
> ENTER;SAVETMPS;
> save_scalar(gv); /* local $0 */
> sv_setpv_mg(GvSV(gv), directive->filename);
> + /* Populate %ENV */
> + modperl_env_configure_server(aTHX_ p, s);
> eval_pv(arg, FALSE);
> FREETMPS;LEAVE;
> }
> ==============================
>
> This patch seems to be working fine for me. But probably, calling
> modperl_env_configure_server() for every eval_pv would be a bit
> costly.
>
> Another option may be to call modperl_env_hv_store():modperl_env.c
> from MP_CMD_SRV_DECLARE2(set_env) and MP_CMD_SRV_DECLARE(pass_env) of
> modperl_cmd.c.
Another option is not to use <Perl> sections for anything but Apache
config. do you need to have this <Perl> section that you've the problem
with during config phase? If not move it into post_config phase and your
problem is solved.
Another alternative is to drop:
PerlSetEnv MyVar "Hello"
and instead use:
<Perl>
$ENV{MyVar} = "Hello";
</Perl>
PerlSetEnv was originally designed to make Env setting be visible before
the response phase (which is what SetEnv did). So I think you are simply
misusing this feature and the doc should just say, that PerlSetEnv takes
effect only in post_config phase and drop any semi-complete support in
<Perl> sections (i.e. dropping modperl_env_configure_server() completely).
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org