perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Pratik <pratikn...@gmail.com>
Subject Re: [mp2 bug] Perl*Env issues
Date Mon, 27 Dec 2004 15:53:16 GMT
On Thu, 23 Dec 2004 15:24:05 -0500, Stas Bekman <stas@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


Mime
View raw message