view release on metacpan or  search on metacpan

src/modules/perl/modperl_env.c  view on Meta::CPAN

static const char *MP_env_pass_defaults[] = {
    "PATH", "TZ", NULL
};

void modperl_env_configure_server(pTHX_ apr_pool_t *p, server_rec *s)
{
    MP_dSCFG(s);
    int i = 0;

    /* make per-server PerlSetEnv and PerlPassEnv entries visible
     * to %ENV at config time
     */

    for (i=0; MP_env_pass_defaults[i]; i++) {
        const char *key = MP_env_pass_defaults[i];
        char *val;

        if (apr_table_get(scfg->SetEnv, key) ||
            apr_table_get(scfg->PassEnv, key))
        {
            continue; /* already configured */
        }

        if ((val = getenv(key))) {
            apr_table_set(scfg->PassEnv, key, val);
        }
    }

    MP_TRACE_e(MP_FUNC, "\t[0x%lx/%s]"
               "\n\t@ENV{keys scfg->SetEnv} = values scfg->SetEnv;",
               modperl_interp_address(aTHX),
               modperl_server_desc(s, p));
    modperl_env_table_populate(aTHX_ scfg->SetEnv);

    MP_TRACE_e(MP_FUNC, "\t[0x%lx/%s]"
               "\n\t@ENV{keys scfg->PassEnv} = values scfg->PassEnv;",
               modperl_interp_address(aTHX),
               modperl_server_desc(s, p));
    modperl_env_table_populate(aTHX_ scfg->PassEnv);
}

#define overlay_subprocess_env(r, tab) \
    r->subprocess_env = apr_table_overlay(r->pool, \
                                          r->subprocess_env, \
                                          tab)

void modperl_env_configure_request_dir(pTHX_ request_rec *r)
{
    MP_dRCFG;
    MP_dDCFG;

    /* populate %ENV and r->subprocess_env with per-directory
     * PerlSetEnv entries.
     *
     * note that per-server PerlSetEnv entries, as well as
     * PerlPassEnv entries (which are only per-server), are added
     * to %ENV and r->subprocess_env via modperl_env_configure_request_srv
     */

    if (!apr_is_empty_table(dcfg->SetEnv)) {
        apr_table_t *setenv_copy;

        /* add per-directory PerlSetEnv entries to %ENV
         * collisions with per-server PerlSetEnv entries are
         * resolved via the nature of a Perl hash
         */
        MP_TRACE_e(MP_FUNC, "\t[0x%lx/%s]"
                   "\n\t@ENV{keys dcfg->SetEnv} = values dcfg->SetEnv;",
                   modperl_interp_address(aTHX),
                   modperl_server_desc(r->server, r->pool));
        modperl_env_table_populate(aTHX_ dcfg->SetEnv);

        /* make sure the entries are in the subprocess_env table as well.
         * we need to use apr_table_overlap (not apr_table_overlay) because
         * r->subprocess_env might have per-server PerlSetEnv entries in it
         * and using apr_table_overlay would generate duplicate entries.
         * in order to use apr_table_overlap, though, we need to copy the
         * the dcfg table so that pool requirements are satisfied */

        setenv_copy = apr_table_copy(r->pool, dcfg->SetEnv);
        apr_table_overlap(r->subprocess_env, setenv_copy, APR_OVERLAP_TABLES_SET);
    }

    MpReqPERL_SET_ENV_DIR_On(rcfg);
}

void modperl_env_configure_request_srv(pTHX_ request_rec *r)
{
    MP_dRCFG;
    MP_dSCFG(r->server);

    /* populate %ENV and r->subprocess_env with per-server PerlSetEnv
     * and PerlPassEnv entries.
     *
     * although both are setup in %ENV in modperl_request_configure_server
     * %ENV will be reset via modperl_env_request_unpopulate.
     */

    if (!apr_is_empty_table(scfg->SetEnv)) {
        MP_TRACE_e(MP_FUNC, "\t[0x%lx/%s]"
                   "\n\t@ENV{keys scfg->SetEnv} = values scfg->SetEnv;",
                   modperl_interp_address(aTHX),
                   modperl_server_desc(r->server, r->pool));
        modperl_env_table_populate(aTHX_ scfg->SetEnv);

        overlay_subprocess_env(r, scfg->SetEnv);
    }

    if (!apr_is_empty_table(scfg->PassEnv)) {
        MP_TRACE_e(MP_FUNC, "\t[0x%lx/%s]"
                   "\n\t@ENV{keys scfg->PassEnv} = values scfg->PassEnv;",
                   modperl_interp_address(aTHX),
                   modperl_server_desc(r->server, r->pool));
        modperl_env_table_populate(aTHX_ scfg->PassEnv);

        overlay_subprocess_env(r, scfg->PassEnv);
    }

    MpReqPERL_SET_ENV_SRV_On(rcfg);
}

void modperl_env_default_populate(pTHX)
{
    modperl_env_ent_t *ent = MP_env_const_vars;
    HV *hv = ENVHV;
    U32 mg_flags;

    modperl_env_untie(mg_flags);

    while (ent->key) {
        SV *sv = newSVpvn(ent->val, ent->vlen);
        (void)hv_store(hv, ent->key, ent->klen,
                       sv, ent->hash);
        MP_TRACE_e(MP_FUNC, "$ENV{%s} = \"%s\";", ent->key, ent->val);
        modperl_envelem_tie(sv, ent->key, ent->klen);
        ent++;
    }

    modperl_env_tie(mg_flags);
}