stas 2003/09/22 16:29:52
Modified: src/modules/perl modperl_env.c modperl_env.h Log: add modperl_env_request_unpopulate and supporting function, to be able to delete entries from %ENV populated for the request due to SetupEnv/perl-script. Revision Changes Path 1.29 +52 -0 modperl-2.0/src/modules/perl/modperl_env.c Index: modperl_env.c =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.c,v retrieving revision 1.28 retrieving revision 1.29 diff -u -u -r1.28 -r1.29 --- modperl_env.c 22 Sep 2003 23:25:54 -0000 1.28 +++ modperl_env.c 22 Sep 2003 23:29:52 -0000 1.29 @@ -32,6 +32,15 @@ SvTAINTED_on(*svp); } +static MP_INLINE +void modperl_env_hv_delete(pTHX_ HV *hv, char *key) +{ + I32 klen = strlen(key); + if (hv_exists(hv, key, klen)) { + hv_delete(hv, key, strlen(key), G_DISCARD); + } +} + typedef struct { const char *key; I32 klen; @@ -102,6 +111,31 @@ modperl_env_tie(mg_flags); } +static void modperl_env_table_unpopulate(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++) { + if (!elts[i].key) { + 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); +} + /* list of environment variables to pass by default */ static const char *MP_env_pass_defaults[] = { "PATH", "TZ", NULL @@ -205,6 +239,24 @@ #endif MpReqSETUP_ENV_On(rcfg); +} + +void modperl_env_request_unpopulate(pTHX_ request_rec *r) +{ + MP_dRCFG; + + /* unset only once */ + if (!MpReqSETUP_ENV(rcfg)) { + return; + } + + MP_TRACE_e(MP_FUNC, + "\n\t[%s/0x%lx/%s%s]\n\tdelete @ENV{keys r->subprocess_env};", + modperl_pid_tid(r->pool), modperl_interp_address(aTHX), + modperl_server_desc(r->server, r->pool), r->uri); + modperl_env_table_unpopulate(aTHX_ r->subprocess_env); + + MpReqSETUP_ENV_Off(rcfg); } void modperl_env_request_tie(pTHX_ request_rec *r) 1.15 +2 -0 modperl-2.0/src/modules/perl/modperl_env.h Index: modperl_env.h =================================================================== RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.h,v retrieving revision 1.14 retrieving revision 1.15 diff -u -u -r1.14 -r1.15 --- modperl_env.h 7 Jul 2003 03:06:14 -0000 1.14 +++ modperl_env.h 22 Sep 2003 23:29:52 -0000 1.15 @@ -26,6 +26,8 @@ void modperl_env_request_populate(pTHX_ request_rec *r); +void modperl_env_request_unpopulate(pTHX_ request_rec *r); + void modperl_env_request_tie(pTHX_ request_rec *r); void modperl_env_request_untie(pTHX_ request_rec *r);