perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: modperl-2.0/t/modperl .cvsignore
Date Thu, 15 Nov 2001 03:02:43 GMT
dougm       01/11/14 19:02:43

  Modified:    src/modules/perl mod_perl.c modperl_env.c modperl_env.h
               t/conf   modperl_extra.pl
               t/modperl .cvsignore
  Log:
  more complete implementation of tie %ENV to r->subprocess_env
  
  Revision  Changes    Path
  1.95      +2 -7      modperl-2.0/src/modules/perl/mod_perl.c
  
  Index: mod_perl.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
  retrieving revision 1.94
  retrieving revision 1.95
  diff -u -r1.94 -r1.95
  --- mod_perl.c	2001/11/15 01:30:45	1.94
  +++ mod_perl.c	2001/11/15 03:02:42	1.95
  @@ -147,6 +147,8 @@
           return;
       }
   
  +    modperl_env_init();
  +
       base_perl = modperl_startup(base_server, p);
   
   #ifdef USE_ITHREADS
  @@ -538,21 +540,14 @@
       h_stdout = modperl_io_tie_stdout(aTHX_ r);
       h_stdin  = modperl_io_tie_stdin(aTHX_ r);
   
  -#if 0
  -    /* current implementation of tie %ENV to $r->subprocess_env 
  -     * is not threadsafe
  -     */
       modperl_env_request_tie(aTHX_ r);
  -#endif
   
       retval = modperl_response_handler_run(r, FALSE);
   
       modperl_io_handle_untie(aTHX_ h_stdout);
       modperl_io_handle_untie(aTHX_ h_stdin);
   
  -#if 0
       modperl_env_request_untie(aTHX_ r);
  -#endif
   
       modperl_perl_global_request_restore(aTHX_ r);
   
  
  
  
  1.19      +150 -41   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.18
  retrieving revision 1.19
  diff -u -r1.18 -r1.19
  --- modperl_env.c	2001/11/12 22:14:36	1.18
  +++ modperl_env.c	2001/11/15 03:02:43	1.19
  @@ -1,6 +1,7 @@
   #include "mod_perl.h"
   
   #define EnvMgObj SvMAGIC((SV*)ENVHV)->mg_ptr
  +#define EnvMgLen SvMAGIC((SV*)ENVHV)->mg_len
   
   static MP_INLINE
   void modperl_env_hv_store(pTHX_ HV *hv, apr_table_entry_t *elt)
  @@ -87,7 +88,6 @@
       const apr_array_header_t *array;
       apr_table_entry_t *elts;
   
  -
       if (MpReqSETUP_ENV(rcfg)) {
           return;
       }
  @@ -118,69 +118,178 @@
       MpReqSETUP_ENV_On(rcfg);
   }
   
  -static int modperl_env_request_set(pTHX_ SV *sv, MAGIC *mg)
  +void modperl_env_request_tie(pTHX_ request_rec *r)
   {
  -    const char *key, *val;
  -    STRLEN klen, vlen;
  -    request_rec *r = (request_rec *)EnvMgObj;
  +    EnvMgObj = (char *)r;
  +    EnvMgLen = -1;
  +
  +#ifdef MP_PERL_HV_GMAGICAL_AWARE
  +    SvGMAGICAL_on((SV*)ENVHV);
  +#endif
  +}
  +
  +void modperl_env_request_untie(pTHX_ request_rec *r)
  +{
  +    EnvMgObj = NULL;
  +
  +#ifdef MP_PERL_HV_GMAGICAL_AWARE
  +    SvGMAGICAL_off((SV*)ENVHV);
  +#endif
  +}
  +
  +/* to store the original virtual tables
  + * these are global, not per-interpreter
  + */
  +static MGVTBL MP_PERL_vtbl_env;
  +static MGVTBL MP_PERL_vtbl_envelem;
   
  -    key = (const char *)MgPV(mg,klen);
  -    val = (const char *)SvPV(sv,vlen);
  +#define MP_PL_vtbl_call(name, meth) \
  +    MP_PERL_vtbl_##name.svt_##meth(aTHX_ sv, mg)
   
  -    apr_table_set(r->subprocess_env, key, val);
  +#define MP_dENV_KEY \
  +    STRLEN klen; \
  +    const char *key = (const char *)MgPV(mg,klen)
  +
  +#define MP_dENV_VAL \
  +    STRLEN vlen; \
  +    const char *val = (const char *)SvPV(sv,vlen)
   
  -    /*return magic_setenv(sv, mg);*/
  +/*
  + * XXX: what we do here might change:
  + *      - make it optional for %ENV to be tied to r->subprocess_env
  + *      - make it possible to modify environ
  + *      - we could allow modification of environ if mpm isn't threaded
  + *      - we could allow modification of environ if variable isn't a CGI
  + *        variable (still could cause problems)
  + */
  +/*
  + * problems we are trying to solve:
  + *      - environ is shared between threads
  + *          + Perl does not serialize access to environ
  + *          + even if it did, CGI variables cannot be shared between threads!
  + * problems we create by trying to solve above problems:
  + *      - a forked process will not inherit the current %ENV
  + *      - C libraries might rely on environ, e.g. DBD::Oracle
  + */
  +static int modperl_env_magic_set_all(pTHX_ SV *sv, MAGIC *mg)
  +{
  +    request_rec *r = (request_rec *)EnvMgObj;
   
  +    if (r) {
  +        if (PL_localizing) {
  +            /* local %ENV = (FOO => 'bar', BIZ => 'baz') */
  +            HE *entry;
  +            STRLEN n_a;
  +
  +            hv_iterinit((HV*)sv);
  +            while ((entry = hv_iternext((HV*)sv))) {
  +                I32 keylen;
  +                apr_table_set(r->subprocess_env,
  +                              hv_iterkey(entry, &keylen),
  +                              SvPV(hv_iterval((HV*)sv, entry), n_a));
  +            }
  +        }
  +    }
  +    else {
  +        return MP_PL_vtbl_call(env, set);
  +    }
  +
       return 0;
   }
   
  -#ifdef MP_PERL_HV_GMAGICAL_AWARE
  -static int modperl_env_request_get(pTHX_ SV *sv, MAGIC *mg)
  +static int modperl_env_magic_clear_all(pTHX_ SV *sv, MAGIC *mg)
   {
  -    const char *key, *val;
  -    STRLEN klen;
       request_rec *r = (request_rec *)EnvMgObj;
  -
  -    key = (const char *)MgPV(mg,klen);
   
  -    if ((val = apr_table_get(r->subprocess_env, key))) {
  -        sv_setpv(sv, val);
  +    if (r) {
  +        apr_table_clear(r->subprocess_env);
       }
       else {
  -        sv_setsv(sv, &PL_sv_undef);
  +        return MP_PL_vtbl_call(env, clear);
       }
   
       return 0;
   }
  -#endif
   
  -/*
  - * XXX: PL_vtbl_* are global (not per-interpreter)
  - * so this method of tie-ing is not thread-safe
  - * overridding svt_get is only useful with 5.7.2+ and requires
  - * a smarter lookup than the current modperl_env_request_get
  - */
  -void modperl_env_request_tie(pTHX_ request_rec *r)
  +static int modperl_env_magic_set(pTHX_ SV *sv, MAGIC *mg)
   {
  -    EnvMgObj = (char *)r;
  +    request_rec *r = (request_rec *)EnvMgObj;
   
  -    PL_vtbl_envelem.svt_set = MEMBER_TO_FPTR(modperl_env_request_set);
  -#ifdef MP_PERL_HV_GMAGICAL_AWARE
  -    SvGMAGICAL_on((SV*)ENVHV);
  -    PL_vtbl_envelem.svt_get = MEMBER_TO_FPTR(modperl_env_request_get);
  -#endif
  +    if (r) {
  +        MP_dENV_KEY;
  +        MP_dENV_VAL;
  +        apr_table_set(r->subprocess_env, key, val);
  +    }
  +    else {
  +        return MP_PL_vtbl_call(envelem, set);
  +    }
  +
  +    return 0;
   }
   
  -void modperl_env_request_untie(pTHX_ request_rec *r)
  +static int modperl_env_magic_clear(pTHX_ SV *sv, MAGIC *mg)
   {
  -#if 0
  -    /* XXX: not currently in use.  if enabled Perl_magic_setenv
  -     * is not available to win32
  -     */
  -    PL_vtbl_envelem.svt_set = MEMBER_TO_FPTR(Perl_magic_setenv);
  -#endif
  +    request_rec *r = (request_rec *)EnvMgObj;
  +
  +    if (r) {
  +        MP_dENV_KEY;
  +        apr_table_unset(r->subprocess_env, key);
  +    }
  +    else {
  +        return MP_PL_vtbl_call(envelem, clear);
  +    }
  +
  +    return 0;
  +}
  +
   #ifdef MP_PERL_HV_GMAGICAL_AWARE
  -    SvGMAGICAL_off((SV*)ENVHV);
  -    PL_vtbl_envelem.svt_get = 0;
  +static int modperl_env_magic_get(pTHX_ SV *sv, MAGIC *mg)
  +{
  +    request_rec *r = (request_rec *)EnvMgObj;
  +
  +    if (r) {
  +        MP_dENV_KEY;
  +        const char *val;
  +
  +        if ((val = apr_table_get(r->subprocess_env, key))) {
  +            sv_setpv(sv, val);
  +        }
  +        else {
  +            sv_setsv(sv, &PL_sv_undef);
  +        }
  +    }
  +    else {
  +        /* there is no svt_get in PL_vtbl_envelem */
  +    }
  +
  +    return 0;
  +}
   #endif
  +
  +/* override %ENV virtual tables with our own */
  +static MGVTBL MP_vtbl_env = {
  +    0,
  +    MEMBER_TO_FPTR(modperl_env_magic_set_all),
  +    0,
  +    MEMBER_TO_FPTR(modperl_env_magic_clear_all),
  +    0
  +};
  +
  +static MGVTBL MP_vtbl_envelem =	{
  +    0,
  +    MEMBER_TO_FPTR(modperl_env_magic_set),
  +    0,
  +    MEMBER_TO_FPTR(modperl_env_magic_clear),
  +    0
  +};
  +
  +void modperl_env_init(void)
  +{
  +    /* save originals */
  +    StructCopy(&PL_vtbl_env, &MP_PERL_vtbl_env, MGVTBL);
  +    StructCopy(&PL_vtbl_envelem, &MP_PERL_vtbl_envelem, MGVTBL);
  +
  +    /* replace with our versions */
  +    StructCopy(&MP_vtbl_env, &PL_vtbl_env, MGVTBL);
  +    StructCopy(&MP_vtbl_envelem, &PL_vtbl_envelem, MGVTBL);
   }
  
  
  
  1.10      +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.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- modperl_env.h	2001/10/13 19:11:32	1.9
  +++ modperl_env.h	2001/11/15 03:02:43	1.10
  @@ -23,4 +23,6 @@
   
   void modperl_env_request_untie(pTHX_ request_rec *r);
   
  +void modperl_env_init(void);
  +
   #endif /* MODPERL_ENV_H */
  
  
  
  1.10      +3 -0      modperl-2.0/t/conf/modperl_extra.pl
  
  Index: modperl_extra.pl
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- modperl_extra.pl	2001/10/09 18:01:21	1.9
  +++ modperl_extra.pl	2001/11/15 03:02:43	1.10
  @@ -18,6 +18,9 @@
       die '$ENV{MOD_PERL} not set!';
   }
   
  +#see t/response/TestModperl/env.pm
  +$ENV{MODPERL_EXTRA_PL} = __FILE__;
  +
   my $ap_mods = scalar grep { /^Apache/ } keys %INC;
   my $apr_mods = scalar grep { /^APR/ } keys %INC;
   
  
  
  
  1.7       +1 -0      modperl-2.0/t/modperl/.cvsignore
  
  Index: .cvsignore
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/modperl/.cvsignore,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- .cvsignore	2001/11/13 18:35:08	1.6
  +++ .cvsignore	2001/11/15 03:02:43	1.7
  @@ -1,3 +1,4 @@
  +env.t
   endav.t
   exit.t
   printf.t
  
  
  

Mime
View raw message