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__, [EMAIL PROTECTED]);
+
+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: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
