You are viewing a plain text version of this content. The canonical link for it is here.
Posted to embperl-cvs@perl.apache.org by ri...@apache.org on 2002/05/20 08:09:50 UTC
cvs commit: embperl Changes.pod Embperl.xs epapinit.c epinit.c
richter 02/05/19 23:09:50
Modified: . Tag: Embperl2c Changes.pod Embperl.xs epapinit.c
epinit.c
Log:
fix segfaults
Revision Changes Path
No revision
No revision
1.129.4.68 +3 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.67
retrieving revision 1.129.4.68
diff -u -r1.129.4.67 -r1.129.4.68
--- Changes.pod 14 May 2002 12:24:33 -0000 1.129.4.67
+++ Changes.pod 20 May 2002 06:09:50 -0000 1.129.4.68
@@ -19,6 +19,9 @@
- readd possibility to build version with and without Apache support
on windows.
- Remove Content-Length: 0 HTTP-Header in CGI Mode
+ - Fixed segfault when replacing an attribute. Reported by Michael Stevens.
+ - Fixed random segfaults, that had occured when Perl had reallocated it's
+ internal Stack.
=head1 2.0b7 (BETA) 21. Mar. 2002
1.29.4.50 +2 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.49
retrieving revision 1.29.4.50
diff -u -r1.29.4.49 -r1.29.4.50
--- Embperl.xs 12 Mar 2002 09:39:39 -0000 1.29.4.49
+++ Embperl.xs 20 May 2002 06:09:50 -0000 1.29.4.50
@@ -49,6 +49,7 @@
Embperl__Req ppReq;
PPCODE:
RETVAL = embperl_InitRequest(aTHX_ pApacheReqSV, pPerlParam, &ppReq);
+ SPAGAIN;
EXTEND(SP, 2) ;
PUSHs(epxs_IV_2obj(RETVAL)) ;
PUSHs(epxs_Embperl__Req_2obj(ppReq)) ;
@@ -61,6 +62,7 @@
Embperl__Req ppReq;
PPCODE:
RETVAL = embperl_InitRequestComponent(aTHX_ pApacheReqSV, pPerlParam, &ppReq);
+ SPAGAIN;
EXTEND(SP, 2) ;
PUSHs(epxs_IV_2obj(RETVAL)) ;
PUSHs(epxs_Embperl__Req_2obj(ppReq)) ;
1.1.2.32 +85 -5 embperl/epapinit.c
Index: epapinit.c
===================================================================
RCS file: /home/cvs/embperl/epapinit.c,v
retrieving revision 1.1.2.31
retrieving revision 1.1.2.32
diff -u -r1.1.2.31 -r1.1.2.32
--- epapinit.c 21 Mar 2002 06:48:09 -0000 1.1.2.31
+++ epapinit.c 20 May 2002 06:09:50 -0000 1.1.2.32
@@ -10,15 +10,21 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epapinit.c,v 1.1.2.31 2002/03/21 06:48:09 richter Exp $
+# $Id: epapinit.c,v 1.1.2.32 2002/05/20 06:09:50 richter Exp $
#
###################################################################################*/
#include "ep.h"
+/* use getenv from runtime library and not from Perl */
+#undef getenv
+#undef getpid
+//#define gettid GetCurrentThreadId
+
#ifdef APACHE
+static int bApDebug = 0 ;
/* define config prototypes */
@@ -129,11 +135,20 @@
void embperl_ApacheAddModule ()
{
+ char * p = getenv("EMBPERL_APDEBUG") ;
+ bApDebug = p?atoi(p):0 ;
+
if (!ap_find_linked_module("embperl.c"))
{
- embperl_module.name = "embperl.c" ;
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: About to add embperl.c as dynamic module [%d/%d]\n", getpid(), gettid()) ;
+
+ embperl_module.name = "embperl.c" ;
ap_add_module (&embperl_module) ;
}
+ else
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: embperl.c already added as dynamic module [%d/%d]\n", getpid(), gettid()) ;
}
@@ -144,12 +159,15 @@
pool * subpool = ap_make_sub_pool(p);
dTHX ;
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: ApacheInit [%d/%d]\n", getpid(), gettid()) ;
+
ap_register_cleanup(subpool, NULL, embperl_ApacheInitCleanup, embperl_ApacheInitCleanup);
ap_add_version_component ("Embperl/"VERSION) ;
if ((rc = embperl_Init (aTHX_ NULL, NULL, s)) != ok)
{
- fprintf ((FILE *)stderr, "Initialization of Embperl failed (#%d)\n", rc) ;
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Initialization of Embperl failed (#%d)\n", rc) ;
}
}
@@ -159,8 +177,22 @@
module * m ;
/* make sure embperl module is removed before mod_perl in case mod_perl is loaded dynamicly*/
if (m = ap_find_linked_module("mod_perl.c"))
+ {
if (m -> dynamic_load_handle)
+ {
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: ApacheInitCleanup: mod_perl.c dynamicly loaded -> remove embperl.c [%d/%d]\n", getpid(), gettid()) ;
ap_remove_module (&embperl_module) ;
+ }
+ else
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: ApacheInitCleanup: mod_perl.c not dynamic loaded [%d/%d]\n", getpid(), gettid()) ;
+ }
+ else
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: ApacheInitCleanup: mod_perl.c not found [%d/%d]\n", getpid(), gettid()) ;
+
+
}
@@ -174,6 +206,9 @@
embperl_DefaultComponentConfig (&cfg -> ComponentConfig) ;
cfg -> bUseEnv = -1 ;
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: create_dir_config [%d/%d]\n", getpid(), gettid()) ;
+
return cfg;
}
@@ -188,6 +223,10 @@
embperl_DefaultComponentConfig (&cfg -> ComponentConfig) ;
cfg -> bUseEnv = -1 ;
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: create_server_config [%d/%d]\n", getpid(), gettid()) ;
+
+
return cfg;
}
@@ -248,6 +287,10 @@
memcpy (mrg, base, sizeof (*mrg)) ;
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: merge_dir/server_config\n") ;
+
+
#include "epcfg.h"
if (add -> bUseEnv >= 0)
@@ -263,6 +306,9 @@
static char * embperl_Apache_Config_useenv (cmd_parms *cmd, tApacheDirConfig * pDirCfg, bool arg)
{ \
pDirCfg -> bUseEnv = arg ;
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: Set UseEnv = %d\n", arg) ;
+
return NULL; \
}
@@ -279,12 +325,20 @@
if(r && r->per_dir_config)
{
*ppConfig = (tApacheDirConfig *) get_module_config(r->per_dir_config, &embperl_module);
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: GetApacheConfig for dir\n") ;
}
else if(s && s->lookup_defaults) /*s->module_config)*/
{
*ppConfig = (tApacheDirConfig *) get_module_config(s->lookup_defaults /*s->module_config*/, &embperl_module);
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: GetApacheConfig for server\n") ;
}
}
+ else
+ if (bApDebug)
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: GetApacheConfig -> no config available for %s\n",r && r->per_dir_config?"dir":"server" ) ;
+
return ok ;
}
@@ -313,14 +367,21 @@
#undef EPCFG_SV
#define EPCFG_SV(STRUCT,TYPE,NAME,CFGNAME) \
if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
- pDirCfg -> STRUCT.NAME = newSVpv((char *)pDirCfg -> save_##STRUCT##NAME, 0) ;
-
+ { \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: About to convert "#CFGNAME" to perl data\n") ; \
+\
+ pDirCfg -> STRUCT.NAME = newSVpv((char *)pDirCfg -> save_##STRUCT##NAME, 0) ; \
+ }
#undef EPCFG_CV
#define EPCFG_CV(STRUCT,TYPE,NAME,CFGNAME) \
if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
{ \
int rc ;\
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: About to convert "#CFGNAME" to perl data\n") ; \
+\
if ((rc = EvalConfig (pApp, sv_2mortal(newSVpv(pDirCfg -> save_##STRUCT##NAME, 0)), 0, NULL, "Configuration: EMBPERL_"#CFGNAME, &pDirCfg -> STRUCT.NAME)) != ok) \
LogError (pReq, rc) ; \
return rc ; \
@@ -331,6 +392,9 @@
#define EPCFG_AV(STRUCT,TYPE,NAME,CFGNAME,SEPARATOR) \
if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
{ \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: About to convert "#CFGNAME" to perl data\n") ; \
+\
pDirCfg -> STRUCT.NAME = embperl_String2AV(pApp, pDirCfg -> save_##STRUCT##NAME, SEPARATOR) ;\
tainted = 0 ; \
}
@@ -340,6 +404,9 @@
#define EPCFG_HV(STRUCT,TYPE,NAME,CFGNAME) \
if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
{ \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: About to convert "#CFGNAME" to perl data\n") ; \
+\
pDirCfg -> STRUCT.NAME = embperl_String2HV(pApp, pDirCfg -> save_##STRUCT##NAME, ' ', NULL) ;\
tainted = 0 ; \
}
@@ -350,6 +417,9 @@
if (pDirCfg -> save_##STRUCT##NAME && !pDirCfg -> STRUCT.NAME) \
{ \
int rc ; \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: About to convert "#CFGNAME" to perl data\n") ; \
+\
if ((rc = EvalRegEx (pApp, pDirCfg -> save_##STRUCT##NAME, "Configuration: EMBPERL_"#CFGNAME, &pDirCfg -> STRUCT.NAME)) != ok) \
return rc ; \
tainted = 0 ; \
@@ -535,6 +605,8 @@
{ \
pDirCfg -> STRUCT.NAME = (TYPE)strtol(arg, NULL, 0) ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: Set "#CFGNAME" = %s\n", arg) ; \
return NULL; \
}
@@ -544,6 +616,8 @@
{ \
pDirCfg -> STRUCT.NAME = (TYPE)arg ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: Set "#CFGNAME" = %s\n", arg) ; \
return NULL; \
}
@@ -555,6 +629,8 @@
pool * p = cmd -> pool ; \
pDirCfg -> STRUCT.NAME = ap_pstrdup(p, arg) ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: Set "#CFGNAME" = %s\n", arg) ; \
return NULL; \
}
@@ -564,6 +640,8 @@
{ \
pDirCfg -> STRUCT.NAME = (TYPE)arg[0] ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: Set "#CFGNAME" = %s\n", arg) ; \
return NULL; \
}
@@ -584,6 +662,8 @@
{ \
pDirCfg -> save_##STRUCT##NAME = ap_pstrdup(cmd -> pool, arg) ; \
pDirCfg -> set_##STRUCT##NAME = 1 ; \
+ if (bApDebug) \
+ aplog_error (APLOG_MARK, APLOG_WARNING | APLOG_NOERRNO, NULL, "Embperl: Set "#CFGNAME" = %s (save for later conversion to Perl data)\n", arg) ; \
return NULL ; \
}
1.1.2.48 +10 -7 embperl/Attic/epinit.c
Index: epinit.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epinit.c,v
retrieving revision 1.1.2.47
retrieving revision 1.1.2.48
diff -u -r1.1.2.47 -r1.1.2.48
--- epinit.c 17 May 2002 14:07:01 -0000 1.1.2.47
+++ epinit.c 20 May 2002 06:09:50 -0000 1.1.2.48
@@ -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.47 2002/05/17 14:07:01 richter Exp $
+# $Id: epinit.c,v 1.1.2.48 2002/05/20 06:09:50 richter Exp $
#
###################################################################################*/
@@ -251,7 +251,7 @@
pSVCode = newSVpvf ("require %s", sPackage) ;
newSVpvf2(pSVCode) ;
/* there is no c api to the require function, eval it... */
- perl_eval_sv(pSVCode, G_EVAL) ;
+ perl_eval_sv(pSVCode, G_EVAL | G_DISCARD) ;
SvREFCNT_dec(pSVCode);
tainted = 0 ;
@@ -270,7 +270,11 @@
XPUSHs(&sv_undef); /* id */
XPUSHs(sv_2mortal (newRV((SV *)pArgs)));
PUTBACK;
- n = perl_call_method ("TIEHASH", G_EVAL) ;
+ n = perl_call_method ("TIEHASH", G_EVAL | G_SCALAR) ;
+ SPAGAIN;
+ if (n > 0)
+ pTie = POPs ;
+ PUTBACK;
if (SvTRUE (ERRSV))
{
STRLEN l ;
@@ -278,10 +282,6 @@
sv_setpv(ERRSV,"");
return rcEvalErr ;
}
- SPAGAIN;
- if (n > 0)
- pTie = POPs ;
- PUTBACK;
if (n == 0 || !SvROK(pTie))
{
LogErrorParam (a, rcSetupSessionErr, "TIEHASH didn't returns a hashref", sPackage) ;
@@ -392,6 +392,7 @@
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)));
@@ -1065,6 +1066,7 @@
strncpy (r -> errdat1, SvPV (ERRSV, l), sizeof (r -> errdat1) - 1) ;
LogError (r, rcEvalErr) ;
sv_setpv(ERRSV,"");
+ POPs ; /* cleanup stack */
}
tainted = 0 ;
return ok ;
@@ -1366,6 +1368,7 @@
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 ;
---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-cvs-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-cvs-help@perl.apache.org