cvs commit: modperl-2.0/src/modules/perl modperl_env.c modperl_env.h

[st...@apache.org]

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);