/*###################################################################################
#
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
#   Embperl - Copyright (c) 2008-2015 Gerald Richter
#   Embperl - Copyright (c) 2015-2023 actevy.io
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#   For use with Apache httpd and mod_perl, see also Apache copyright.
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
###################################################################################*/
#include "ep.h"
#ifdef APACHE
#include <http_core.h>
#include "epdefault.c"
#if !defined(MOD_EMBPERL) && !defined(EMBPERL_SO)
#define MOD_EMBPERL
#define EMBPERL_SO
#endif
/* use getenv from runtime library and not from Perl */
#undef getenv
#undef getpid
/* define get thread id if not already done by Apache */
/* 05/06/23: Marcus Doemling: do not define gettid for glibc >= 2.30 */
#if !defined(_GNU_SOURCE) || !defined(__GLIBC__) || __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 30)
#ifndef gettid
#ifdef WIN32
#define gettid GetCurrentThreadId
#else
int gettid()
    {
    return 0 ;
    }
#endif
#endif
#endif
#ifndef APACHE2
/* from mod_perl 1.x */
apr_pool_t * perl_get_startup_pool (void)
{
    SV *sv ;
    dTHX ;
    sv = perl_get_sv("Apache::__POOL", FALSE);
    if(sv) {
        IV tmp = SvIV((SV*)SvRV(sv));
        return (pool *)tmp;
    }
    return NULL;
}
#endif
/* debugging by default off, enable with httpd -D EMBPERL_APDEBUG */
static int bApDebug = 0 ;
static int bApInit  = 0 ;
/* subpool to get notified on unload */
static apr_pool_t * unload_subpool ;
/* --- declare config datastructure --- */
#define EPCFG_STR EPCFG
#define EPCFG_INT EPCFG
#define EPCFG_INTOPT EPCFG
#define EPCFG_BOOL EPCFG
#define EPCFG_CHAR EPCFG
#define EPCFG_EXPIRES EPCFG_STR
#define EPCFG_CV EPCFG_SAVE
#define EPCFG_SV EPCFG_SAVE
#define EPCFG_HV EPCFG_SAVE
#define EPCFG_REGEX EPCFG_SAVE
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,SEPARATOR) EPCFG_SAVE(STRUCT,TYPE,NAME,CFGNAME)
#define EPCFG_APP    
#define EPCFG_REQ   
#define EPCFG_COMPONENT   
#define EPCFG(STRUCT,TYPE,NAME,CFGNAME)   int  set_##STRUCT##NAME:1 ;
#define EPCFG_SAVE(STRUCT,TYPE,NAME,CFGNAME)  \
     int  set_##STRUCT##NAME:1 ; \
     char *  save_##STRUCT##NAME ; 
struct tApacheDirConfig
    {
    tPerlInterpreter * pPerlTHX ;                  /* pointer to Perl interpreter */
    tAppConfig       AppConfig ;
    tReqConfig       ReqConfig ;
    tComponentConfig ComponentConfig ;
    int              bUseEnv ;
    /* flags if config directive is given in context */
#include "epcfg.h"
    }  ;
#ifdef MOD_EMBPERL
/* --- declare other function prototypes --- */
#ifdef APACHE2
static int embperl_ApacheInit (apr_pool_t *p, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s) ;
static int embperl_ApachePostConfig (apr_pool_t *p, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s) ;
static apr_status_t embperl_ApacheInitCleanup (void * p) ;
#else
static void embperl_ApacheInitCleanup (void * p) ;
static void embperl_ApacheInit (server_rec *s, apr_pool_t *p) ;
#endif
static const char * embperl_Apache_Config_useenv (cmd_parms *cmd, /*tApacheDirConfig*/ void * pDirCfg, int arg) ;
static void *embperl_create_dir_config(apr_pool_t *p, char *d) ;
static void *embperl_create_server_config(apr_pool_t *p, server_rec *s) ;
static void *embperl_merge_dir_config (apr_pool_t *p, void *basev, void *addv) ;
/* --- declare config function prototypes --- */
#undef EPCFG_SAVE
#define EPCFG_SAVE EPCFG
#undef EPCFG 
#define EPCFG(STRUCT,TYPE,NAME,CFGNAME) \
    const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /*tApacheDirConfig*/ void * pDirCfg, const char *  arg) ;
#include "epcfg.h"
#ifndef AP_INIT_TAKE1
#define AP_INIT_TAKE1(name,func,foo,valid,comment) { name,func,foo,valid, TAKE1, comment }
#endif
#ifndef AP_INIT_FLAG
#define AP_INIT_FLAG(name,func,foo,valid,comment) { name,func,foo,valid, FLAG, comment }
#endif
#undef EPCFG
#undef EPCFG_SAVE
#define EPCFG_SAVE EPCFG
#define EPCFG(STRUCT,TYPE,NAME,CFGNAME) \
    AP_INIT_TAKE1( "EMBPERL_"#CFGNAME,   embperl_Apache_Config_##STRUCT##NAME,   NULL, RSRC_CONF | OR_OPTIONS,  "" ),
static const command_rec embperl_cmds[] =
{
#include "epcfg.h"
     
    AP_INIT_FLAG("EMBPERL_USEENV", embperl_Apache_Config_useenv, NULL, RSRC_CONF, "If set to 'on' Embperl will also scan the environment variable for configuration information"),
    {NULL}
};
/* --- apache callback datastructures --- */
#ifdef APACHE2
static void embperl_register_hooks (apr_pool_t * p)
    {
    ap_hook_open_logs(embperl_ApacheInit, NULL, NULL, APR_HOOK_LAST) ; /* make sure we run after modperl init */
    ap_hook_post_config(embperl_ApachePostConfig, NULL, NULL, APR_HOOK_FIRST) ; 
    }
module AP_MODULE_DECLARE_DATA embperl_module =
    {
    STANDARD20_MODULE_STUFF,
    embperl_create_dir_config,  /* dir config creater */
    embperl_merge_dir_config,   /* dir merger --- default is to override */
    embperl_create_server_config, /* server config */
    embperl_merge_dir_config,   /* merge server configs */
    embperl_cmds,               /* command table */
    embperl_register_hooks      /* register hooks */
    };
#else
/* static module MODULE_VAR_EXPORT embperl_module = { */
static module embperl_module = {
    STANDARD_MODULE_STUFF,
    embperl_ApacheInit,         /* initializer */
    embperl_create_dir_config,  /* dir config creater */
    embperl_merge_dir_config,   /* dir merger --- default is to override */
    embperl_create_server_config, /* server config */
    embperl_merge_dir_config,   /* merge server configs */
    embperl_cmds,               /* command table */
    NULL,                       /* handlers */
    NULL,                       /* filename translation */
    NULL,                       /* check_user_id */
    NULL,                       /* check auth */
    NULL,                       /* check access */
    NULL,                       /* type_checker */
    NULL,                       /* fixups */
    NULL,                       /* logger */
    NULL,                       /* header parser */
    NULL,                       /* child_init */
    NULL,                       /* child_exit */
    NULL                        /* post read-request */
};
#endif
/*---------------------------------------------------------------------------
* embperl_ApInitDone
*/
int embperl_ApInitDone (void)
    {
    return 0 ; /* bInitDone ; */
    }
/*---------------------------------------------------------------------------
* embperl_ApacheInitUnload
*/
/*!
*
* \_en                                                                     
* Apache 1: Register subpool to get notified on unload
* Apache 2: nothing
* \endif                                                                       
*
* \_de                                                                     
* Apache 1: Subppol registrieren um einen Unload mitzubekommen
* Apache 2: nichts
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */
static int embperl_ApacheInitUnload (apr_pool_t *p)
    {
#ifdef APACHE2
     if (!unload_subpool && p)
         {    
         apr_pool_create_ex(&unload_subpool, p, NULL, NULL); 
         apr_pool_cleanup_register(unload_subpool, NULL, embperl_ApacheInitCleanup, embperl_ApacheInitCleanup); 
         if (bApDebug)
             ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheInitUnload [%d/%d]\n", getpid(), gettid()) ;
         }
#else
    if (!unload_subpool && p)
        {            
        unload_subpool = ap_make_sub_pool(p);
        ap_register_cleanup(unload_subpool, NULL, embperl_ApacheInitCleanup, embperl_ApacheInitCleanup);
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheInitUnload [%d/%d]\n", getpid(), gettid()) ;
        }
#endif
    return ok ;
    }
/*---------------------------------------------------------------------------
* embperl_ApacheAddModule
*/
/*!
*
* \_en                                                                     
* Apache 1: Add module to dynamily loaded modules
* Apache 2: Just print a debug message. (mod_embperl.so must have been already loaded)
* \endif                                                                       
*
* \_de                                                                     
* Apache 1: Module zu dynamisch geladenen Modulen hinzufügen
* Apache 2: Nur eine Debugmessage ausgeben. (mod_embperl.so muß bereits geladen sein)
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */
void embperl_ApacheAddModule (void)
    {
    bApDebug |= ap_exists_config_define("EMBPERL_APDEBUG") ;
    
#ifdef APACHE2
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Perl part initialization start [%d/%d]\n", getpid(), gettid()) ;
    return ;
#else 
    if (!ap_find_linked_module("mod_embperl.c"))
        {
        apr_pool_t * pool ;
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: About to add mod_embperl.c as dynamic module [%d/%d]\n", getpid(), gettid()) ;
         
        ap_add_module (&embperl_module) ;
        pool = perl_get_startup_pool () ;
        embperl_ApacheInitUnload (pool) ;
        }
    else
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: mod_embperl.c already added as dynamic module [%d/%d]\n", getpid(), gettid()) ;
#endif
    }
/*---------------------------------------------------------------------------
* embperl_ApacheInit
*/
/*!
*
* \_en                                                                     
* Apache 1: Call initialization of Embperl, after configuration is read in
* Apache 2: Just add version component. (Initilalization is call from Perl)
* \endif                                                                       
*
* \_de                                                                     
* Apache 1: Initzialisierung von Embperl ausführen, nachdem Konfiguration eingelesen ist
* Apache 2: Nur Versionsnummer dem Apache hinzufügen. (Initialisierung von von Perl aus aufgerufen)
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */
#ifdef APACHE2
static int embperl_ApacheInit (apr_pool_t *p, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s)
#else
static void embperl_ApacheInit (server_rec *s, apr_pool_t *p)
#endif
    {
#ifndef APACHE2
    int     rc;
#endif
    dTHX ;
#ifndef APACHE2
    embperl_ApacheInitUnload (p) ;
#endif
    bApDebug |= ap_exists_config_define("EMBPERL_APDEBUG") ;
     
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheInit [%d/%d]\n", getpid(), gettid()) ;
#ifdef APACHE2
    bApInit = 1 ;
    return APR_SUCCESS ;
#else
    ap_add_version_component ("Embperl/"VERSION) ;
    if ((rc = embperl_Init (aTHX_ NULL, NULL, s)) != ok)
        {
        ap_log_error (APLOG_MARK, APLOG_ERR | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "Initialization of Embperl failed (#%d)\n", rc) ;
        }
    bApInit = 1 ;
#endif
    }
#ifdef APACHE2
static int embperl_ApachePostConfig (apr_pool_t *p, apr_pool_t *plog, apr_pool_t *ptemp, server_rec *s)
    {
    ap_add_version_component (p, "Embperl/"VERSION) ;
    return APR_SUCCESS ;
    }
#endif
/*---------------------------------------------------------------------------
* embperl_ApacheInitCleanup
*/
/*!
*
* \_en                                                                     
* Apache 1: Make sure Embperl is unloaded before mod_perl is unloaded
* Apache 2: not used
* \endif                                                                       
*
* \_de                                                                     
* Apache 1: Sicherstellen, das Embperl vor mod_perl aus dem Speicher entladen wird
* Apache 2: Nich benutzt
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */
#ifdef APACHE2
static apr_status_t embperl_ApacheInitCleanup (void * p)
#else
static void embperl_ApacheInitCleanup (void * p)
#endif
    {
#ifdef APACHE2
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: embperl_ApacheInitCleanup [%d/%d]\n", getpid(), gettid()) ;
    return OK ;
#else
    module * m ;
    /* make sure embperl module is removed before mod_perl in case mod_perl is loaded dynamicly*/
    if ((m = ap_find_linked_module("mod_perl.c")))
        {
        if (m -> dynamic_load_handle)
            {
            if (bApDebug)
                ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheInitCleanup: mod_perl.c dynamicly loaded -> remove mod_embperl.c [%d/%d]\n", getpid(), gettid()) ;
            /*embperl_EndPass1 () ;*/
            ap_remove_module (&embperl_module) ; 
            }
        else
            {
            if (bApDebug)
                ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheInitCleanup: mod_perl.c not dynamic loaded [%d/%d]\n", getpid(), gettid()) ;
            embperl_EndPass1 () ;
            }
        }
    else
        {
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheInitCleanup: mod_perl.c not found [%d/%d]\n", getpid(), gettid()) ;
        embperl_EndPass1 () ;
        }
#endif
    }
/*---------------------------------------------------------------------------
* embperl_ApacheConfigCleanup
*/
/*!
*
* \_en                                                                     
* Apache Cleanup DirConfig structure
* \endif                                                                       
*
* \_de                                                                     
* Apache Cleanup DirConfig structure
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */
/* --- functions for merging configurations --- */
#define EPCFG_APP    
#define EPCFG_REQ   
#define EPCFG_COMPONENT   
#undef EPCFG_STR
#undef EPCFG_INT
#undef EPCFG_INTOPT
#undef EPCFG_BOOL
#undef EPCFG_CHAR
#undef EPCFG_CV
#undef EPCFG_SV
#undef EPCFG_HV
#undef EPCFG_AV
#undef EPCFG_REGEX
#define EPCFG_INT EPCFG
#define EPCFG_INTOPT EPCFG
#define EPCFG_BOOL EPCFG
#define EPCFG_CHAR EPCFG
#define EPCFG_STR EPCFG
#define EPCFG_CV EPCFG_DEC
#define EPCFG_SV EPCFG_DEC
#define EPCFG_HV EPCFG_DEC
#define EPCFG_REGEX EPCFG_DEC
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,X) EPCFG_DEC(STRUCT,TYPE,NAME,CFGNAME)
#undef EPCFG
#define EPCFG(STRUCT,TYPE,NAME,CFGNAME)
#undef EPCFG_DEC
#define EPCFG_DEC(STRUCT,TYPE,NAME,CFGNAME)  \
    if (cfg -> STRUCT.NAME) \
        { \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheConfigCleanup:SvREFCNT_dec "#CFGNAME" (name="#NAME" type="#TYPE" refcnt=%d) \n", (int)SvREFCNT ((SV *)(cfg -> STRUCT.NAME))) ; \
        SvREFCNT_dec ((SV *)(cfg -> STRUCT.NAME)) ; \
        cfg -> STRUCT.NAME = NULL ; \
        }
#ifdef APACHE2
static apr_status_t embperl_ApacheConfigCleanup (void * p)
#else
static void embperl_ApacheConfigCleanup (void * p)
#endif
    {
    tApacheDirConfig * cfg = (tApacheDirConfig *) p ;
    dTHX ;
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: ApacheConfigCleanup [%d/%d]\n", getpid(), gettid()) ;
#include "epcfg.h"
#ifdef APACHE2
    return OK ;
#endif
    }
/*---------------------------------------------------------------------------
* embperl_GetApacheConfig
*/
int embperl_GetApacheConfig (/*in*/ tThreadData * pThread,
                            /*in*/  request_rec * r,
                            /*in*/  server_rec * s,
                            /*out*/ tApacheDirConfig * * ppConfig)
    {
    *ppConfig = NULL ;
    if (embperl_module.module_index >= 0)
        {
        if(r && r->per_dir_config)
            {
            *ppConfig = (tApacheDirConfig *) ap_get_module_config(r->per_dir_config, &embperl_module);
            if (bApDebug)
                ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: GetApacheConfig for dir\n") ;
            }
        else if(s && s->lookup_defaults) /*s->module_config)*/
            {
            *ppConfig = (tApacheDirConfig *) ap_get_module_config(s->lookup_defaults /*s->module_config*/, &embperl_module);
            if (bApDebug)
                ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: GetApacheConfig for server\n") ;
            }
        else if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: GetApacheConfig -> no config available for %s\n",r && r->per_dir_config?"dir":"server" ) ;
        }
    else
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: GetApacheConfig -> no config available for %s; mod_embperl not loaded?\n",r && r->per_dir_config?"dir":"server" ) ;
    return ok ;
    }
/*---------------------------------------------------------------------------
* embperl_create_dir_config
*/
static void *embperl_create_dir_config(apr_pool_t * p, char *d)
    {
    /*char buf [20] ;*/
    tApacheDirConfig *cfg ;
    apr_pool_t * subpool ;
    embperl_ApacheInitUnload (p) ;
#ifdef APACHE2
    apr_pool_create_ex(&subpool, p, NULL, NULL);
#else
    subpool = ap_make_sub_pool(p);
#endif
    cfg = (tApacheDirConfig *) apr_pcalloc(subpool, sizeof(tApacheDirConfig));
#if 0
#ifdef APACHE2
    apr_pool_cleanup_register(subpool, cfg, embperl_ApacheConfigCleanup, embperl_ApacheConfigCleanup); 
#else
    ap_register_cleanup(subpool, cfg, embperl_ApacheConfigCleanup, embperl_ApacheConfigCleanup);
#endif
#endif
     
    embperl_DefaultReqConfig (&cfg -> ReqConfig) ;
    embperl_DefaultAppConfig (&cfg -> AppConfig) ;
    embperl_DefaultComponentConfig (&cfg -> ComponentConfig) ;
    cfg -> bUseEnv = -1 ; 
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: create_dir_config %s (0x%p) [%d/%d]\n", cfg -> AppConfig.sAppName?cfg -> AppConfig.sAppName:"", cfg, getpid(), gettid()) ;
    return cfg;
    }
/*---------------------------------------------------------------------------
* embperl_create_server_config
*/
static void *embperl_create_server_config(apr_pool_t * p, server_rec *s)
    {
    tApacheDirConfig *cfg = (tApacheDirConfig *) apr_pcalloc(p, sizeof(tApacheDirConfig));
    bApDebug |= ap_exists_config_define("EMBPERL_APDEBUG") ;
    embperl_ApacheInitUnload (p) ;
    embperl_DefaultReqConfig (&cfg -> ReqConfig) ;
    embperl_DefaultAppConfig (&cfg -> AppConfig) ;
    embperl_DefaultComponentConfig (&cfg -> ComponentConfig) ;
    cfg -> bUseEnv = -1 ; 
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: create_server_config (0x%p) [%d/%d]\n", cfg, getpid(), gettid()) ;
    return cfg;
    }
/* --- functions for merging configurations --- */
#define EPCFG_APP    
#define EPCFG_REQ   
#define EPCFG_COMPONENT   
#undef EPCFG_STR
#undef EPCFG_INT
#undef EPCFG_INTOPT
#undef EPCFG_BOOL
#undef EPCFG_CHAR
#undef EPCFG_CV
#undef EPCFG_SV
#undef EPCFG_HV
#undef EPCFG_AV
#undef EPCFG_REGEX
#define EPCFG_INT EPCFG
#define EPCFG_INTOPT EPCFG
#define EPCFG_BOOL EPCFG
#define EPCFG_CHAR EPCFG
#define EPCFG_CV EPCFG_SAVE
#define EPCFG_SV EPCFG_SAVE
#define EPCFG_HV EPCFG_SAVE
#define EPCFG_REGEX EPCFG_SAVE
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,SEPARATOR) EPCFG_SAVE(STRUCT,TYPE,NAME,CFGNAME)
#undef EPCFG
#define EPCFG(STRUCT,TYPE,NAME,CFGNAME)  \
    if (add -> set_##STRUCT##NAME) \
        { \
        mrg -> set_##STRUCT##NAME = 1 ; \
        mrg -> STRUCT.NAME = add -> STRUCT.NAME ; \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Merge "#CFGNAME" (type="#TYPE") => %d\n", mrg -> STRUCT.NAME) ; \
        } \
    else \
        {  \
        if (bApDebug && mrg -> set_##STRUCT##NAME) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Merge "#CFGNAME" (type="#TYPE") stays %d\n", mrg -> STRUCT.NAME) ; \
        } 
#define EPCFG_STR(STRUCT,TYPE,NAME,CFGNAME)  \
    if (add -> set_##STRUCT##NAME) \
        { \
        mrg -> set_##STRUCT##NAME = 1 ; \
        mrg -> STRUCT.NAME = add -> STRUCT.NAME ; \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Merge "#CFGNAME" (type="#TYPE") => %s\n", mrg -> STRUCT.NAME?mrg -> STRUCT.NAME:"<null>") ; \
        } \
    else \
        {  \
        if (bApDebug && mrg -> set_##STRUCT##NAME) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Merge "#CFGNAME" (type="#TYPE") stays %s\n", mrg -> STRUCT.NAME?mrg -> STRUCT.NAME:"<null>") ; \
        } 
#undef EPCFG_SAVE
#ifdef PERL_IMPLICIT_CONTEXT
#define dTHXCond if (!aTHX) aTHX = PERL_GET_THX ;
#else
#define dTHXCond 
#endif
#define EPCFG_SAVE(STRUCT,TYPE,NAME,CFGNAME)  \
    if (add -> set_##STRUCT##NAME) \
        { \
        mrg -> set_##STRUCT##NAME = 1 ; \
        mrg -> STRUCT.NAME = add -> STRUCT.NAME ; \
        mrg -> save_##STRUCT##NAME = add -> save_##STRUCT##NAME ; \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Merge "#CFGNAME" (type="#TYPE") => %s\n", mrg -> save_##STRUCT##NAME?mrg -> save_##STRUCT##NAME:"<null>") ; \
        } \
    else \
        {  \
        if (bApDebug && mrg -> set_##STRUCT##NAME) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Merge "#CFGNAME" (type="#TYPE") stays %s\n", mrg -> save_##STRUCT##NAME?mrg -> save_##STRUCT##NAME:"<null>") ; \
        } \
    if (mrg -> STRUCT.NAME) \
        { \
        dTHXCond  \
        SvREFCNT_inc((SV *)mrg -> STRUCT.NAME) ; \
        } 
/*---------------------------------------------------------------------------
* embperl_merge_dir_config
*/
static void *embperl_merge_dir_config (apr_pool_t *p, void *basev, void *addv)
    {
    if (!basev)
        {
        return addv ;
        }
    else
        {
        tApacheDirConfig *mrg ; /*= (tApacheDirConfig *)ap_palloc (p, sizeof(tApacheDirConfig)); */
        tApacheDirConfig *base = (tApacheDirConfig *)basev;
        tApacheDirConfig *add = (tApacheDirConfig *)addv;
        apr_pool_t * subpool ;
#ifdef PERL_IMPLICIT_CONTEXT
        pTHX ;
        aTHX = NULL ;
#endif
#ifdef APACHE2
        apr_pool_create_ex(&subpool, p, NULL, NULL);
#else
        subpool = ap_make_sub_pool(p);
#endif
        mrg = (tApacheDirConfig *)apr_palloc (subpool, sizeof(tApacheDirConfig));
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: merge_dir/server_config base=0x%p add=0x%p mrg=0x%p\n", basev, addv, mrg) ;
#ifdef APACHE2
        apr_pool_cleanup_register(subpool, mrg, embperl_ApacheConfigCleanup, embperl_ApacheConfigCleanup); 
#else
        ap_register_cleanup(subpool, mrg, embperl_ApacheConfigCleanup, embperl_ApacheConfigCleanup);
#endif
        memcpy (mrg, base, sizeof (*mrg)) ;
        if (bApDebug)
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: merge_dir/server_config %s + %s\n", mrg -> AppConfig.sAppName, add -> AppConfig.sAppName) ;
        if (add -> AppConfig.sAppName)
            mrg -> AppConfig.sAppName = add -> AppConfig.sAppName ;
#include "epcfg.h" 
        if (add -> bUseEnv >= 0)
            mrg -> bUseEnv = add -> bUseEnv ;
        return mrg ;
        }
    }
/*---------------------------------------------------------------------------
* embperl_Apache_Config_useenv
*/
static const char * embperl_Apache_Config_useenv (cmd_parms *cmd, /*tApacheDirConfig*/ void * pDirCfg, int arg)
    { 
    ((tApacheDirConfig *)pDirCfg) -> bUseEnv = arg ; 
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set UseEnv = %d\n", arg) ;
    return NULL; 
    } 
/* --- functions for apache config cmds --- */
#undef EPCFG
#undef EPCFG_INT
#define EPCFG_INT(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char * arg) \
    { \
    ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = (TYPE)strtol(arg, NULL, 0) ; \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE";INT) = %s\n", arg) ; \
    return NULL; \
    } 
#undef EPCFG_INTOPT
#define EPCFG_INTOPT(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char * arg) \
    { \
    if (isdigit(*arg))    \
        ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = (TYPE)strtol(arg, NULL, 0) ; \
    else \
        { \
        int val ; \
        if (embperl_OptionListSearch(Options##CFGNAME,1,#CFGNAME,arg,&val)) \
            return "Unknown Option" ; \
        ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = (TYPE)val ; \
        } \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE";INT) = %s\n", arg) ; \
    return NULL; \
    } 
#undef EPCFG_BOOL
#define EPCFG_BOOL(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char * arg) \
    { \
    ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = (TYPE)(arg?1:0) ; \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE";BOOL) = %s\n", arg) ; \
    return NULL; \
    } 
#undef EPCFG_STR
#define EPCFG_STR(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char* arg) \
    { \
    apr_pool_t * p = cmd -> pool ;    \
    ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = apr_pstrdup(p, arg) ; \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE";STR) = %s\n", arg) ; \
    return NULL; \
    } 
#undef EPCFG_EXPIRES
#define EPCFG_EXPIRES(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char* arg) \
    { \
    apr_pool_t * p = cmd -> pool ;    \
    char buf[256] ; \
    if (!embperl_CalcExpires(arg, buf, 0)) \
        LogErrorParam (NULL, rcTimeFormatErr, "EMBPERL_"#CFGNAME, arg) ; \
    else \
        ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = apr_pstrdup(p, arg) ; \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE";STR) = %s\n", arg) ; \
    return NULL; \
    } 
#undef EPCFG_CHAR
#define EPCFG_CHAR(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char * arg) \
    { \
    ((tApacheDirConfig *)pDirCfg) -> STRUCT.NAME = (TYPE)arg[0] ; \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE";CHAR) = %s\n", arg) ; \
    return NULL; \
    } 
#undef EPCFG_CV
#undef EPCFG_SV
#undef EPCFG_HV
#undef EPCFG_AV
#undef EPCFG_REGEX
#define EPCFG_CV EPCFG_SAVE
#define EPCFG_SV EPCFG_SAVE
#define EPCFG_HV EPCFG_SAVE
#define EPCFG_REGEX EPCFG_SAVE
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,SEPARATOR) EPCFG_SAVE(STRUCT,TYPE,NAME,CFGNAME)
#undef EPCFG_SAVE
#define EPCFG_SAVE(STRUCT,TYPE,NAME,CFGNAME) \
const char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, /* tApacheDirConfig */ void * pDirCfg, const char* arg) \
    { \
    ((tApacheDirConfig *)pDirCfg) -> save_##STRUCT##NAME = apr_pstrdup(cmd -> pool, arg) ; \
    ((tApacheDirConfig *)pDirCfg) -> set_##STRUCT##NAME = 1 ; \
    if (bApDebug) \
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Set "#CFGNAME" (type="#TYPE") = %s (save for later conversion to Perl data)\n", arg) ; \
    return NULL ; \
    } 
#define EPCFG_APP    
#define EPCFG_REQ   
#define EPCFG_COMPONENT   
#include "epcfg.h"
#endif /* MOD_EMBPERL */
/*--------------------------------------------------------------------------- */
#ifdef EMBPERL_SO
/*---------------------------------------------------------------------------
* embperl_GetApacheAppName
*/
char * embperl_GetApacheAppName (/*in*/ tApacheDirConfig * pDirCfg)
    {
    char *n = pDirCfg?pDirCfg -> AppConfig.sAppName:"Embperl" ;
    if (bApDebug)
        ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: get_appname %s[%d/%d]\n", n?n:"", getpid(), gettid()) ;
    return n ;
    }
/* --- functions for converting string to Perl structures --- */
#undef EPCFG_STR
#undef EPCFG_INT
#undef EPCFG_EXPIRES
#undef EPCFG_INTOPT
#undef EPCFG_BOOL
#undef EPCFG_CHAR
#define EPCFG_INT EPCFG
#define EPCFG_EXPIRES EPCFG_STR
#define EPCFG_INTOPT EPCFG
#define EPCFG_BOOL EPCFG
#define EPCFG_CHAR EPCFG
#undef EPCFG
#define EPCFG(STRUCT,TYPE,NAME,CFGNAME)  \
        if (bApDebug && pDirCfg -> set_##STRUCT##NAME) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get "#CFGNAME" (type="#TYPE") %d (0x%x)\n", pDirCfg -> STRUCT.NAME, pDirCfg -> STRUCT.NAME) ; 
#define EPCFG_STR(STRUCT,TYPE,NAME,CFGNAME)  \
        if (bApDebug && pDirCfg -> set_##STRUCT##NAME) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get "#CFGNAME" (type="#TYPE") %s\n", pDirCfg -> STRUCT.NAME?pDirCfg -> STRUCT.NAME:"<null>") ; 
#undef EPCFG_SV
#define EPCFG_SV(STRUCT,TYPE,NAME,CFGNAME) \
    if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
        { \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get: about to convert "#CFGNAME" (type="#TYPE";SV) to perl data: %s\n", pDirCfg -> save_##STRUCT##NAME) ; \
\
        pDirCfg -> STRUCT.NAME = newSVpv((char *)pDirCfg -> save_##STRUCT##NAME, 0) ; \
        } \
    SvREFCNT_inc((SV *)(pDirCfg -> STRUCT.NAME)) ;
#undef EPCFG_CV
#define EPCFG_CV(STRUCT,TYPE,NAME,CFGNAME) \
    if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
        { \
        int rc ;\
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get: about to convert "#CFGNAME" (type="#TYPE";CV) to perl data: %s\n", pDirCfg -> save_##STRUCT##NAME) ; \
\
        if ((rc = EvalConfig (pApp, sv_2mortal(newSVpv(pDirCfg -> save_##STRUCT##NAME, 0)), 0, NULL, "Configuration: EMBPERL_"#CFGNAME, &pDirCfg -> STRUCT.NAME)) != ok) \
            pDirCfg -> STRUCT.NAME = NULL ; \
        tainted = 0 ; \
        } \
    if (pDirCfg -> STRUCT.NAME) \
        SvREFCNT_inc((SV *)(pDirCfg -> STRUCT.NAME)) ;
#undef EPCFG_AV
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,SEPARATOR) \
    if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
        { \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get: about to convert "#CFGNAME" (type="#TYPE";AV) to perl data: %s\n", pDirCfg -> save_##STRUCT##NAME) ; \
\
        pDirCfg -> STRUCT.NAME = embperl_String2AV(pApp, pDirCfg -> save_##STRUCT##NAME, SEPARATOR) ;\
        tainted = 0 ; \
        } \
    SvREFCNT_inc((SV *)(pDirCfg -> STRUCT.NAME)) ;
   
#undef EPCFG_HV
#define EPCFG_HV(STRUCT,TYPE,NAME,CFGNAME) \
    if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
        { \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get: about to convert "#CFGNAME" (type="#TYPE";HV) to perl data: %s\n", pDirCfg -> save_##STRUCT##NAME) ; \
\
        pDirCfg -> STRUCT.NAME = embperl_String2HV(pApp, pDirCfg -> save_##STRUCT##NAME, ' ', NULL) ;\
        tainted = 0 ; \
        } \
    SvREFCNT_inc((SV *)(pDirCfg -> STRUCT.NAME)) ;
     
#undef EPCFG_REGEX
#define EPCFG_REGEX(STRUCT,TYPE,NAME,CFGNAME) \
    if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
        { \
        int rc ; \
        if (bApDebug) \
            ap_log_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, APLOG_STATUSCODE NULL, "EmbperlDebug: Get: about to convert "#CFGNAME" (type="#TYPE";REGEX) to perl data: %s\n", pDirCfg -> save_##STRUCT##NAME) ; \
\
        if ((rc = EvalRegEx (pApp, pDirCfg -> save_##STRUCT##NAME, "Configuration: EMBPERL_"#CFGNAME, &pDirCfg -> STRUCT.NAME)) != ok) \
            pDirCfg -> STRUCT.NAME = NULL ; \
        tainted = 0 ; \
        } \
    if (pDirCfg -> STRUCT.NAME) \
        SvREFCNT_inc((SV *)(pDirCfg -> STRUCT.NAME)) ;
/*---------------------------------------------------------------------------
* embperl_GetApacheAppConfig
*/
int embperl_GetApacheAppConfig (/*in*/ tThreadData * pThread,
                                /*in*/ tMemPool    * pPool,
                                /*in*/ tApacheDirConfig * pDirCfg,
                                /*out*/ tAppConfig * pConfig)
    {
    eptTHX_
    tApp * pApp = NULL ;
    if(pDirCfg)
        {
#define EPCFG_APP    
#undef EPCFG_REQ   
#undef EPCFG_COMPONENT   
#include "epcfg.h"         
         
        memcpy (&pConfig -> pPool + 1, &pDirCfg -> AppConfig.pPool + 1, sizeof (*pConfig) - ((tUInt8 *)(&pConfig -> pPool) - (tUInt8 *)pConfig) - sizeof (pConfig -> pPool)) ;
        pConfig -> bDebug = pDirCfg -> ComponentConfig.bDebug ;
         
        if (pDirCfg -> bUseEnv)
             embperl_GetCGIAppConfig (pThread, pPool, pConfig, 1, 0, 0) ;
        }
    else
        embperl_DefaultAppConfig (pConfig) ;
    return ok ;
    }
/*---------------------------------------------------------------------------
* embperl_GetApacheReqConfig
*/
int embperl_GetApacheReqConfig (/*in*/ tApp *        pApp,
                                /*in*/ tMemPool    * pPool,
                                /*in*/ tApacheDirConfig * pDirCfg,
                                /*out*/ tReqConfig * pConfig)
    {
#define a pApp
    epaTHX_
#undef a
    if(pDirCfg)
        {
#undef EPCFG_APP    
#define EPCFG_REQ   
#undef EPCFG_COMPONENT   
#include "epcfg.h"         
        memcpy (&pConfig -> pPool + 1, &pDirCfg -> ReqConfig.pPool + 1, sizeof (*pConfig) - ((tUInt8 *)(&pConfig -> pPool) - (tUInt8 *)pConfig) - sizeof (pConfig -> pPool)) ;
        pConfig -> bDebug = pDirCfg -> ComponentConfig.bDebug ;
        pConfig -> bOptions = pDirCfg -> ComponentConfig.bOptions ;
        if (pDirCfg -> bUseEnv)
             embperl_GetCGIReqConfig (pApp, pPool, pConfig, 1, 0, 0) ;
        }
    else
        embperl_DefaultReqConfig (pConfig) ;
    pConfig -> bOptions |= optSendHttpHeader ;
    return ok ;
    }
/*---------------------------------------------------------------------------
* embperl_GetApacheComponentConfig
*/
int embperl_GetApacheComponentConfig (/*in*/ tReq * pReq,
                                /*in*/ tMemPool    * pPool,
                                /*in*/ tApacheDirConfig * pDirCfg,
                                /*out*/ tComponentConfig * pConfig)
    {
    if(pDirCfg)
        {
    #define r pReq
        epTHX_
    #undef r
        tApp * pApp = pReq -> pApp ;
#undef EPCFG_APP    
#undef EPCFG_REQ   
#define EPCFG_COMPONENT   
#include "epcfg.h"         
        memcpy (&pConfig -> pPool + 1, &pDirCfg -> ComponentConfig.pPool + 1, sizeof (*pConfig) - ((tUInt8 *)(&pConfig -> pPool) - (tUInt8 *)pConfig) - sizeof (pConfig -> pPool)) ;
         
        if (pDirCfg -> bUseEnv)
             embperl_GetCGIComponentConfig (pReq, pPool, pConfig, 1, 0, 0) ;
        }
    else
        embperl_DefaultComponentConfig (pConfig) ;
    return ok ;
    }
/*---------------------------------------------------------------------------
* embperl_AddCookie
*/
struct addcookie
    {
    tApp * pApp ;
    tReqParam * pParam ;
    } ;
static int embperl_AddCookie (/*in*/ void * s, const char * pKey, const char * pValue)
    {
    tApp * a = ((struct addcookie *)s) -> pApp ;
    epaTHX_ 
    HV *   pHV ;
         
    if (!(pHV = ((struct addcookie *)s) -> pParam -> pCookies))    
        pHV = ((struct addcookie *)s) -> pParam -> pCookies = newHV () ;
    embperl_String2HV(a, pValue, ';', pHV) ;
    return 1 ;
    }
/*---------------------------------------------------------------------------
* embperl_GetApacheReqParam
*/
int embperl_GetApacheReqParam  (/*in*/  tApp        * pApp,
                                /*in*/ tMemPool    * pPool,
                                /*in*/  request_rec * r,
                                /*out*/ tReqParam * pParam)
    {
    tApp * a = pApp ;
    epaTHX_
    char * p ;
    struct addcookie s ;
    char buf[20] ;
    char * scheme ;
    short  port ;
    s.pApp = a ;
    s.pParam = pParam ;
    pParam -> sFilename    = r -> filename ;
    pParam -> sUnparsedUri = r -> unparsed_uri ;
    pParam -> sUri         = r -> uri ;
    pParam -> sPathInfo    = r -> path_info ;
    pParam -> sQueryInfo   = r -> args ;  
    if ((p = ep_pstrdup (pPool, apr_table_get (r -> headers_in, "Accept-Language"))))
        {
        while (isspace(*p))
            p++ ;
        pParam -> sLanguage = p ;
        while (isalpha(*p))
            p++ ;
        *p = '\0' ;
        }
    apr_table_do (embperl_AddCookie, &s, r -> headers_in, "Cookie", NULL) ;
    buf[0] = '\0' ;
#ifdef APACHE2
    port   = r -> connection -> local_addr -> port ;
#else
    port   = ntohs(r -> connection -> local_addr.sin_port) ;
#endif
#ifdef EAPI
    if (ap_ctx_get (r -> connection -> client -> ctx, "ssl"))
        {
        scheme = "https" ;
        if (port != 443)
            sprintf (buf, ":%d", port) ;
        }
    else
#endif
        {
        scheme = "http" ;
        if (port != 80)
            sprintf (buf, ":%d", port) ;
        }
    pParam -> sServerAddr = ep_pstrcat (pPool, scheme, "://", 
                    r -> hostname?r -> hostname:r -> server -> server_hostname, buf, NULL) ;
    return ok ;
    }
#endif /* EMBPERL_SO */
#endif /* APACHE */