richter 02/02/26 00:48:43
Modified: . Tag: Embperl2c Embperl.pm ep.h epapinit.c epcfg.h
epcgiinit.c epdat2.h epeval.c epinit.c eputil.c
xsbuilder/maps Tag: Embperl2c ep_structure.map
Log:
session handling
Revision Changes Path
No revision
No revision
1.118.4.89 +44 -1 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.88
retrieving revision 1.118.4.89
diff -u -r1.118.4.88 -r1.118.4.89
--- Embperl.pm 25 Feb 2002 11:20:25 -0000 1.118.4.88
+++ Embperl.pm 26 Feb 2002 08:48:42 -0000 1.118.4.89
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.118.4.88 2002/02/25 11:20:25 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.89 2002/02/26 08:48:42 richter Exp $
#
###################################################################################
@@ -111,6 +111,7 @@
}
#######################################################################################
+
sub Warn
{
local $^W = 0 ;
@@ -173,6 +174,48 @@
}
#######################################################################################
+
+sub get_multipart_formdata
+ {
+ my ($self) = @_ ;
+
+ my $dbgForm = $self -> config -> debug & Embperl::Constant::dbgForm ;
+
+ # just let CGI.pm read the multipart form data, see cgi docu
+ require CGI ;
+
+ my $cgi = new CGI ;
+ my $fdat = $self -> thread -> form_hash ;
+ my $ffld = $self -> thread -> form_array ;
+ @$ffld = $cgi->param;
+
+ $self -> log ("[$$]FORM: Read multipart formdata,
length=$ENV{CONTENT_LENGTH}\n") if ($dbgForm) ;
+ my $params ;
+ foreach ( @$ffld )
+ {
+ # the param_fetch needs CGI.pm 2.43
+ #$params = $cgi->param_fetch( $_ ) ;
+ $params = $cgi->{$_} ;
+ if ($#$params > 0)
+ {
+ $fdat->{ $_ } = join ("\t", @$params) ;
+ }
+ else
+ {
+ $fdat->{ $_ } = $params -> [0] ;
+ }
+
+ $self -> log ("[$$]FORM: $_=$fdat->{$_}\n") if ($dbgForm) ;
+
+ if (ref($fdat->{$_}) eq 'Fh')
+ {
+ $fdat->{"-$_"} = $cgi -> uploadInfo($fdat->{$_}) ;
+ }
+ }
+ }
+
+#######################################################################################
+
sub SendErrorDoc ()
1.27.4.44 +2 -0 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27.4.43
retrieving revision 1.27.4.44
diff -u -r1.27.4.43 -r1.27.4.44
--- ep.h 12 Feb 2002 09:11:44 -0000 1.27.4.43
+++ ep.h 26 Feb 2002 08:48:42 -0000 1.27.4.44
@@ -593,6 +593,8 @@
AV * embperl_String2AV (/*in*/ tApp * pApp,
/*in*/ const char * sData,
/*in*/ const char * sSeparator) ;
+HV * embperl_String2HV (/*in*/ tApp * a,
+ /*in*/ const char * sData) ;
/* ---- from epeval.c ----- */
1.1.2.20 +12 -4 embperl/epapinit.c
Index: epapinit.c
===================================================================
RCS file: /home/cvs/embperl/epapinit.c,v
retrieving revision 1.1.2.19
retrieving revision 1.1.2.20
diff -u -r1.1.2.19 -r1.1.2.20
--- epapinit.c 25 Feb 2002 11:20:25 -0000 1.1.2.19
+++ epapinit.c 26 Feb 2002 08:48:42 -0000 1.1.2.20
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epapinit.c,v 1.1.2.19 2002/02/25 11:20:25 richter Exp $
+# $Id: epapinit.c,v 1.1.2.20 2002/02/26 08:48:42 richter Exp $
#
###################################################################################*/
@@ -31,6 +31,7 @@
#define EPCFG_BOOL EPCFG
#define EPCFG_CV EPCFG
#define EPCFG_SV EPCFG
+#define EPCFG_HV EPCFG
#define EPCFG_REGEX EPCFG
#define EPCFG_CHAR EPCFG
#define EPCFG_APP
@@ -318,7 +319,7 @@
#define EPCFG_BOOL(STRUCT,TYPE,NAME,CFGNAME) \
char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, tApacheDirConfig *
pDirCfg, char * arg) \
{ \
- pDirCfg -> STRUCT.NAME = arg ; \
+ pDirCfg -> STRUCT.NAME = (TYPE)arg ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
return NULL; \
}
@@ -339,7 +340,7 @@
char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, tApacheDirConfig *
pDirCfg, char* arg) \
{ \
epdcTHX_ \
- pDirCfg -> STRUCT.NAME = newSVpv(arg, 0) ; \
+ pDirCfg -> STRUCT.NAME = newSVpv((char *)arg, 0) ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
return NULL; \
}
@@ -348,7 +349,7 @@
#define EPCFG_CHAR(STRUCT,TYPE,NAME,CFGNAME) \
char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, tApacheDirConfig *
pDirCfg, char * arg) \
{ \
- pDirCfg -> STRUCT.NAME = arg[0] ; \
+ pDirCfg -> STRUCT.NAME = (TYPE)arg[0] ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
return NULL; \
}
@@ -367,6 +368,13 @@
#undef EPCFG_AV
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,SEPARATOR) \
+char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, tApacheDirConfig *
pDirCfg, char * arg) \
+ { \
+ return "unimplemented" ; \
+ }
+
+#undef EPCFG_HV
+#define EPCFG_HV(STRUCT,TYPE,NAME,CFGNAME) \
char * embperl_Apache_Config_##STRUCT##NAME (cmd_parms *cmd, tApacheDirConfig *
pDirCfg, char * arg) \
{ \
return "unimplemented" ; \
1.1.2.10 +3 -2 embperl/Attic/epcfg.h
Index: epcfg.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epcfg.h,v
retrieving revision 1.1.2.9
retrieving revision 1.1.2.10
diff -u -r1.1.2.9 -r1.1.2.10
--- epcfg.h 25 Feb 2002 11:20:25 -0000 1.1.2.9
+++ epcfg.h 26 Feb 2002 08:48:42 -0000 1.1.2.10
@@ -40,8 +40,9 @@
/* tAppConfig */
EPCFG_STR(AppConfig, char *, sAppName, APPNAME)
-EPCFG_STR(AppConfig, char *, sSessionArgs, SESSION_ARGS)
-EPCFG_STR(AppConfig, char *, sSessionClasses, SESSION_CLASSES)
+EPCFG_STR(AppConfig, char *, sSessionHandlerClass, SESSION_HANDLER_CLASS)
+EPCFG_HV (AppConfig, HV *, pSessionArgs, SESSION_ARGS)
+EPCFG_AV (AppConfig, AV *, pSessionClasses, SESSION_CLASSES, " ,")
EPCFG_STR(AppConfig, char *, sSessionConfig, SESSION_CONFIG)
EPCFG_STR(AppConfig, char *, sCookieName, COOKIE_NAME)
EPCFG_STR(AppConfig, char *, sCookieDomain, COOKIE_DOMAIN)
1.1.2.11 +17 -1 embperl/Attic/epcgiinit.c
Index: epcgiinit.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcgiinit.c,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -u -r1.1.2.10 -r1.1.2.11
--- epcgiinit.c 25 Feb 2002 11:20:25 -0000 1.1.2.10
+++ epcgiinit.c 26 Feb 2002 08:48:42 -0000 1.1.2.11
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcgiinit.c,v 1.1.2.10 2002/02/25 11:20:25 richter Exp $
+# $Id: epcgiinit.c,v 1.1.2.11 2002/02/26 08:48:42 richter Exp $
#
###################################################################################*/
@@ -57,6 +57,7 @@
tainted = 0 ; \
if (arg) \
pConfig -> NAME = newSVpv (arg, 0) ; \
+ tainted = 0 ; \
}
#undef EPCFG_AV
@@ -68,6 +69,19 @@
tainted = 0 ; \
if (arg) \
pConfig -> NAME = embperl_String2AV(pApp, arg, SEPARATOR) ;\
+ tainted = 0 ; \
+ }
+
+#undef EPCFG_HV
+#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME) \
+ { \
+ char * arg ; \
+ tainted = 0 ; \
+ arg = GetHashValueStr (aTHX_ pThread -> pEnvHash, "EMBPERL_"#CFGNAME, NULL) ; \
+ tainted = 0 ; \
+ if (arg) \
+ pConfig -> NAME = embperl_String2HV(pApp, arg) ;\
+ tainted = 0 ; \
}
#undef EPCFG_CV
@@ -81,6 +95,7 @@
if (arg) \
if ((rc = EvalConfig (pApp, sv_2mortal(newSVpv(arg, 0)), 0, NULL,
"Configuration: EMBPERL_"#CFGNAME, &pConfig -> NAME)) != ok) \
return rc ; \
+ tainted = 0 ; \
}
#undef EPCFG_REGEX
@@ -94,6 +109,7 @@
if (arg) \
if ((rc = EvalRegEx (pApp, arg, "Configuration: EMBPERL_"#CFGNAME, &pConfig
-> NAME)) != ok) \
return rc ; \
+ tainted = 0 ; \
}
1.1.2.27 +10 -8 embperl/Attic/epdat2.h
Index: epdat2.h
===================================================================
RCS file: /home/cvs/embperl/Attic/epdat2.h,v
retrieving revision 1.1.2.26
retrieving revision 1.1.2.27
diff -u -r1.1.2.26 -r1.1.2.27
--- epdat2.h 25 Feb 2002 11:20:26 -0000 1.1.2.26
+++ epdat2.h 26 Feb 2002 08:48:42 -0000 1.1.2.27
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epdat2.h,v 1.1.2.26 2002/02/25 11:20:26 richter Exp $
+# $Id: epdat2.h,v 1.1.2.27 2002/02/26 08:48:42 richter Exp $
#
###################################################################################*/
@@ -121,8 +121,9 @@
SV * _perlsv ; /**< The perl reference to this structure */
tMemPool * pPool ; /**< pool for memorymanagement */
char * sAppName ;
- char * sSessionArgs ;
- char * sSessionClasses ;
+ char * sSessionHandlerClass ;
+ HV * pSessionArgs ;
+ AV * pSessionClasses ;
char * sSessionConfig ;
char * sCookieName ;
char * sCookieDomain ;
@@ -204,12 +205,13 @@
struct tReq * pCurrReq ; /**< Current running request if any */
tAppConfig Config ; /**< application configuration data */
FILEIO * lfd ; /**< log file handle */
- SV * pUserSession ; /**< user session object */
- SV * pStateSession ; /**< state session object */
- HV * pUserHash ; /* Session User data */
- HV * pStateHash ; /* Session State data */
- HV * pModHash ; /* Module data */
+ HV * pUserHash ; /**< Session User data */
+ SV * pUserObj ; /**< Session User object */
+ HV * pStateHash ; /**< Session State data */
+ SV * pStateObj ; /**< Session State object */
+ HV * pAppHash ; /**< Session Application data */
+ SV * pAppObj ; /**< Session Application object */
} tApp ;
1.23.4.22 +29 -8 embperl/epeval.c
Index: epeval.c
===================================================================
RCS file: /home/cvs/embperl/epeval.c,v
retrieving revision 1.23.4.21
retrieving revision 1.23.4.22
diff -u -r1.23.4.21 -r1.23.4.22
--- epeval.c 25 Feb 2002 11:20:26 -0000 1.23.4.21
+++ epeval.c 26 Feb 2002 08:48:42 -0000 1.23.4.22
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epeval.c,v 1.23.4.21 2002/02/25 11:20:26 richter Exp $
+# $Id: epeval.c,v 1.23.4.22 2002/02/26 08:48:42 richter Exp $
#
###################################################################################*/
@@ -146,10 +146,18 @@
{
SV * pSVErr ;
SV * pRV ;
+ int n ;
- pRV = perl_eval_pv (s, 0) ;
+ n = perl_eval_sv (pSV, G_EVAL | G_SCALAR) ;
tainted = 0 ;
- if (SvROK (pRV))
+
+ SPAGAIN;
+ if (n > 0)
+ pRV = POPs;
+ PUTBACK;
+
+ tainted = 0 ;
+ if (n > 0 && SvROK (pRV))
{
*pCV = (CV *)SvRV (pRV) ;
SvREFCNT_inc (*pCV) ;
@@ -228,6 +236,8 @@
SV * pRV ;
SV * pSVErr ;
char c ;
+ int n ;
+ dSP ;
if (sRegex[0] == '!')
{
@@ -241,9 +251,19 @@
tainted = 0 ;
pSV = newSVpvf ("package Embperl::Regex ; sub { $_[0] %c~ m{%s} }", c, sRegex) ;
- p = SvPV(pSV, l) ;
- pRV = perl_eval_pv (p, 0) ;
+ /* perl_eval_pv seems to be broken in 5.005_03!! */
+ /* p = SvPV(pSV, l) ; */
+ /* pRV = perl_eval_pv (p, 0) ; */
+
+ n = perl_eval_sv (pSV, G_EVAL | G_SCALAR) ;
+ SvREFCNT_dec(pSV);
+ tainted = 0 ;
+ SPAGAIN;
+ if (n > 0)
+ pRV = POPs;
+ PUTBACK;
+
pSVErr = ERRSV ;
if (SvTRUE (pSVErr))
{
@@ -253,17 +273,18 @@
sv_setpv(pSVErr,"");
*ppCV = NULL ;
- SvREFCNT_dec (pSV) ;
return rcEvalErr ;
}
- if (SvROK (pRV))
+ if (n > 0 && SvROK (pRV))
{
*ppCV = (CV *)SvRV (pRV) ;
SvREFCNT_inc (*ppCV) ;
}
+ else
+ *ppCV = NULL ;
+
- SvREFCNT_dec (pSV) ;
return ok ;
}
1.1.2.29 +195 -21 embperl/Attic/epinit.c
Index: epinit.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epinit.c,v
retrieving revision 1.1.2.28
retrieving revision 1.1.2.29
diff -u -r1.1.2.28 -r1.1.2.29
--- epinit.c 25 Feb 2002 11:20:26 -0000 1.1.2.28
+++ epinit.c 26 Feb 2002 08:48:42 -0000 1.1.2.29
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epinit.c,v 1.1.2.28 2002/02/25 11:20:26 richter Exp $
+# $Id: epinit.c,v 1.1.2.29 2002/02/26 08:48:42 richter Exp $
#
###################################################################################*/
@@ -203,6 +203,7 @@
{
pCfg -> sAppName = "Embperl" ;
pCfg -> sCookieName = "EMBPERL_UID" ;
+ pCfg -> sSessionHandlerClass = "Apache::SessionX" ;
#ifdef WIN32
pCfg -> sLog = "\\embperl.log" ;
#else
@@ -212,6 +213,163 @@
}
+/*---------------------------------------------------------------------------
+* embperl_CreateSessionObject
+*/
+/*!
+*
+* \_en
+* Creates a new session object.
+*
+* \endif
+*
+* \_de
+* Erzeugt eine neues Sessionobjekt.
+*
+* \endif
+*
+* ------------------------------------------------------------------------ */
+
+
+
+static int embperl_CreateSessionObject(/*in*/ tApp * a,
+ /*in*/ SV * pArgs,
+ /*out*/ SV * * ppHash,
+ /*out*/ SV * * ppObj)
+
+
+ {
+ epaTHX_
+ dSP ;
+
+ char * sPackage = a -> sSessionHandlerClass ;
+ HV * pHash = newHV () ;
+ SV * pTie = newRV_noinc((SV *)newHV()) ;
+ hv_magic(pHash, pTie, 'P') ;
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSVpv(sPackage, 0)));
+ XPUSHs(&sv_undef); /* id */
+ XPUSHs(pArgs);
+ PUTBACK;
+ n = perl_call_method ("TIEHASH", G_EVAL) ;
+ if (SvTRUE (ERRSV))
+ {
+ STRLEN l ;
+ strncpy (r -> errdat1, SvPV (ERRSV, l), sizeof (r -> errdat1) - 1) ;
+ sv_setpv(ERRSV,"");
+ return rcEvalError ;
+ }
+ if (n > 0)
+ pTie = POPs ;
+ if (n == 0 || !SvROK(pTie))
+ {
+ strncpy (r -> errdat1, "Session handling", sizeof (r -> errdat1) - 1) ;
+ strncpy (r -> errdat1, sPackage, sizeof (r -> errdat1) - 1) ;
+ return rcNotHashRef ;
+ }
+
+ *ppHash = pHash ;
+ *ppObj = 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 ;
+ HV * pArgs = a -> pSessionArgs ;
+ HV * pArgs1 ;
+ HV * pArgs2 ;
+ HV * pArgs3 ;
+
+ if (!pArgs)
+ a -> pSessionArgs = pArgs = newHV() ;
+
+ if (a -> pSessionClasses)
+ {
+ if ((ppStore = av_fetch (a -> pSessionClasses, 0, 0)))
+ pStore = *ppStore ;
+ if (!pStore)
+ pStore = sv_2mortal(newSVpv("File", 4)) ;
+ hv_store (pArgs, "Store", 5, pStore, 0) ;
+
+ if ((ppLocker = av_fetch (a -> pSessionClasses, 1, 0)))
+ pLocker = *ppLocker ;
+ if (!pLocker)
+ pLocker = sv_2mortal(newSVpv("Null", 4)) ;
+ hv_store (pArgs, "Locker", 6, pLocker, 0) ;
+
+ if ((ppSerializer = av_fetch (a -> pSessionClasses, 2, 0)))
+ pSerializer = *ppSerializer ;
+ if (!pSerializer)
+ pSerializer = sv_2mortal(newSVpv("Storable", 8)) ;
+ hv_store (pArgs, "Serialize", 9, pSerializer, 0) ;
+
+ if ((ppGenerator = av_fetch (a -> pSessionClasses, 3, 0)))
+ pGenerator = *ppGenerator ;
+ if (!pGenerator)
+ pGenerator = sv_2mortal(newSVpv("MD5", 3)) ;
+ hv_store (pArgs, "Generate", 8, pGenerator, 0) ;
+ }
+
+ if (a -> sSessionConfig)
+ hv_store (pArgs, "config", 5, newSVpv (a -> 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) ;
+
+ if ((rc = embperl_CreateSessionObject (a, pArgs1, pApp -> pModHash, pApp ->
pModObj)) != ok)
+ return rc ;
+
+ pArgs2 = newHVhv(pArgs) ;
+ hv_store (pArgs2, "recreate_id", 11, newSViv (1), 0) ;
+ pArgs3 = newHVhv(pArgs2) ;
+
+ if ((rc = embperl_CreateSessionObject (a, pArgs2, pApp -> pUserHash, pApp ->
pUserObj)) != ok)
+ return rc ;
+
+ hv_store (pArgs3, "newid", 5, newSViv (1), 0) ;
+
+ if ((rc = embperl_CreateSessionObject (a, pArgs3, pApp -> pStateHash, pApp ->
pStateObj)) != ok)
+ return rc ;
+
+
+ return ok ;
+ }
+
/*---------------------------------------------------------------------------
* embperl_SetupApp
@@ -224,6 +382,8 @@
* one.
*
* @param pThread per thread data
+* @param pApacheCfg apache configuration vector
+* @param pPerlParam parameters passed from Perl
* \endif
*
* \_de
@@ -231,6 +391,8 @@
* 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
*
* ------------------------------------------------------------------------ */
@@ -295,6 +457,7 @@
pApp -> pThread = pThread ;
+ *ppApp = pApp ;
if (pApp -> Config.sLog && pApp -> Config.sLog[0])
{
@@ -305,26 +468,11 @@
}
}
-
- /*
- if ((pApp ->pUserHash = perl_get_hv (sUserHashName, TRUE)) == NULL)
- {
- LogError (r, rcHashError) ;
- }
-
- if ((pApp ->pStateHash = perl_get_hv (sStateHashName, TRUE)) == NULL)
+ if ((rc = embperl_SetupSessionObjects (pApp)) != ok)
{
- LogError (r, rcHashError) ;
- }
-
- if ((pApp ->pModHash = perl_get_hv (sModHashName, TRUE)) == NULL)
- {
- LogError (r, rcHashError) ;
+ LogErrorParam (pApp, rc, NULL, NULL) ;
+ return rc ;
}
- */
-
- if (pPerlParam && SvROK(pPerlParam))
- Embperl__App__Config_new_init(aTHX_ &pApp -> Config, SvRV(pPerlParam),
0) ;
}
*ppApp = pApp ;
@@ -788,13 +936,13 @@
static int embperl_SetupFormData (/*i/o*/ register req * r)
{
+ epTHX_
char * p = NULL ;
char * f ;
int rc = ok ;
STRLEN len = 0 ;
char sLen [20] ;
- epTHX ;
-
+ const char * sType ;
hv_clear (r -> pThread -> pFormHash) ;
hv_clear (r -> pThread -> pFormSplitHash) ;
@@ -811,6 +959,7 @@
if (r -> pApacheReq)
{
const char * sLength = table_get(r -> pApacheReq->headers_in,
"Content-Length") ;
+ sType = table_get(r -> pApacheReq->headers_in, "Content-Type") ;
len = sLength?atoi (sLength):0 ;
}
else
@@ -818,9 +967,30 @@
{
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,"");
+ }
+ tainted = 0 ;
+ return ok ;
+ }
+
+
if (len == 0)
{
p = r -> Param.sQueryInfo ;
@@ -899,6 +1069,8 @@
#endif
tMemPool * pPool = ep_make_sub_pool (pApp -> pPool) ;
+ tainted = 0 ;
+
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) ;
@@ -952,6 +1124,7 @@
r -> Param.sFilename = GetHashValueStrDup(aTHX_ pPool, (HV *)pHV,
"inputfile", NULL) ;
}
+ tainted = 0 ;
r -> pApp = pApp ;
pThread = r -> pThread = pApp -> pThread ;
@@ -987,6 +1160,7 @@
getcwd (r -> sInitialCWD, PATH_MAX * 2 - 1) ;
*ppReq = r ;
+ tainted = 0 ;
return ok ;
}
1.15.4.45 +65 -1 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.44
retrieving revision 1.15.4.45
diff -u -r1.15.4.44 -r1.15.4.45
--- eputil.c 25 Feb 2002 11:20:26 -0000 1.15.4.44
+++ eputil.c 26 Feb 2002 08:48:42 -0000 1.15.4.45
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eputil.c,v 1.15.4.44 2002/02/25 11:20:26 richter Exp $
+# $Id: eputil.c,v 1.15.4.45 2002/02/26 08:48:42 richter Exp $
#
###################################################################################*/
@@ -1641,6 +1641,70 @@
}
return pAV ;
+ }
+
+
+
+/* ---------------------------------------------------------------------------- */
+/* */
+/* Split string into hash */
+/* */
+/* ---------------------------------------------------------------------------- */
+
+
+HV * embperl_String2HV (/*in*/ tApp * a,
+ /*in*/ const char * sData)
+
+ {
+ HV * pHV ;
+ char * p ;
+ char * q ;
+ char * pVal ;
+ char * pKeyEnd ;
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX ;
+
+ if (a)
+ aTHX = a -> pPerlTHX ;
+ else
+ aTHX = PERL_GET_THX ;
+#endif
+
+ pHV = newHV () ;
+
+
+ while (*sData)
+ {
+ while (isspace(*sData))
+ sData++ ;
+
+ p = strchr (sData, '=') ;
+ if (!p)
+ break ;
+ pKeyEnd = p ;
+ while (pKeyEnd > sData && isspace(pKeyEnd[-1]))
+ pKeyEnd-- ;
+
+ p++ ;
+ while (isspace(*p))
+ p++ ;
+
+ if (*p == '\'' || *p == '"')
+ q = *p++ ;
+ else
+ q = ' ' ;
+
+ pVal = p ;
+ while (*p && p != q)
+ p++ ;
+
+ hv_store(pHV, sData, pKeyEnd - sData, newSVpv(pVal, p - pVal)) ;
+ sData = p ;
+ if (*sData)
+ sData++ ;
+ }
+
+ return pHV ;
}
No revision
No revision
1.1.2.18 +16 -14 embperl/xsbuilder/maps/Attic/ep_structure.map
Index: ep_structure.map
===================================================================
RCS file: /home/cvs/embperl/xsbuilder/maps/Attic/ep_structure.map,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -u -r1.1.2.17 -r1.1.2.18
--- ep_structure.map 25 Feb 2002 11:20:30 -0000 1.1.2.17
+++ ep_structure.map 26 Feb 2002 08:48:43 -0000 1.1.2.18
@@ -58,18 +58,19 @@
<tApp>
! _perlsv
-! pPerlTHX | perl_thx
-! pPool | pool
- pThread | thread
- pCurrReq | curr_req
- Config | config
+! pPerlTHX | perl_thx
+! pPool | pool
+ pThread | thread
+ pCurrReq | curr_req
+ Config | config
lfd
- pUserSession | user_session
- pStateSession | state_session
- pUserHash | user_hash
- pStateHash | state_hash
- pModHash | mod_hash
- bDebug | debug
+ pUserObj | user_session
+ pStateObj | state_session
+ pAppObj | app_session
+ pUserHash | udat
+ pStateHash | sdat
+ pAppHash | mdat
+ bDebug | debug
new
! private
</tApp>
@@ -78,9 +79,10 @@
<tAppConfig>
! _perlsv
sAppName | app_name
- sSessionArgs | session_args
- sSessionClasses | session_classes
- sSessionConfig | session_config
+ pSessionArgs | session_args
+ pSessionClasses | session_classes
+ sSessionConfig | session_config
+ sSessionHandlerClass | session_handler_class
sCookieName | cookie_name
sCookieDomain | cookie_domain
sCookiePath | cookie_path
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
