epinit.c

/*###################################################################################
#
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
#   Embperl - Copyright (c) 2008-2014 Gerald Richter
#
#   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.
#
#   $Id: epinit.c 1578075 2014-03-16 14:01:14Z richter $
#
###################################################################################*/


#include "ep.h"
#include "epmacro.h"
#include "xs/ep_xs_typedefs.h"
#include "xs/ep_xs_sv_convert.h"

#include "epdefault.c"

SV   ep_sv_undef ; /* we need our own undef value, because when 
                      storing a PL_sv_undef with Perl 5.8.0 in a hash
                      Perl takes it as a placeholder and pretents it isn't there :-( */

#ifndef PERL_IMPLICIT_CONTEXT

SV * embperl_ThreadDataRV ;

#define SINGLETHREAD

#endif



#define OPTPREFIX               EMBPERL_PACKAGE_STR

#define EMBPERL_APP_PACKAGE     EMBPERL_PACKAGE_STR"::Application"
#define EMBPERL_REQ_PACKAGE     EMBPERL_PACKAGE_STR"::Req"
#define EMBPERL_THREAD_PACKAGE  EMBPERL_PACKAGE_STR"::Thread"

#define FDAT_NAME               "fdat"
#define EMBPERL_FDAT_NAME       EMBPERL_PACKAGE_STR"::"FDAT_NAME
#define EMBPERL_SPLIFDAT_NAME   EMBPERL_PACKAGE_STR"::splitfdat"
#define FFLD_NAME               "ffld"
#define EMBPERL_FFLD_NAME       EMBPERL_PACKAGE_STR"::"FFLD_NAME
#define EMBPERL_HDR_NAME        EMBPERL_PACKAGE_STR"::http_headers_out"
#define EMBPERL_IDAT_NAME       EMBPERL_PACKAGE_STR"::idat"
#define PARAM_NAME              "param"
#define EMBPERL_PARAM_NAME      EMBPERL_PACKAGE_STR"::"PARAM_NAME
#define EMBPERL_REQ_NAME        EMBPERL_PACKAGE_STR"::req"
#define EMBPERL_APP_NAME        EMBPERL_PACKAGE_STR"::app"
#define EMBPERL_ENV_NAME        "ENV"

#define EMBPERL_EscMode_NAME    EMBPERL_PACKAGE_STR"::escmode"
#define EMBPERL_CurrNode_NAME    EMBPERL_PACKAGE_STR"::_ep_node"


static int  bInitDone = 0 ; /* c part is already initialized */
static int  nRequestCount = 1 ;
static perl_mutex RequestCountMutex ;

static tMemPool * pMainPool ;

static tReq NullRequest ; /* a request object with all zero, to point for deleted objects */

/* -------------------------------------------------------------------------
*
* Options lists for configuration 
*
*/

#define OPTION(a,b) { #a, a}, { #b, a},

tOptionEntry OptionsDEBUG[] =
    {
    OPTION(dbgStd, std)
    OPTION(dbgMem,Mem)
    OPTION(dbgEval,Eval)
    OPTION(dbgCmd,Cmd)
    OPTION(dbgEnv,Env)
    OPTION(dbgForm,Form)
    OPTION(dbgTab,Tab)
    OPTION(dbgInput,Input)
    OPTION(dbgFlushOutput,FlushOutput)
    OPTION(dbgFlushLog,FlushLog)
    OPTION(dbgAllCmds,AllCmds)
    OPTION(dbgSource,Source)
    OPTION(dbgFunc,Func)
    OPTION(dbgLogLink,LogLink)
    OPTION(dbgDefEval,DefEval)
    OPTION(dbgOutput,Output)
    OPTION(dbgDOM,DOM)
    OPTION(dbgRun,Run)
    OPTION(dbgHeadersIn,HeadersIn)
    OPTION(dbgShowCleanup,ShowCleanup)
    OPTION(dbgProfile,Profile)
    OPTION(dbgSession,Session)
    OPTION(dbgImport,Import)
    OPTION(dbgBuildToken,BuildToken)
    OPTION(dbgParse,Parse)
    OPTION(dbgObjectSearch,ObjectSearch)
    OPTION(dbgCache,Cache)
    OPTION(dbgCompile,Compile)
    OPTION(dbgXML,XML)
    OPTION(dbgXSLT,XSLT)
    OPTION(dbgCheckpoint,Checkpoint)
    OPTION(dbgAll,All)
    } ;

#define OPTION_OPT(a) OPTION(opt##a, a) 

tOptionEntry OptionsOPTIONS[] =
    {
    OPTION_OPT(DisableVarCleanup)
    OPTION_OPT(DisableEmbperlErrorPage)
    OPTION_OPT(SafeNamespace)
    OPTION_OPT(OpcodeMask)
    OPTION_OPT(RawInput)
    OPTION_OPT(SendHttpHeader)
    OPTION_OPT(EarlyHttpHeader)
    OPTION_OPT(DisableChdir)
    OPTION_OPT(DisableFormData)
    OPTION_OPT(DisableHtmlScan)
    OPTION_OPT(DisableInputScan)
    OPTION_OPT(DisableTableScan)
    OPTION_OPT(DisableMetaScan)
    OPTION_OPT(AllFormData)
    OPTION_OPT(RedirectStdout)
    OPTION_OPT(UndefToEmptyValue)
    OPTION_OPT(NoHiddenEmptyValue)
    OPTION_OPT(AllowZeroFilesize)
    OPTION_OPT(ReturnError)
    OPTION_OPT(KeepSrcInMemory)
    OPTION_OPT(KeepSpaces)
    OPTION_OPT(OpenLogEarly)
    OPTION_OPT(NoUncloseWarn)
    OPTION_OPT(DisableSelectScan)
    OPTION_OPT(ShowBacktrace)
    OPTION_OPT(EnableChdir)
    OPTION_OPT(FormDataNoUtf8)
    } ;


#define OPTION_ESC(a) OPTION(esc##a, a) 

tOptionEntry OptionsESCMODE[] =
    {
    OPTION_ESC(None)
    OPTION_ESC(Html)
    OPTION_ESC(Url)
    OPTION_ESC(Escape)
    OPTION_ESC(XML)
    OPTION_ESC(Std)
    } ;


#define OPTION_IESC(a) OPTION(iesc##a, a) 

tOptionEntry OptionsINPUT_ESCMODE[] =
    {
    OPTION_IESC(None)
    OPTION_IESC(Html)
    OPTION_IESC(Url)
    OPTION_IESC(RemoveTags)
    } ;

#define OPTION_OMODE(a) OPTION(omode##a, a) 

tOptionEntry OptionsOUTPUT_MODE[] =
    {
    OPTION_OMODE(Html)
    OPTION_OMODE(Xml)
    } ;

#define OPTION_OCHARSET(a) OPTION(ocharset##a, a) 

tOptionEntry OptionsOUTPUT_ESC_CHARSET[] =
    {
    OPTION_OCHARSET(Utf8)
    OPTION_OCHARSET(Latin1)
    OPTION_OCHARSET(Latin2)
    } ;

#define OPTION_SMODE(a) OPTION(smode##a, a) 

tOptionEntry OptionsSESSION_MODE[] =
    {
    OPTION_SMODE(None)
    OPTION_SMODE(UDatCookie)
    OPTION_SMODE(UDatParam)
    OPTION_SMODE(UDatUrl)
    OPTION_SMODE(SDatParam)
    } ;


/*---------------------------------------------------------------------------
* embperl_SetupThread
*/
/*!
*
* \_en									   
* Setup an thread object. Either take an existing one, if this thread
* already has a azocitaed object or create a new one.
*                                                                          
* \endif                                                                       
*
* \_de									   
* Initialisiert ein Threadobjekt. Ist dem Thread schon ein Objekt zugeorndet
* wird das bestehende genutzt, ansonsten ein neues zur?ck geliefert.
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_SetupThread  (/*in*/ pTHX_
                             /*out*/tThreadData * *  ppThread)


    {
    tThreadData * pThread ;
    SV * *        ppSV ;

#ifdef SINGLETHREAD
    ppSV = &embperl_ThreadDataRV ;
#else
    ppSV = hv_fetch (PL_modglobal, "Embperl::Thread", 15, 1) ;
#endif
    if (!ppSV)
	{
	LogErrorParam (NULL, rcHashError, "PL_modglobal (key=Embperl::Thread)", "") ;
        return rcHashError ;
	}
	
    if (!*ppSV || !SvOK(*ppSV))
        {
        SV * pThreadRV ;
        SV * pThreadSV ;
        HV * pStash = gv_stashpv (EMBPERL_PACKAGE_STR, 1) ;
        tMemPool * pPool = ep_make_sub_pool (pMainPool) ;

        epxs_Embperl__Thread_create_obj(pThread,pThreadSV,pThreadRV,ep_palloc(pPool,sizeof(*pThread))) ;
#ifdef PERL_IMPLICIT_CONTEXT
        pThread -> pPerlTHX = aTHX ;
#endif
        pThread -> pPool         = pPool ;
        pThread -> pMainPool     = pMainPool ;
        pThread -> nPid          = getpid () ; 
        pThread -> pApplications = newHV () ;
        pThread -> pFormHash     = perl_get_hv (EMBPERL_FDAT_NAME, GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pFormHash) ;
        pThread -> pFormHashGV   = *((GV **)hv_fetch    (pStash, FDAT_NAME, sizeof (FDAT_NAME) - 1, 0)) ;
        pThread -> pFormSplitHash = perl_get_hv (EMBPERL_SPLIFDAT_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pFormSplitHash) ;
        pThread -> pFormArray    = perl_get_av (EMBPERL_FFLD_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pFormArray) ;
        pThread -> pFormArrayGV  = *((GV **)hv_fetch    (pStash, FFLD_NAME, sizeof (FFLD_NAME) - 1, 0)) ;
        pThread -> pHeaderHash   = perl_get_hv (EMBPERL_HDR_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pHeaderHash) ;
        pThread -> pInputHash    = perl_get_hv (EMBPERL_IDAT_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pInputHash) ;
#ifdef DMALLOC
        pThread -> pEnvHash      = Perl_get_hv(aTHX_ EMBPERL_ENV_NAME,  GV_ADD | GV_ADDMULTI) ;
#else
        pThread -> pEnvHash      = perl_get_hv (EMBPERL_ENV_NAME,  GV_ADD | GV_ADDMULTI) ;
#endif        
        SvREFCNT_inc(pThread -> pEnvHash) ;
        pThread -> pParamArray   = perl_get_av (EMBPERL_PARAM_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pParamArray) ;
        pThread -> pParamArrayGV = *((GV **)hv_fetch    (pStash, PARAM_NAME, sizeof (PARAM_NAME) - 1, 0)) ;
        pThread -> pReqRV        = perl_get_sv (EMBPERL_REQ_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pReqRV) ;
        pThread -> pAppRV        = perl_get_sv (EMBPERL_APP_NAME,  GV_ADD | GV_ADDMULTI) ;
        SvREFCNT_inc(pThread -> pAppRV) ;
        *ppSV = pThreadRV ;
        }
    else
        {
        pThread = epxs_sv2_Embperl__Thread(*ppSV) ;
        }

    *ppThread = pThread ;
    return ok ;
    }



/*---------------------------------------------------------------------------
* embperl_GetThread
*/
/*!
*
* \_en									   
* Returns already has a azocitaed object thread object. The thread object
* must be setup before via embperl_SetupThread
* \endif                                                                       
*
* \_de									   
* Liefert das diesem Thread zugeordnete Thread-Objekt zur?ck. Das Objekt mu?
* vorher mittels embperl_SetupThread initialisiert worden sein.
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



tThreadData * embperl_GetThread  (/*in*/ pTHX)

    {    
    tThreadData * pThread ; 
    int           rc ;

    if ((rc = embperl_SetupThread (aTHX_ &pThread)) != ok)
        {
        LogError (NULL, rc) ;
        return NULL ;
        }

    return pThread ;
    }

/*---------------------------------------------------------------------------
* embperl_EndPass1
*/
/*!
*
* \_en									   
* Call when configuration pass 1 of apache is done.
* \endif                                                                       
*
* \_de									   
* Wird aufgerufen wenn Pass 1 des Einlesens der Konfiguration beendet ist.
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_EndPass1  (void)


    {
    tThreadData * pThread  ;
    dTHX ;
    pThread = embperl_GetThread  (aTHX) ;
    
    hv_clear (pThread -> pApplications) ;

    return ok ;
    }


/*---------------------------------------------------------------------------
* embperl_CreateSessionObject
*/
/*!
*
* \_en									   
* Creates a new session object.
*                                                                          
* \endif                                                                       
*
* \_de									   
* Erzeugt eine neues Sessionobjekt.
*                                                                          
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



static int embperl_CreateSessionObject(/*in*/ tApp *       a,
                                       /*in*/ HV *         pArgs,
                                       /*out*/ HV * *      ppHash,
                                       /*out*/ SV * *      ppObj)


    {
    epaTHX_
    dSP ;
    tAppConfig * pCfg = &a -> Config ;
    char *       sPackage = pCfg -> sSessionHandlerClass ;
    HV * pHash = newHV () ;
    SV * pTie = NULL  ;
    int n ;
    SV * pSVCode ;

    pSVCode = newSVpvf ("require %s", sPackage) ; 
    newSVpvf2(pSVCode) ;
    /* there is no c api to the require function, eval it... */
    perl_eval_sv(pSVCode, G_EVAL | G_DISCARD) ;
    SvREFCNT_dec(pSVCode);
    tainted = 0 ;

    if (SvTRUE (ERRSV))
	{
        STRLEN l ;
        if (strcmp (sPackage, "Apache::SessionX") != 0 ||
              GetHashValueStr (aTHX_ a -> pThread -> pEnvHash, "GATEWAY_INTERFACE", NULL))
            LogErrorParam (a, rcSetupSessionErr, SvPV (ERRSV, l), NULL) ;
        sv_setpv(ERRSV,"");
        return rcEvalErr ;
        }

    SPAGAIN;
    PUSHMARK(sp);
    XPUSHs(sv_2mortal(newSVpv(sPackage, 0))); 
    XPUSHs(&sv_undef); /* id */ 
    XPUSHs(sv_2mortal (newRV((SV *)pArgs))); 
    PUTBACK;                        
    n = perl_call_method ("TIEHASH", G_EVAL | G_SCALAR) ;
    SPAGAIN;
    if (n > 0)
        pTie = POPs ;
    PUTBACK;
    if (SvTRUE (ERRSV))
	{
        STRLEN l ;
        LogErrorParam (a, rcSetupSessionErr, SvPV (ERRSV, l), NULL) ;
        sv_setpv(ERRSV,"");
        return rcEvalErr ;
        }
    if (n == 0 || !SvROK(pTie))
        {
        LogErrorParam (a, rcSetupSessionErr, "TIEHASH didn't returns a hashref", sPackage) ;
        return rcNotHashRef ;
        }
    hv_magic(pHash, (GV *)pTie, 'P') ;

    *ppHash = pHash ;
    *ppObj  = SvREFCNT_inc(pTie) ;

    return ok ;
    }

/*---------------------------------------------------------------------------
* embperl_SetupSessionObjects
*/
/*!
*
* \_en									   
* Setup the session onbjects.
*                                                                          
* \endif                                                                       
*
* \_de									   
* Initialisiert neue Sessionobjekte.
*                                                                          
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_SetupSessionObjects    (/*in*/ tApp *       a)


    {
    epaTHX_
    int   rc ;
    SV *  pStore ;
    SV ** ppStore ;
    SV *  pLocker ;
    SV ** ppLocker ;
    SV *  pSerializer ;
    SV ** ppSerializer ;
    SV *  pGenerator ;
    SV ** ppGenerator ;
    tAppConfig * pCfg = &a -> Config ;
    HV *  pArgs = pCfg -> pSessionArgs ;
    HV *  pArgs1 ;
    HV *  pArgs2 ;
    HV *  pArgs3 ;
    dSP ;

    
    if (strcmp (pCfg -> sSessionHandlerClass, "no") == 0)
        return ok ;

    if (!pArgs)
        pCfg ->  pSessionArgs = pArgs = newHV() ;
    
    if (pCfg ->  pSessionClasses)
        {
        if ((ppStore = av_fetch (pCfg ->  pSessionClasses, 0, 0)))
            pStore = SvREFCNT_inc(*ppStore) ;
        else
            pStore = newSVpv("File", 4) ;
        hv_store (pArgs, "Store", 5, pStore, 0) ;

        if ((ppLocker = av_fetch (pCfg ->  pSessionClasses, 1, 0)))
            pLocker = SvREFCNT_inc(*ppLocker) ;
        else
            pLocker = newSVpv("Null", 4) ;
        hv_store (pArgs, "Lock", 4, pLocker, 0) ;

        if ((ppSerializer = av_fetch (pCfg ->  pSessionClasses, 2, 0)))
            pSerializer = SvREFCNT_inc(*ppSerializer) ;
        else
            pSerializer = newSVpv("Storable", 8) ;
        hv_store (pArgs, "Serialize", 9, pSerializer, 0) ;

        if ((ppGenerator = av_fetch (pCfg ->  pSessionClasses, 3, 0)))
            pGenerator = SvREFCNT_inc(*ppGenerator) ;
        else
            pGenerator = newSVpv("MD5", 3) ;
        hv_store (pArgs, "Generate", 8, pGenerator, 0) ;
        }
    else
        {
        /* workaround for perl bug in newHVhv when to less hash entries */
        hv_store (pArgs, "__dummy1__", 10, newSViv (1), 0) ;
        hv_store (pArgs, "__dummy2__", 10, newSViv (1), 0) ;
        hv_store (pArgs, "__dummy3__", 10, newSViv (1), 0) ;
        hv_store (pArgs, "__dummy4__", 10, newSViv (1), 0) ;
        }

    if (pCfg ->  sSessionConfig)
        hv_store (pArgs, "config", 5, newSVpv (pCfg ->  sSessionConfig, 0), 0) ;

    hv_store (pArgs, "lazy", 4, newSViv (1), 0) ;
    hv_store (pArgs, "create_unknown", 14, newSViv (1), 0) ;

    pArgs1 = newHVhv(pArgs) ;
    hv_store (pArgs1, "Transaction", 11, newSViv (1), 0) ;
    pArgs2 = newHVhv(pArgs) ;
    hv_store (pArgs2, "recreate_id", 11, newSViv (1), 0) ;
    pArgs3 = newHVhv(pArgs2) ;

    if ((rc = embperl_CreateSessionObject (a, pArgs1, &a -> pAppHash, &a -> pAppObj)) != ok)
        return rc ;

    SPAGAIN ;
    PUSHMARK(sp);
    XPUSHs(a -> pAppObj); 
    XPUSHs(sv_2mortal (newSVpv(a -> Config.sAppName, 0))); 
    PUTBACK;                        
    perl_call_method ("setidfrom", G_DISCARD) ;

    if ((rc = embperl_CreateSessionObject (a, pArgs2, &a -> pUserHash, &a -> pUserObj)) != ok)
        return rc ;

    hv_store (pArgs3, "newid", 5, newSViv (1), 0) ;

    if ((rc = embperl_CreateSessionObject (a, pArgs3, &a -> pStateHash, &a -> pStateObj)) != ok)
        return rc ;


    return ok ;
    }


/*---------------------------------------------------------------------------
* embperl_SetupApp
*/
/*!
*
* \_en									   
* Setup an application object. Either take an existing one, if the
* application is already created for that thread or create a new
* one.
*                                                                          
* @param   pThread          per thread data
* @param   pApacheCfg       apache configuration vector
* @param   pPerlParam       parameters passed from Perl
* \endif                                                                       
*
* \_de									   
* Initialisiert ein Applicationobjekt. Entweder wird ein bereits bestehendes
* benutzt, oder falls nicht vorhanden, ein neues erzeugt.
*                                                                          
* @param   pThread          per thread daten
* @param   pApacheCfg       apache Konfigurations Vector
* @param   pPerlParam       Parameter die von Perl aus ?bergeben wurden
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_SetupApp     (/*in*/ pTHX_
                             /*in*/ tThreadData *  pThread,
                             /*in*/ tApacheDirConfig * pApacheCfg,
                             /*in*/ SV *           pPerlParam,
                             /*out*/tApp * *       ppApp)


    {
    char * sAppName = NULL ;
    tApp * pApp = NULL ;
    HV * pParam = NULL ;


    if (pPerlParam && SvROK(pPerlParam))
        {
        pParam = (HV *)SvRV(pPerlParam) ;
        sAppName        = GetHashValueStr (aTHX_ pParam, "app_name", NULL) ;
        if (!sAppName) // backward compability to broken appname 
            sAppName        = GetHashValueStr (aTHX_ pParam, "appname", NULL) ;
        }

    if (!sAppName)
        {
#ifdef APACHE
        if (pApacheCfg)
            sAppName = embperl_GetApacheAppName (pApacheCfg) ;
        else
#endif
            sAppName = embperl_GetCGIAppName (pThread) ;
        }
    
    if (sAppName)
        pApp = (tApp * )GetHashValuePtr (NULL, pThread -> pApplications, sAppName, NULL) ;

  
    if (!pApp)
        {
        int  rc ;
        SV * pAppSV ;
        SV * pAppRV ;
        SV * pSV ;
        SV * pRV ;
        tAppConfig * pCfg ;
        
        tMemPool * pPool = ep_make_sub_pool (pThread -> pPool) ;

        
        epxs_Embperl__App_create_obj(pApp,pAppSV,pAppRV,ep_palloc(pPool,sizeof(*pApp))) ;
        epxs_Embperl__App__Config_create_obj(pCfg,pSV,pRV,&pApp -> Config) ;
#ifdef PERL_IMPLICIT_CONTEXT
        pApp -> pPerlTHX = aTHX ;
#endif
        pApp -> pPool         = pPool ;
        pCfg -> pPool         = pPool ;

#ifdef APACHE
        if (pApacheCfg)
            embperl_GetApacheAppConfig (pThread, pPool, pApacheCfg, &pApp -> Config) ;
        else
#endif
            {
            bool   bUseEnv = 0 ;
            bool   bUseRedirectEnv = 0 ;
            if (pParam)
                {
                bUseEnv         = (bool)GetHashValueInt (aTHX_ pParam, "use_env", 0) ;
                bUseRedirectEnv = (bool)GetHashValueInt (aTHX_ pParam, "use_redirect_env", 0) ;
                }

            embperl_GetCGIAppConfig (pThread, pPool, &pApp -> Config, bUseEnv, bUseRedirectEnv, 1) ;
            }

        SetHashValueInt (NULL, pThread -> pApplications, sAppName, (IV)pApp) ;
        
        pApp -> pThread = pThread ;

        if (pParam)
            Embperl__App__Config_new_init(aTHX_ &pApp -> Config, (SV *)pParam, 0) ;

        tainted = 0 ;

        if (pApp -> Config.sLog && pApp -> Config.sLog[0])
            {
            if ((rc = OpenLog (pApp)) != ok)
	        { 
                pApp -> Config.bDebug = 0 ; /* Turn debbuging off, only errors will go to stderr */
	        LogErrorParam (pApp, rc, pApp -> Config.sLog, Strerror(errno)) ;
	        }
            }

        if (pApp -> Config.sAppHandlerClass)
            {
            HV * stash = gv_stashpv(pApp -> Config.sAppHandlerClass, TRUE) ;
            sv_bless(pApp -> _perlsv, stash) ;
            }
        

        embperl_SetupSessionObjects (pApp) ;
        }

    sv_setsv(pThread -> pAppRV, pApp -> _perlsv) ;   
    
    *ppApp = pApp ;

    return ok ;
    }



static int notused ;

#if 0
INTMG (TabCount, pCurrReq -> TableStack.State.nCount, pCurrReq -> TableStack.State.nCountUsed, ;) 
INTMG (TabRow, pCurrReq -> TableStack.State.nRow, pCurrReq -> TableStack.State.nRowUsed, ;) 
INTMG (TabCol, pCurrReq -> TableStack.State.nCol, pCurrReq -> TableStack.State.nColUsed, ;) 
INTMG (TabMaxRow, pCurrReq -> nTabMaxRow, notused,  ;) 
INTMG (TabMaxCol, pCurrReq -> nTabMaxCol, notused, ;) 
INTMG (TabMode, pCurrReq -> nTabMode, notused, ;) 
#endif
INTMG_COMP (EscMode, Config.nEscMode, notused, NewEscMode (CurrReq, pSV)) 
#ifdef EP2
INTMGshort_COMP (CurrNode, xCurrNode) 
#endif

OPTMGRD_COMP (optDisableVarCleanup       , Config.bOptions) 
OPTMG_COMP    (optDisableEmbperlErrorPage, Config.bOptions) 
OPTMG_COMP    (optReturnError            , Config.bOptions) 
OPTMGRD_COMP (optSafeNamespace           , Config.bOptions) 
OPTMGRD_COMP (optOpcodeMask              , Config.bOptions) 
OPTMG_COMP    (optRawInput               , Config.bOptions) 
OPTMG_COMP    (optSendHttpHeader         , Config.bOptions) 
OPTMGRD_COMP (optDisableChdir            , Config.bOptions) 
OPTMG_COMP    (optDisableHtmlScan        , Config.bOptions) 
OPTMGRD_COMP (optEarlyHttpHeader         , Config.bOptions) 
OPTMGRD_COMP (optDisableFormData         , Config.bOptions) 
OPTMG_COMP    (optDisableInputScan       , Config.bOptions) 
OPTMG_COMP    (optDisableTableScan       , Config.bOptions) 
OPTMG_COMP    (optDisableMetaScan        , Config.bOptions) 
OPTMGRD_COMP (optAllFormData             , Config.bOptions) 
OPTMGRD_COMP (optRedirectStdout          , Config.bOptions) 
OPTMG_COMP    (optUndefToEmptyValue      , Config.bOptions) 
OPTMG_COMP    (optNoHiddenEmptyValue     , Config.bOptions) 
OPTMGRD_COMP (optAllowZeroFilesize       , Config.bOptions) 
OPTMGRD_COMP (optKeepSrcInMemory         , Config.bOptions) 
OPTMG_COMP    (optKeepSpaces             , Config.bOptions) 
OPTMG_COMP    (optOpenLogEarly           , Config.bOptions) 
OPTMG_COMP    (optNoUncloseWarn          , Config.bOptions) 


OPTMG_COMP    (dbgStd          , Config.bDebug) 
OPTMG_COMP    (dbgMem          , Config.bDebug) 
OPTMG_COMP    (dbgEval         , Config.bDebug) 
OPTMG_COMP    (dbgCmd          , Config.bDebug) 
OPTMG_COMP    (dbgEnv          , Config.bDebug) 
OPTMG_COMP    (dbgForm         , Config.bDebug) 
OPTMG_COMP    (dbgTab          , Config.bDebug) 
OPTMG_COMP    (dbgInput        , Config.bDebug) 
OPTMG_COMP    (dbgFlushOutput  , Config.bDebug) 
OPTMG_COMP    (dbgFlushLog     , Config.bDebug) 
OPTMG_COMP    (dbgAllCmds      , Config.bDebug) 
OPTMG_COMP    (dbgSource       , Config.bDebug) 
OPTMG_COMP    (dbgFunc         , Config.bDebug) 
OPTMG_COMP    (dbgLogLink      , Config.bDebug) 
OPTMG_COMP    (dbgDefEval      , Config.bDebug) 
OPTMG_COMP    (dbgHeadersIn    , Config.bDebug) 
OPTMG_COMP    (dbgShowCleanup  , Config.bDebug) 
OPTMG_COMP    (dbgProfile      , Config.bDebug) 
OPTMG_COMP    (dbgSession      , Config.bDebug) 
OPTMG_COMP    (dbgImport       , Config.bDebug) 


    
/* ---------------------------------------------------------------------------- */
/* add magic to integer var */
/* */
/* in  sVarName = Name of varibale */
/* in  pVirtTab = pointer to virtual table */
/* */
/* ---------------------------------------------------------------------------- */

static int AddMagic (/*i/o*/ tApp * a,
 		     /*in*/ char *     sVarName,
                     /*in*/ MGVTBL *   pVirtTab) 

    {
    SV * pSV ;
    struct magic * pMagic ;
    epaTHX ;

    EPENTRY (AddMagic) ;

    
    pSV = perl_get_sv (sVarName, TRUE) ;
    sv_magic (pSV, NULL, 0, sVarName, strlen (sVarName)) ;
    sv_setiv (pSV, 0) ;
    pMagic = mg_find (pSV, 0) ;

    if (pMagic)
        pMagic -> mg_virtual = pVirtTab ;
    else
        {
        LogError (NULL, rcMagicError) ;
        return 1 ;
        }

    perl_get_sv (sVarName, TRUE) ; /* avoid warning */

    return ok ;
    }

    
/* ---------------------------------------------------------------------------- */
/* add magic to array								*/
/*										*/
/* in  sVarName = Name of varibale						*/
/* in  pVirtTab = pointer to virtual table					*/
/*										*/
/* ---------------------------------------------------------------------------- */

int AddMagicAV (/*i/o*/ register req * r,
		/*in*/ char *     sVarName,
                /*in*/ MGVTBL *   pVirtTab) 

    {
    SV * pSV ;
    struct magic * pMagic ;
    epTHX ;

    EPENTRY (AddMagicAV) ;

    
    pSV = (SV *)perl_get_av (sVarName, TRUE) ;
    sv_magic (pSV, NULL, 'P', sVarName, strlen (sVarName)) ;
    pMagic = mg_find (pSV, 0) ;

    if (pMagic)
        pMagic -> mg_virtual = pVirtTab ;
    else
        {
        LogError (r, rcMagicError) ;
        return 1 ;
        }


    return ok ;
    }



/* ---------------------------------------------------------------------------- */
/* init embperl module */
/* */
/* in  nIOType = type of requested i/o */
/* */
/* ---------------------------------------------------------------------------- */

int embperl_Init        (/*in*/ pTHX_
                         /*in*/ SV *          pApacheSrvSV,
                         /*in*/ SV *          pPerlParam,
                         /*in*/ server_rec *  ap_s)

    {
    int     rc ;
    tThreadData * pThread ;
    tApp        * pApp ;
    tApacheDirConfig * pApacheCfg = NULL ;


    memcpy (&ep_sv_undef, &PL_sv_undef, sizeof (PL_sv_undef)) ;

#ifdef APACHE
    if (pApacheSrvSV && SvROK (pApacheSrvSV))
        {
        /* when running under mod_perl only register the module */
        /*  rest will be call from module initialzation when config has been read */
        ap_s = epxs_sv2_Apache__Server(pApacheSrvSV) ;
        embperl_ApacheAddModule () ;
#ifdef APACHE2
#else
        return ok ;
#endif
        }
#endif

    if (!pMainPool)
        pMainPool = ep_init_alloc() ;
    
    if ((rc = embperl_SetupThread (aTHX_ &pThread)) != ok)
        return rc ;
    
#ifdef APACHE
    if (ap_s)
        {
        embperl_GetApacheConfig (pThread, NULL, ap_s, &pApacheCfg) ;
        }
#endif

    if ((rc = embperl_SetupApp (aTHX_ pThread, pApacheCfg, pPerlParam, &pApp)) != ok)
        return rc ;
      


    ADDINTMG (EscMode) 
    ADDINTMG (CurrNode) 
    
    ADDOPTMG (optDisableVarCleanup      ) 
    ADDOPTMG (optDisableEmbperlErrorPage) 
    ADDOPTMG (optReturnError) 
    ADDOPTMG (optSafeNamespace          ) 
    ADDOPTMG (optOpcodeMask             ) 
    ADDOPTMG (optRawInput               ) 
    ADDOPTMG (optSendHttpHeader         ) 
    ADDOPTMG (optDisableChdir           ) 
    ADDOPTMG (optDisableHtmlScan        ) 
    ADDOPTMG (optEarlyHttpHeader        ) 
    ADDOPTMG (optDisableFormData        ) 
    ADDOPTMG (optDisableInputScan       ) 
    ADDOPTMG (optDisableTableScan       ) 
    ADDOPTMG (optDisableMetaScan        ) 
    ADDOPTMG (optAllFormData            ) 
    ADDOPTMG (optRedirectStdout         ) 
    ADDOPTMG (optUndefToEmptyValue      ) 
    ADDOPTMG (optNoHiddenEmptyValue     ) 
    ADDOPTMG (optAllowZeroFilesize      ) 
    ADDOPTMG (optKeepSrcInMemory       ) 
    ADDOPTMG (optKeepSpaces            ) 
    ADDOPTMG (optOpenLogEarly          ) 
    ADDOPTMG (optNoUncloseWarn         ) 

    ADDOPTMG   (dbgStd         ) 
    ADDOPTMG   (dbgMem         ) 
    ADDOPTMG   (dbgEval        ) 
    ADDOPTMG   (dbgCmd         ) 
    ADDOPTMG   (dbgEnv         ) 
    ADDOPTMG   (dbgForm        ) 
    ADDOPTMG   (dbgTab         ) 
    ADDOPTMG   (dbgInput       ) 
    ADDOPTMG   (dbgFlushOutput ) 
    ADDOPTMG   (dbgFlushLog    ) 
    ADDOPTMG   (dbgAllCmds     ) 
    ADDOPTMG   (dbgSource      ) 
    ADDOPTMG   (dbgFunc        ) 
    ADDOPTMG   (dbgLogLink     ) 
    ADDOPTMG   (dbgDefEval     ) 
    ADDOPTMG   (dbgHeadersIn   ) 
    ADDOPTMG   (dbgShowCleanup ) 
    ADDOPTMG   (dbgProfile     ) 
    ADDOPTMG   (dbgSession     ) 
    ADDOPTMG   (dbgImport      ) 
   
    if (bInitDone)
        return ok ; /* the rest needs to be done only once per process */

#if defined (_MDEBUG) && defined (WIN32)
    _CrtSetReportHook( EmbperlCRTDebugOutput );
#endif

    DomInit (pApp) ;
    Cache_Init (pApp) ;
    Provider_Init (pApp) ;
#ifdef APACHE2
    ApFilter_Init (pApp) ;
#endif
#ifdef XALAN
    embperl_Xalan_Init () ;
#endif
#ifdef LIBXSLT
    embperl_LibXSLT_Init () ;
#endif

    ep_create_mutex(RequestCountMutex) ;
    
    bInitDone = 1 ;

#ifdef APACHE
    {
    int preload = 1 ;
    if (ap_s)
        {
        module * m ;
        if ((m = ap_find_linked_module("mod_perl.c")))
            {
            if (m -> dynamic_load_handle)
                preload = 0 ;
            }
        }            
    if (preload)
        {
        dSP;
        PUSHMARK(sp) ;
        perl_call_pv ("Embperl::PreLoadFiles", G_DISCARD) ;
        }
    }    
#else
    {
    dSP;
    PUSHMARK(sp) ;
    perl_call_pv ("Embperl::PreLoadFiles", G_DISCARD) ;
    }
#endif    
    

    return rc ;
    }
    

/*---------------------------------------------------------------------------
* embperl_GetFormData
*/
/*!
*
* \_en									   
* Takes the given form data and put them in %fdat/@ffld
* \endif                                                                       
*
* \_de									   
* Nimmt die ?bergebenen Formulardaten und legt sie in %fdat/@ffld ab
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */

static int embperl_GetFormData (/*i/o*/ register req * r,
			        /*in*/ char * pQueryString,
                                /*in*/ int    nLen)

    {
    int     num ;
    char *  p ;
    char *  pMem ;
    int     nVal ;
    int     nKey ;
    char *  pKey ;
    char *  pVal ;
    SV *    pSVV ;
    SV *    pSVK ;
    SV * *  ppSV ;

    AV *    pFormArray      = r -> pThread -> pFormArray ;
    HV *    pFormHash       = r -> pThread -> pFormHash ;
    bool    bAll            = (r -> Config.bOptions & optAllFormData) != 0 ;
    bool    bNoUtf8         = (r -> Config.bOptions & optFormDataNoUtf8) != 0 ;
    bool    bDebug          = (r -> Config.bDebug   & dbgForm) != 0 ;
    int     mayutf8  = 0 ;
    bool    bInValue = 0 ;
    char    c ;
    epTHX ;

    if (nLen == 0)
        return ok ;
    
    if ((pMem = _malloc (r, nLen + 4)) == NULL)
        return rcOutOfMemory ;

    p = pMem ;


    nKey = nVal = 0 ;
    pKey = pVal = p ;
    while (1)
        {
        switch (nLen > 0?*pQueryString:'\0')
            {
            case '+':
                pQueryString++ ;
                nLen-- ;
                *p++ = ' ' ;
                break ;
            
            case '%':
                pQueryString++ ;
                nLen-- ;
                num = 0 ;
                if (*pQueryString)
                    {
                    if (toupper (*pQueryString) >= 'A')
                        num += (toupper (*pQueryString) - 'A' + 10) << 4 ;
                    else
                        num += ((*pQueryString) - '0') << 4 ;
                    pQueryString++ ;
                    }
                if (*pQueryString)
                    {
                    if (toupper (*pQueryString) >= 'A')
                        num += (toupper (*pQueryString) - 'A' + 10) ;
                    else
                        num += ((*pQueryString) - '0') ;
                    pQueryString++ ;
                    nLen-- ;
                    }
                *p++ = num ;
                break ;
            case ';':
            case '&':
                bInValue = 0 ;
                pQueryString++ ;
                nLen-- ;
            case '\0':
                nVal = p - pVal ;
                *p++ = '\0' ;
            
                if (nKey > 0 && (nVal > 0 || (bAll)))
                    {
                    char * sid = NULL ;
                    sid = r -> pApp -> Config.sCookieName ;
		    if (sid)
			{ /* remove session id  */
			if (strncmp (pKey, sid, nKey) != 0)
			    sid = NULL ;
		        else
                            {
                            char * p = strchr(pVal, ':') ;
                            if (p && *p)
                                {
                                char * p2 = strchr(p+1, ':') ;
                                if (p2)
                                    *p2 = '\0' ;
                                r -> sSessionUserID = ep_pstrdup (r -> pPool, p + 1) ;
                                *p = '\0' ;
                                }
                            if (*pVal)
                                r -> sSessionStateID = ep_pstrdup (r -> pPool, pVal) ;
                            }
                        }

		    if (sid == NULL)
			{ /* field is not the session id */
			if (pVal > pKey)
			    pVal[-1] = '\0' ;
                    
			if ((ppSV = hv_fetch (pFormHash, pKey, nKey, 0)))
			    { /* Field exists already -> append separator and field value */
			    sv_catpvn (*ppSV, &r -> Config.cMultFieldSep , 1) ;
			    sv_catpvn (*ppSV, pVal, nVal) ;
			    }
			else
			    { /* New Field -> store it */
			    pSVV = newSVpv (pVal, nVal) ;
#ifdef UTF8_IS_START
			    if (mayutf8 && is_utf8_string((U8*)pVal, nVal))
			    	SvUTF8_on (pSVV) ;
#endif
			    if (hv_store (pFormHash, pKey, nKey, pSVV, 0) == NULL)
				{
				_free (r, pMem) ;
				strcpy (r -> errdat1, "fdat") ;
				return rcHashError ;
				}

			    pSVK = newSVpv (pKey, nKey) ;

			    av_push (pFormArray, pSVK) ;
			    }

                
			if (bDebug)
			    lprintf (r -> pApp,  "[%d]FORM: %s=%s\n", r -> pThread -> nPid, pKey, pVal) ; 
			}
                    }
                pKey = pVal = p ;
                nKey = nVal = 0 ;
		mayutf8 = 0 ;
				                
                if (*pQueryString == '\0')
                    {
                    _free (r, pMem) ;
                    return ok ;
                    }
                
                
                break ;
            case '=':
                if (!bInValue)
                    {
                    nKey = p - pKey ;
                    *p++ = r -> Config.cMultFieldSep ;
                    nVal = 0 ;
                    pVal = p ;
                    pQueryString++ ;
                    nLen-- ;
                    bInValue = 1 ;
                    break ;
                    }
                /* fall through */    
            default:
                c = *p++ = *pQueryString++ ;
                nLen-- ;
#ifdef UTF8_IS_START
                if (!bNoUtf8)
                    mayutf8 += UTF8_IS_START(c) ;
#endif
                break ;
            }
        }

    return ok ;
    }


/*---------------------------------------------------------------------------
* embperl_SetupFormData
*/
/*!
*
* \_en									   
* Get the posted form data and put them in %fdat/@ffld
* \endif                                                                       
*
* \_de									   
* Lie?t die formular daten ein und legt sie in %fdat/@ffld ab
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */


static int embperl_SetupFormData (/*i/o*/ register req * r)

    {
    epTHX_
    char *  p = NULL ;
    char *  f ;
    int     rc = ok ;
    STRLEN  len   = 0 ;
    char    sLen [20] ;
    const char * sType ;

    hv_clear (r -> pThread -> pFormHash) ;
    hv_clear (r -> pThread -> pFormSplitHash) ;
    av_clear (r -> pThread -> pFormArray) ;
    hv_clear (r -> pThread -> pInputHash) ;

    if  (r -> Config.bOptions & optDisableFormData)
        return ok ;
    
    /* print out of env set tainted, so reset it now */
    tainted = 0 ;

#ifdef APACHE
    if (r -> pApacheReq)
        {
        const char * sLength = apr_table_get(r -> pApacheReq->headers_in, "Content-Length") ;
        sType   = apr_table_get(r -> pApacheReq->headers_in, "Content-Type") ;
	len = sLength?atoi (sLength):0 ;
	}
    else
#endif
	{
	sLen [0] = '\0' ;
	GetHashValue (r, r -> pThread -> pEnvHash, "CONTENT_LENGTH", sizeof (sLen) - 1, sLen) ;
	sType = GetHashValueStr (aTHX_ r -> pThread -> pEnvHash, "CONTENT_TYPE", "") ;
	len = atoi (sLen) ;
	}

    if (sType && strncmp (sType, "multipart/form-data", 19) == 0)
        {
        dSP ;

        PUSHMARK(sp);
	XPUSHs(r -> _perlsv); 
	PUTBACK;                        
	perl_call_method ("get_multipart_formdata", G_EVAL) ;
        if (SvTRUE (ERRSV))
	    {
            STRLEN l ;
            strncpy (r -> errdat1, SvPV (ERRSV, l), sizeof (r -> errdat1) - 1) ;
	    LogError (r, rcEvalErr) ; 
            sv_setpv(ERRSV,"");
            POPs ; /* cleanup stack */
            }
	tainted = 0 ;
        return ok ;
        }
   
    
    if (len == 0)
        {
        p = r -> Param.sQueryInfo ;
        len = p?strlen (p):0 ;
        f = NULL ;
        }
    else
        {
        if ((p = _malloc (r, len + 1)) == NULL)
            return rcOutOfMemory ;

        if ((rc = OpenInput (r, NULL)) != ok)
            {
            _free (r, p) ;
            return rc ;
            }
        iread (r, p, len) ;
        CloseInput (r) ;
        
        p[len] = '\0' ;
        f = p ;
        }
        
    if (r  -> Config.bDebug & dbgForm)
        lprintf (r -> pApp,   "[%d]Formdata... length = %d\n", r -> pThread -> nPid, len) ;    

    rc = embperl_GetFormData (r, p, len) ;
    
    if (len > 0 && f)
	{
	r -> Param.sQueryInfo = f ;
	f[len] = '\0' ;
	}

    return rc ;
    }


/*---------------------------------------------------------------------------
* embperl_LogStartReq
*/
/*!
*
* \_en									   
* Log request startup, headers and environment
* \endif                                                                       
*
* \_de									   
* Logged den Requeststart, HTTP-Header und Umgebungsvariablen
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */


static void embperl_LogStartReq (/*i/o*/ req * r)

    {
    epTHX ;
    
    if (r -> Config.bDebug)
        {
        time_t t = time(NULL) ;
        lprintf (r -> pApp,  "[%d]REQ: ***** Start Request at %s", r -> pThread -> nPid, ctime (&t)) ;
        lprintf (r -> pApp,  "[%d]Use App: %s\n", r -> pApp -> pThread -> nPid, r -> pApp -> Config.sAppName) ; 
        }



#ifdef APACHE
    if (r -> pApacheReq && (r -> Config.bDebug & dbgHeadersIn))
        {
        int i;
        const apr_array_header_t *hdrs_arr;
        apr_table_entry_t  *hdrs;

        hdrs_arr = apr_table_elts (r -> pApacheReq->headers_in);
        hdrs = (apr_table_entry_t *)hdrs_arr->elts;

        lprintf (r -> pApp,   "[%d]HDR:  %d\n", r -> pThread -> nPid, hdrs_arr->nelts) ; 
        for (i = 0; i < hdrs_arr->nelts; ++i)
	    if (hdrs[i].key)
                lprintf (r -> pApp,   "[%d]HDR:  %s=%s\n", r -> pThread -> nPid, hdrs[i].key, hdrs[i].val) ; 
        }
#endif
    if (r -> Config.bDebug & dbgEnv)
        {
        SV *   psv ;
        HE *   pEntry ;
        char * pKey ;
        I32    l ;
        int  savewarn = dowarn ;
        dowarn = 0 ; /* no warnings here */
        
        hv_iterinit (r -> pThread -> pEnvHash) ;
        while ((pEntry = hv_iternext (r -> pThread -> pEnvHash)))
            {
            pKey = hv_iterkey (pEntry, &l) ;
            psv  = hv_iterval (r -> pThread -> pEnvHash, pEntry) ;

                lprintf (r -> pApp,   "[%d]ENV:  %s=%s\n", r -> pThread -> nPid, pKey, SvPV (psv, na)) ; 
            }
        dowarn = savewarn ;
        }

    }



/*---------------------------------------------------------------------------
* embperl_SetupRequest
*/
/*!
*
* \_en									   
* setup data for (http-)request object
* \endif                                                                       
*
* \_de									   
* Initialisiert das Requestobjekt
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */


int    embperl_SetupRequest (/*in*/ pTHX_
                             /*in*/ SV *             pApacheReqSV,
                             /*in*/ tApp *           pApp,
                             /*in*/ tApacheDirConfig *  pApacheCfg,
                             /*in*/ SV *             pPerlParam,
                             /*out*/tReq * *         ppReq)
                     
                     
    {
    tReq *          r ;
    tThreadData *   pThread ;
    SV *            pReqSV ;
    SV *            pReqRV ;
    SV * pSV ;
    SV * pRV ;
    tReqConfig *    pConfig ;
    tReqParam  *    pParam ;
    char *          pCookieName ;
    HV *            pParamHV = NULL ;
    dSP ;

#ifdef APACHE
    request_rec * pApacheReq  ;
#endif
    tMemPool * pPool = ep_make_sub_pool (pApp -> pPool) ;

    tainted = 0 ;

    if (pPerlParam && SvROK(pPerlParam))
        pParamHV = (HV *)SvRV(pPerlParam) ;

    epxs_Embperl__Req_create_obj(r,pReqSV,pReqRV,ep_palloc(pPool,sizeof(*r))) ;
    epxs_Embperl__Req__Config_create_obj(pConfig,pSV,pRV,&r->Config) ;
    epxs_Embperl__Req__Param_create_obj(pParam,pSV,pRV,&r->Param) ;
#ifdef PERL_IMPLICIT_CONTEXT
    r -> pPerlTHX = aTHX ;
#endif
    r -> pPool         = pPool ;
    pConfig -> pPool   = pPool ;
    pParam  -> pPool   = pPool ;

    r -> pApp = pApp ;
    pThread = r -> pThread = pApp -> pThread  ;
    r -> pPrevReq = pThread -> pCurrReq  ;
    pThread -> pCurrReq = r ;
    pApp ->    pCurrReq = r ;
    sv_setsv(pThread -> pReqRV, r -> _perlsv) ;   
    
    r -> startclock      = clock () ;
    r -> stsv_count      = sv_count ;

#ifdef PERL_IMPLICIT_CONTEXT
    r -> pPerlTHX = aTHX ;
#endif


    
#ifdef APACHE
    if (SvROK (pApacheReqSV))
        pApacheReq = r -> pApacheReq = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV));
    else
        pApacheReq = r -> pApacheReq = NULL ;
    r -> pApacheReqSV = SvREFCNT_inc(pApacheReqSV) ;
    if (pApacheReq)
        {
        embperl_GetApacheReqConfig (pApp, pPool, pApacheCfg, &r -> Config) ;
        embperl_GetApacheReqParam  (pApp, pPool, pApacheReq, &r -> Param) ;
        }
    else
#endif
        {
        bool   bUseEnv = 0 ;
        bool   bUseRedirectEnv = 0 ;
        if (pParamHV)
            {
            bUseEnv         = (bool)GetHashValueInt (aTHX_ pParamHV, "use_env", 0) ;
            bUseRedirectEnv = (bool)GetHashValueInt (aTHX_ pParamHV, "use_redirect_env", 0) ;
            }
        embperl_GetCGIReqConfig (pApp, pPool, &r -> Config, bUseEnv, bUseRedirectEnv, 1) ;
        embperl_GetCGIReqParam  (pApp, pPool, &r -> Param) ;
        }
    
    if (pParamHV)
        {
        char * fn = GetHashValueStrDup(aTHX_ pPool, pParamHV, "inputfile", NULL) ;
        Embperl__Req__Config_new_init(aTHX_ &r -> Config, (SV *)pParamHV, 0) ;
        Embperl__Req__Param_new_init(aTHX_ &r -> Param, (SV *)pParamHV, 0) ;
        if (fn)
            r -> Param.sFilename = fn ;
        
        }

    tainted = 0 ;


    /*if (r -> Config.bDebug)
	lprintf (r -> pApp,  "[%d]ep_acquire_mutex(RequestCountMutex)\n", r -> pThread -> nPid) ; */
    ep_acquire_mutex(RequestCountMutex) ;
    r -> nRequestCount   = nRequestCount++ ;
    ep_release_mutex(RequestCountMutex) ;
    /*if (r -> Config.bDebug)
	lprintf (r -> pApp,  "[%d]ep_release_mutex(RequestCountMutex)\n", r -> pThread -> nPid) ; */
    r -> nRequestTime    = time(NULL) ;

    r -> pErrArray  = newAV () ;
    r -> pDomTreeAV = newAV () ; 
    r -> pCleanupAV = newAV () ; 
    r -> pCleanupPackagesHV = newHV () ; 
    r -> pMessages = newAV () ;    
    r -> pDefaultMessages = newAV () ;    

    pCookieName = r -> pApp -> Config.sCookieName ;
    if (pCookieName)
	{ /* remove session id  */
        char * pVal = GetHashValueStr (aTHX_ r -> Param.pCookies, pCookieName, NULL) ;
        if (pVal)
            r -> sSessionUserID = ep_pstrdup (r -> pPool, pVal) ;
        }

    if (r -> pApp -> Config.sCookieExpires)
        {
        char buf[256] ; 

        if (!embperl_CalcExpires(r -> pApp -> Config.sCookieExpires, buf, 0)) 
            LogErrorParam (r -> pApp, rcTimeFormatErr, "EMBPERL_COOKIE_EXPIRES", r -> pApp -> Config.sCookieExpires) ; 
        else
            r -> sCookieExpires = ep_pstrdup (r -> pPool, buf) ;    
        }    

    if (r -> pApp -> pUserHash)
        r -> nSessionMgnt = 1 ;

    r -> nLogFileStartPos = GetLogFilePos (pApp) ;

    hv_clear (pThread -> pHeaderHash) ;

    embperl_LogStartReq (r) ;

    embperl_SetupFormData (r) ;

    if (r -> sSessionUserID && pApp -> pUserObj)
        {
        tainted = 0 ;
        SPAGAIN;
        PUSHMARK(sp);
	XPUSHs(pApp -> pUserObj); 
	XPUSHs(sv_2mortal(newSVpv(r -> sSessionUserID, 0))); 
	PUTBACK;                        
	perl_call_method ("setid", 0) ;
        }

    if (r -> sSessionStateID && pApp -> pStateObj)
        {
        tainted = 0 ;
        SPAGAIN;
        PUSHMARK(sp);
	XPUSHs(pApp -> pStateObj); 
	XPUSHs(sv_2mortal(newSVpv(r -> sSessionStateID, 0))); 
	PUTBACK;                        
	perl_call_method ("setid", 0) ;
        }

    
    r -> sInitialCWD = ep_palloc(pPool, PATH_MAX * 2) ;
    if (! getcwd (r -> sInitialCWD, PATH_MAX * 2 - 1) )
      {
	perror("could not getcwd() in epinit.c");
	exit(1);
      }

    *ppReq = r ;

    if (pApp -> Config.sAppHandlerClass)
        {
        tainted = 0 ;
        SPAGAIN ;
        PUSHMARK(sp);
	XPUSHs(pApp -> _perlsv); 
	XPUSHs(r -> _perlsv); 
	PUTBACK;                        
	perl_call_method ("init", G_EVAL) ;
        tainted = 0 ;

        if (SvTRUE (ERRSV))
	    {
            STRLEN l ;
            POPs ; /* cleanup stack */
            LogErrorParam (pApp, rcEvalErr, SvPV (ERRSV, l), " while calling APP_HANDLER_CLASS -> init") ;
            sv_setpv(ERRSV,"");
            return rcEvalErr ;
            }
        }

    tainted = 0 ;
    
    return ok ;
    }
    
/*---------------------------------------------------------------------------
* embperl_CleanupOutput
*/
/*!
*
* \_en									   
* cleanup data for component output object
* \endif                                                                       
*
* \_de									   
* R?umt das Component-Ausgabe Objekt auf
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_CleanupOutput   (/*in*/ tReq *                r,
                                /*in*/ tComponent *           c)
                     
                     
    {
    epTHX_
    tComponentOutput * pOutput = c -> pOutput ;

    if (!pOutput || (c -> pPrev && c -> pPrev -> pOutput == pOutput))
        { /* this component uses the main output object */
        return ok ;
        }

    CloseOutput (r, pOutput) ;

    if (SvREFCNT(SvRV(pOutput -> _perlsv)) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", (int)SvREFCNT(SvRV(pOutput -> _perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component.output") ;
        }            
    sv_unmagic(SvRV(pOutput -> _perlsv), '~') ;
    SvREFCNT_dec (pOutput -> _perlsv) ;
    ep_destroy_pool (pOutput -> pPool) ;

    return ok ;
    }

    
/*---------------------------------------------------------------------------
* embperl_CleanupComponent
*/
/*!
*
* \_en									   
* cleanup component object
* \endif                                                                       
*
* \_de									   
* Component-Objekt aufr?umen
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_CleanupComponent  (/*in*/ tComponent *          c)
                     
                     
    {
    tReq *  r = c -> pReq ;
    epTHX_
    SV * pHV ;
    MAGIC * mg;

    if (c -> Param.sISA && c -> sCurrPackage)
        {
        STRLEN  l ;
        SV * pName = newSVpvf ("%s::ISA", c -> sImportPackage) ;
        AV * pCallerISA = perl_get_av (SvPV(pName, l), TRUE) ;
        int i ;
        int n = av_len(pCallerISA) + 1;
        SV ** ppSV ;
        newSVpvf2(pName) ;

        SvREFCNT_dec (pName) ;
        
        for (i = 0; i < n; i++)
            {
            if ((ppSV = av_fetch(pCallerISA, i, 0)) && *ppSV && strcmp (SvPV(*ppSV, l), c -> sCurrPackage) == 0)
                break ;
            }

        if (n == i)
            av_push(pCallerISA, newSVpv (c -> sCurrPackage, 0)) ;
        }
        
    embperl_CleanupOutput (r, c) ;

    if (SvREFCNT(SvRV(c -> Config._perlsv)) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", (int)SvREFCNT(SvRV(c -> Config._perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component.config") ;
        }            
    if (SvREFCNT(SvRV(c -> Param._perlsv)) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", (int)SvREFCNT(SvRV(c -> Param._perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component.param") ;
        }            
    if (SvREFCNT(c -> _perlsv) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", (int)SvREFCNT(SvRV(c -> _perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.component") ;
        }            


    Embperl__Component__Config_destroy(aTHX_ &c -> Config) ;
    Embperl__Component__Param_destroy(aTHX_ &c -> Param) ;
    Embperl__Component_destroy(aTHX_ c) ;

    pHV = SvRV (c -> _perlsv) ;
    if ((mg = mg_find (pHV, '~')))
        *((tComponent **)(mg -> mg_ptr)) = &NullRequest.Component ;
    pHV = SvRV (c -> Config._perlsv) ;
    if ((mg = mg_find (pHV, '~')))
        *((tComponentConfig **)(mg -> mg_ptr)) = &NullRequest.Component.Config ;
    pHV = SvRV (c -> Param._perlsv) ;
    if ((mg = mg_find (pHV, '~')))
        *((tComponentParam **)(mg -> mg_ptr)) = &NullRequest.Component.Param ;

    SvREFCNT_dec (c -> Config._perlsv) ;
    SvREFCNT_dec (c -> Param._perlsv) ;
    SvREFCNT_dec (c -> _perlsv) ;


    if (c == &r -> Component && c -> pPrev)
        { /* we have a previous component, so let restore it */
        tComponent * pPrev = c -> pPrev;

        memcpy (c, pPrev, sizeof (*c)) ;
        
	/* adjust pointer in perl magic */
        pHV = SvRV (c -> _perlsv) ;
        if ((mg = mg_find (pHV, '~')))
            *((tComponent **)(mg -> mg_ptr)) = c ;
        pHV = SvRV (c -> Config._perlsv) ;
        if ((mg = mg_find (pHV, '~')))
            *((tComponentConfig **)(mg -> mg_ptr)) = &c -> Config ;
        pHV = SvRV (c -> Param._perlsv) ;
        if ((mg = mg_find (pHV, '~')))
            *((tComponentParam **)(mg -> mg_ptr)) = &c -> Param ;
        }
    else
        {
        c -> _perlsv = NULL ;
        }
    
    return ok ;
    }


/*---------------------------------------------------------------------------
* embperl_CleanupRequest
*/
/*!
*
* \_en									   
* cleanup request
* \endif                                                                       
*
* \_de									   
* Das Requestobjekt aufr?umen
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */

int    embperl_CleanupRequest (/*in*/ tReq *  r) 

    {
    epTHX_
    int     i ;
    HE *    pEntry ;
    I32     l ;
    tApp *  pApp = r -> pApp ;
    SV *    pHV ;
    MAGIC * mg;
    dSP ;

    
    hv_iterinit (r -> pCleanupPackagesHV) ;
    while ((pEntry = hv_iternext (r -> pCleanupPackagesHV)))
        {
	char * sPackage = hv_iterkey (pEntry, &l) ;
        ClearSymtab (r, sPackage, r -> Config.bDebug & dbgShowCleanup) ;
        }
    tainted = 0 ;

    sv_setsv(r -> pThread -> pReqRV, &sv_undef) ;   

    while (r -> Component._perlsv)
        embperl_CleanupComponent(&r -> Component) ;
    
    if (r -> nSessionMgnt)
        {
        SPAGAIN ;
        PUSHMARK(sp);
        XPUSHs(pApp -> pAppObj); 
        PUTBACK;                        
        perl_call_method ("cleanup", G_DISCARD) ;
        SPAGAIN ;
        PUSHMARK(sp);
        XPUSHs(pApp -> pUserObj); 
        PUTBACK;                        
        perl_call_method ("cleanup", G_DISCARD) ;
        SPAGAIN ;
        PUSHMARK(sp);
        XPUSHs(pApp -> pStateObj); 
        PUTBACK;                        
        perl_call_method ("cleanup", G_DISCARD) ;
        SPAGAIN ;
        }
    
    hv_clear (r -> pThread -> pHeaderHash) ;
    hv_clear (r -> pThread -> pInputHash) ;
    av_clear (r -> pThread -> pFormArray) ;
    hv_clear (r -> pThread -> pFormHash) ;
    hv_clear (r -> pThread -> pFormSplitHash) ;
    /*
    for (i = 0 ; i <= av_len (r -> pDomTreeAV); i++)
	{
	SV ** ppSV = av_fetch (r -> pDomTreeAV, i, 0) ;   
        SV * pSV = * ppSV ;
        lprintf (r -> pApp, "r -> pDomTreeAV DomTree #%d type = %d cnt=%d n=%d\n", i, SvTYPE(pSV), SvREFCNT(pSV), SvIVX(pSV)) ;
	}
    */
    av_clear (r -> pDomTreeAV) ;
    SvREFCNT_dec (r -> pDomTreeAV) ;
    for (i = 0 ; i <= av_len (r -> pCleanupAV); i++)
	{
	SV ** ppSV = av_fetch (r -> pCleanupAV, i, 0) ;   
        SV * pSV = * ppSV ;
	/*
        if (SvROK(pSV))
            lprintf (r -> pApp, "r -> pCleanupAV DomTree #%d type = %d cnt=%d n=%d\n", i, SvTYPE(SvRV(pSV)), SvREFCNT(SvRV(pSV)), SvIVX(SvRV(pSV))) ;
	*/
        if (SvROK(pSV))
            sv_setsv (SvRV(pSV), &sv_undef) ;
	}
    av_clear (r -> pCleanupAV) ;

    Cache_CleanupRequest (r) ;

    if (SvREFCNT(SvRV(r -> Config._perlsv)) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", (int)SvREFCNT(SvRV(r -> Config._perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.config") ;
        }            
    if (SvREFCNT(SvRV(r -> Param._perlsv)) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", (int)SvREFCNT(SvRV(r -> Param._perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request.param") ;
        }            
    /*
    if (SvREFCNT(SvRV(r -> _perlsv)) != 1)
        {
        char buf[20] ;
        sprintf (buf, "%d", SvREFCNT(SvRV(r -> _perlsv)) - 1) ;
        LogErrorParam (r -> pApp, rcRefcntNotOne, buf, "request") ;
        }            
        */

    /* cleanup errarray manualy, to avoid segv incase error in destroy */
    SvREFCNT_dec (r -> pErrArray) ;
    r -> pErrArray = NULL ;

    
    Embperl__Req__Config_destroy(aTHX_ &r -> Config) ;
    Embperl__Req__Param_destroy(aTHX_ &r -> Param) ;
    Embperl__Req_destroy(aTHX_ r) ;

    pHV = SvRV (r -> _perlsv) ;
    if ((mg = mg_find (pHV, '~')))
        *((tReq **)(mg -> mg_ptr)) = &NullRequest ;
    pHV = SvRV (r -> Config._perlsv) ;
    if ((mg = mg_find (pHV, '~')))
        *((tReqConfig **)(mg -> mg_ptr)) = &NullRequest.Config ;
    pHV = SvRV (r -> Param._perlsv) ;
    if ((mg = mg_find (pHV, '~')))
        *((tReqParam **)(mg -> mg_ptr)) = &NullRequest.Param ;
    
   
    SvREFCNT_dec (r -> Config._perlsv) ;
    SvREFCNT_dec (r -> Param._perlsv) ;
    SvREFCNT_dec (r -> _perlsv) ;
    
    ep_destroy_pool (r -> pPool) ;
    sv_setpv(ERRSV,"");

    if (r -> Config.bDebug)
	DomStats (r -> pApp) ;

    r -> pThread -> pCurrReq = r -> pPrevReq ;
    r -> pApp ->    pCurrReq = r -> pPrevReq ;

    if (r -> pPrevReq)
        sv_setsv(r -> pThread -> pReqRV, r -> pPrevReq -> _perlsv) ;   

    
    return ok ;
    }





/*---------------------------------------------------------------------------
* embperl_SetupOutput
*/
/*!
*
* \_en									   
* setup data for component output object
* \endif                                                                       
*
* \_de									   
* Initialisiert das Component-Ausgabe Objekt
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_SetupOutput     (/*in*/ tReq *                r,
                                /*in*/tComponent *           c)
                     
                     
    {
    epTHX_
    int          rc ;
    SV *         pSV ;
    SV *         pRV ;
    tComponentOutput * pOutput ;
    tMemPool * pPool  ;

    if (!c -> Param.pOutput && !c -> Param.sOutputfile && c -> pPrev && !r -> Component.pImportStash)
        { /* this component uses the main output object */
        c -> pOutput = c -> pPrev -> pOutput ;
        return ok ;
        }

    pPool = ep_make_sub_pool (r -> pPool) ;

    tainted = 0 ;
    epxs_Embperl__Component__Output_create_obj(pOutput,pSV,pRV,ep_palloc(pPool,sizeof(tComponentOutput))) ;
    tainted = 0 ;
    pOutput -> pPool         = pPool ;
    c -> pOutput = pOutput ;

    if (r -> Component.pImportStash)
	pOutput -> bDisableOutput = 1 ;
    else if (c -> Param.pOutput)
        {
        if ((rc = OpenOutput (r, "")) != ok)
            return rc ;
        }
    else
        {
        if ((rc = OpenOutput (r, embperl_File2Abs(r, pOutput -> pPool, c -> Param.sOutputfile))) != ok)
            return rc ;
        }

    return ok ;
    }


/*---------------------------------------------------------------------------
* embperl_SetupComponent
*/
/*!
*
* \_en									   
* setup data for component object
* \endif                                                                       
*
* \_de									   
* Initialisiert das Component-Objekt
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */



int    embperl_SetupComponent  (/*in*/ tReq *                 r,
                                /*in*/ SV *                   pPerlParam,
                                /*out*/tComponent * *         ppComponent)
                     
                     
    {
    int          rc ;
    SV *         pComponentSV ;
    SV *         pComponentRV ;
    SV *         pSV ;
    SV *         pRV ;
    tComponent * c ;
    tComponentParam * pParam ;
    tComponentConfig * pConfig ;
    epTHX_
    tComponent * pPrev = NULL ;
    char * p ;
    HV *         pParamHV = NULL ;

    if (r -> Component._perlsv)
        { /* we have already a component, so let safe it first */
        SV * pHV ;
        MAGIC * mg ;

        pPrev = ep_palloc(r->pPool,sizeof(*pPrev)) ;

        memcpy (pPrev, &r -> Component, sizeof (*pPrev)) ;
        
	/* adjust pointer in perl magic */
        pHV = SvRV (pPrev -> _perlsv) ;
        if ((mg = mg_find (pHV, '~')))
            *((tComponent **)(mg -> mg_ptr)) = pPrev ;
        pHV = SvRV (pPrev -> Config._perlsv) ;
        if ((mg = mg_find (pHV, '~')))
            *((tComponentConfig **)(mg -> mg_ptr)) = &pPrev -> Config ;
        pHV = SvRV (pPrev -> Param._perlsv) ;
        if ((mg = mg_find (pHV, '~')))
            *((tComponentParam **)(mg -> mg_ptr)) = &pPrev -> Param ;
        }

    if (pPerlParam && SvROK(pPerlParam))
        pParamHV = (HV *)SvRV(pPerlParam) ;
   
    epxs_Embperl__Component_create_obj(c,pComponentSV, pComponentRV,&r->Component) ;
    epxs_Embperl__Component__Param_create_obj(pParam,pSV, pRV,&r->Component.Param) ;
    epxs_Embperl__Component__Config_create_obj(pConfig,pSV, pRV,&r->Component.Config) ;
    
    r -> Component.pPrev = pPrev ;

    c -> pPool         = r -> pPool ;
    pParam -> pPool    = r -> pPool ;
    pConfig -> pPool   = r -> pPool ;

    c -> Param.nImport = -1 ;
    c -> Param.nFirstLine = 1 ;

    c -> pReq = r ;
#ifdef APACHE
    if (r -> pApacheReq)
        {
        embperl_GetApacheComponentConfig (r, r -> pPool, r -> pApacheConfig, &c -> Config) ;
        }
    else
#endif
        {
        bool   bUseEnv = 0 ;
        bool   bUseRedirectEnv = 0 ;
        if (pParamHV)
            {
            bUseEnv         = (bool)GetHashValueInt (aTHX_ pParamHV, "use_env", 0) ;
            bUseRedirectEnv = (bool)GetHashValueInt (aTHX_ pParamHV, "use_redirect_env", 0) ;
            }
        embperl_GetCGIComponentConfig (r, r -> pPool, &c -> Config, bUseEnv, bUseRedirectEnv, 1) ;
        }
    
    if (pPrev)
        c -> Config.bOptions &= ~optReturnError ;
    
    if (pParamHV)
        {
        Embperl__Component__Config_new_init (aTHX_ &c -> Config, (SV *)pParamHV, 0) ;
        Embperl__Component__Param_new_init  (aTHX_ &c -> Param, (SV *)pParamHV, 0) ;
        }

    c -> sCWD = pPrev?pPrev -> sCWD:r -> sInitialCWD ;
    if (c -> sCWD == NULL)
        c -> sCWD = "" ;

    NewEscMode (r, NULL) ;
    c -> bEscModeSet = 0 ;

    if (c -> Param.nImport < 0 && (c -> Param.sObject || c -> Param.sISA))
        c -> Param.nImport = 0 ;

    if (c -> Param.nImport >= 0)
	{
        char code[40] ;
        SV * pSVImport ;
        STRLEN l ;

        sprintf (code, "caller(%d)", c -> Param.nImport>0?c -> Param.nImport:1) ; 
        /* there is no c api to the caller function, eval it... */
        pSVImport = perl_eval_pv(code, 0) ;
        if (!SvOK(pSVImport))
            {
            if (c -> Param.nImport == 0)
                c -> sImportPackage = "main" ;
            else
	        {
	        LogError (r, rcImportStashErr) ;
                c -> sImportPackage = NULL ;
	        }
            }
        else
            c -> sImportPackage = ep_pstrdup(r -> pPool, SvPV (pSVImport, l)) ;

        if (c -> sImportPackage)
            {
            if ((c -> pImportStash = gv_stashpv (c -> sImportPackage, 0)) == NULL)
	        {
	        strncpy (r -> errdat1, c -> sImportPackage, sizeof (r -> errdat1) - 1);
	        LogError (r, rcImportStashErr) ;
	        }
            SvREFCNT_inc(c -> pImportStash) ;
            }
	}

    c -> nSourceline = pParam -> nFirstLine ;
    if (!pParam -> sInputfile) 
        {
        if (pParam -> sISA)
            pParam -> sInputfile = pParam -> sISA ;
        else if (pParam -> sObject)
            pParam -> sInputfile = pParam -> sObject ;
        else
            {
            if (pPrev)
                pParam -> sInputfile = pPrev -> sSourcefile ;
            if (!pParam -> sInputfile)
                pParam -> sInputfile = r -> Param.sFilename ;
            }
        }
    else if ((p = strchr(pParam -> sInputfile, '#')))
        {
        pParam -> sSub = p + 1 ;
        if (p == pParam -> sInputfile && c -> pPrev)
            pParam -> sInputfile = c -> pPrev -> sSourcefile ;
        else
            *p = '\0' ;
        }
    if (!pParam -> sInputfile || !*pParam -> sInputfile || strcmp(pParam -> sInputfile, "*") == 0) 
        pParam -> sInputfile = r -> Param.sFilename ;
    else if (strcmp(pParam -> sInputfile, "../*") == 0) 
        {
#ifdef WIN32
        char * p = strrchr(r -> Param.sFilename, '\\') ;
        if (!p)
            p = strrchr(r -> Param.sFilename, '/') ;                
#else
        char * p = strrchr(r -> Param.sFilename, '/') ;
#endif
        if (!p)
            p = r -> Param.sFilename ;
        else
            p++ ;
        
        pParam -> sInputfile = ep_pstrcat(r -> pPool, "../", p, NULL) ;
        }

    *ppComponent = c ;

    if (!pParam -> sInputfile)
        rc = rcMissingInput ;
    else
        rc = embperl_SetupOutput (r, c) ;
    if (rc != ok)
        LogError (r, rc) ;
    return rc ;
    }






/*---------------------------------------------------------------------------
* embperl_InitRequest
*/
/*!
*
* \_en									   
* Initialize the Thread and Application object and if available return the
* Apache configuration data
* \endif                                                                       
*
* \_de									   
* Initialisiert das Thread und Application Objekt und leifert, soweit vorhanden,
* die Apache Konfiguration
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */




int     embperl_InitAppForRequest (/*in*/ pTHX_
                             /*in*/ SV *             pApacheReqSV,
                             /*in*/ SV *             pPerlParam,
                             /*out*/tThreadData * *  ppThread,
                             /*out*/tApp * *         ppApp,
                             /*out*/tApacheDirConfig * * ppApacheCfg)


    {
    int              rc ;
    tThreadData *    pThread ;
    tApp  *          pApp ;
    tApacheDirConfig * pApacheCfg = NULL ;

    
    /* get our thread object */
    if ((rc = embperl_SetupThread (aTHX_ &pThread)) != ok)
        {
        LogError (NULL, rc) ;
        return rc ;
        }

#ifdef APACHE
    if (pApacheReqSV && SvROK (pApacheReqSV))
        {
        request_rec * ap_r = (request_rec *)SvIV((SV*)SvRV(pApacheReqSV));
        
        embperl_GetApacheConfig (pThread, ap_r, ap_r -> server, &pApacheCfg) ;
        
        }
#endif

    /* get the application object */
    if ((rc = embperl_SetupApp (aTHX_ pThread, pApacheCfg, pPerlParam, &pApp)) != ok)
        {
        LogError (NULL, rc) ;
        return rc ;
        }


    *ppThread    = pThread ;
    *ppApp       = pApp ;
    *ppApacheCfg = pApacheCfg ;

    return ok ;
    }


/*---------------------------------------------------------------------------
* embperl_InitRequest
*/
/*!
*
* \_en									   
* Initialize all necessary data structures to start a request like thread,
* application and request object
* \endif                                                                       
*
* \_de									   
* Initialisiert alle n?tigen Datenstrukturen um den Request zu starten, wie
* Thread-, Applikcation und Request-Objekt.
* \endif                                                                       
*                                                                          
* ------------------------------------------------------------------------ */




int     embperl_InitRequest (/*in*/ pTHX_
                             /*in*/ SV *             pApacheReqSV,
                             /*in*/ SV *             pPerlParam,
                             /*out*/tReq * *         ppReq)


    {
    int              rc ;
    tThreadData *    pThread ;
    tApp  *          pApp ;
    tReq  *          r ;
    tApacheDirConfig * pApacheCfg = NULL ;

    
    /* get our thread & Application object */

    if ((rc = embperl_InitAppForRequest (aTHX_
                                         pApacheReqSV,
                                         pPerlParam,
                                         &pThread,
                                         &pApp,
                                         &pApacheCfg)) != ok)
        {
        LogError (NULL, rc) ;
        return rc ;
        }


    /* and setup the request object */
    if ((rc = embperl_SetupRequest (aTHX_ pApacheReqSV, pApp, pApacheCfg, pPerlParam, &r)) != ok)
        {
        LogErrorParam (pApp, rc, NULL, NULL) ;
        return rc ;
        }

    r -> pApacheConfig = pApacheCfg ;
   
    *ppReq = r ;

    if (r -> Config.pAllow || r -> Config.pUriMatch)
        {
        SV * args[1] ;
        SV * pRet ;
        STRLEN l ;

        if (r -> Param.sUri && *r -> Param.sUri)
            args[0] = newSVpv (r -> Param.sUri, 0) ;
        else if (r -> Param.sFilename && *r -> Param.sFilename)
            args[0] = newSVpv (r -> Param.sFilename, 0) ;
        else if (pPerlParam  && SvROK(pPerlParam))
            args[0] = (SV *)GetHashValueSVinc (r, (HV *)SvRV(pPerlParam), "inputfile", &sv_undef) ;
        else
            {
            LogError (r, rcCannotCheckUri) ;
            return rcCannotCheckUri ;
            }

        if (r -> Config.pAllow)
            {
            CallStoredCV (r, "ALLOW", r -> Config.pAllow, 1, args, 0, &pRet) ;
            if (pRet && !SvTRUE(pRet))
                {
                strncpy (r -> errdat1, SvPV(args[0], l), sizeof(r -> errdat1) - 1) ;
                SvREFCNT_dec(args[0]) ;
                if (pRet)
                    SvREFCNT_dec(pRet) ;
                LogError (r, rcForbidden) ;
                return rcForbidden ;
                }
            if (pRet)
                SvREFCNT_dec(pRet) ;
            }

        if (r -> Config.pUriMatch)
            {
            CallStoredCV (r, "URIMATCH", r -> Config.pUriMatch, 1, args, 0, &pRet) ;
            if (pRet && !SvTRUE(pRet))
                {
                strncpy (r -> errdat1, SvPV(args[0], l), sizeof(r -> errdat1) - 1) ;
                SvREFCNT_dec(args[0]) ;
                if (pRet)
                    SvREFCNT_dec(pRet) ;
                return rcDecline ;
                }
            if (pRet)
                SvREFCNT_dec(pRet) ;
            }
        SvREFCNT_dec(args[0]) ;
        }    

    return ok ;
    }




int     embperl_InitRequestComponent (/*in*/ pTHX_
                             /*in*/ SV *             pApacheReqSV,
                             /*in*/ SV *             pPerlParam,
                             /*out*/tReq * *         ppReq)

    {
    int rc ;
    tComponent * pComponent ;
    
    if ((rc = embperl_InitRequest (aTHX_ pApacheReqSV, pPerlParam, ppReq)) != ok)
        return rc ;

    return embperl_SetupComponent  (*ppReq, pPerlParam, &pComponent) ;
    }