cvs commit: modperl-2.0/src/modules/perl modperl_module.c
stas2002/12/12 02:12:41
Modified:src/modules/perl modperl_module.c
Log:
handle correct perlmodules (directives) with vhosts:
- handle gracefully cases when things are undef/NULL
- handle the case when scfg==NULL, by stealing the base_servers's config
Revision ChangesPath
1.9 +47 -3 modperl-2.0/src/modules/perl/modperl_module.c
Index: modperl_module.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_module.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_module.c 17 Sep 2002 02:04:00 - 1.8
+++ modperl_module.c 12 Dec 2002 10:12:41 - 1.9
@@ -149,10 +149,18 @@
GV *gv;
modperl_mgv_t *method;
modperl_module_cfg_t *mrg = NULL,
+*tmp,
*base = (modperl_module_cfg_t *)basev,
-*add = (modperl_module_cfg_t *)addv,
-*tmp = base-server ? base : add;
-
+*add = (modperl_module_cfg_t *)addv;
+
+/* if the module is loaded in vhost, base==NULL */
+tmp = (base base-server) ? base : add;
+
+if (tmp !tmp-server) {
+/* no directives for this module were encountered so far */
+return basev;
+}
+
server_rec *s = tmp-server;
int is_startup = (p == s-process-pconf);
@@ -327,6 +335,42 @@
modperl_module_info_t *minfo = MP_MODULE_INFO(info-modp);
modperl_module_cfg_t *srv_cfg;
+ if (s-is_virtual) {
+MP_dSCFG(s);
+
+/* if the Perl module is loaded in the base server and a vhost
+ * has configuration directives from that module, but no
+ * mod_perl.c directives, scfg == NULL when
+ * modperl_module_cmd_take123 is run. If the directive
+ * callback wants to do something with the mod_perl config
+ * object, it'll segfault, since it doesn't exist yet, because
+ * this happens before server configs are merged. So we create
+ * a temp struct and fill it in with things that might be
+ * needed by the Perl callback.
+ */
+if (!scfg) {
+scfg = modperl_config_srv_new(p);
+modperl_set_module_config(s-module_config, scfg);
+scfg-server = s;
+}
+
+/* if PerlLoadModule Foo is called from the base server, but
+ * Foo's directives are used inside a vhost, we need to
+ * temporary link to the base server config's 'modules'
+ * member. e.g. so Apache::Module-get_config() can be called
+ * from a custom directive's callback, before the server/vhost
+ * config merge is performed */
+
+if (!scfg-modules) {
+modperl_config_srv_t *base_scfg =
+modperl_config_srv_get(modperl_global_get_server_rec());
+if (base_scfg-modules) {
+scfg-modules = base_scfg-modules;
+}
+}
+
+}
+
#ifdef USE_ITHREADS
modperl_interp_t *interp = modperl_interp_pool_select(p, s);
dTHXa(interp-perl);
cvs commit: modperl-2.0/src/modules/perl modperl_module.c
dougm 2002/09/05 11:05:52
Modified:src/modules/perl modperl_module.c
Log:
automate SvREFCNT-ing used with modperl_module_cmd_fetch a bit
Revision ChangesPath
1.7 +9 -7 modperl-2.0/src/modules/perl/modperl_module.c
Index: modperl_module.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_module.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_module.c 4 Sep 2002 17:11:22 - 1.6
+++ modperl_module.c 5 Sep 2002 18:05:52 - 1.7
-499,7 +499,10
{
const char *errmsg = NULL;
-*retval = Nullsv;
+if (*retval) {
+SvREFCNT_dec(*retval);
+*retval = Nullsv;
+}
if (sv_isobject(obj)) {
int count;
-572,7 +575,7
cmds = apr_array_make(p, fill+1, sizeof(command_rec));
for (i=0; i=fill; i++) {
-SV *val;
+SV *val = Nullsv;
STRLEN len;
SV *obj = AvARRAY(module_cmds)[i];
modperl_module_cmd_data_t *info = modperl_module_cmd_data_new(p);
-586,7 +589,6
}
cmd-name = apr_pstrdup(p, SvPV(val, len));
-SvREFCNT_dec(val);
if ((errmsg = modperl_module_cmd_fetch(aTHX_ obj, args_how, val))) {
/* XXX default based on $self-func prototype */
-600,7 +602,6
cmd-args_how =
modperl_constants_lookup_apache(SvPV(val, len));
}
-SvREFCNT_dec(val);
}
if (!modperl_module_cmd_lookup(cmd)) {
-614,7 +615,6
}
else {
info-func_name = apr_pstrdup(p, SvPV(val, len));
-SvREFCNT_dec(val);
}
if ((errmsg = modperl_module_cmd_fetch(aTHX_ obj, req_override, val))) {
-628,7 +628,6
cmd-req_override =
modperl_constants_lookup_apache(SvPV(val, len));
}
-SvREFCNT_dec(val);
}
if ((errmsg = modperl_module_cmd_fetch(aTHX_ obj, errmsg, val))) {
-638,7 +637,6
}
else {
cmd-errmsg = apr_pstrdup(p, SvPV(val, len));
-SvREFCNT_dec(val);
}
cmd-cmd_data = info;
-646,7 +644,11
/* no default if undefined */
if (!(errmsg = modperl_module_cmd_fetch(aTHX_ obj, data, val))) {
info-cmd_data = apr_pstrdup(p, SvPV(val, len));
+}
+
+if (val) {
SvREFCNT_dec(val);
+val = Nullsv;
}
}
cvs commit: modperl-2.0/src/modules/perl modperl_module.c modperl_module.h
dougm 2002/08/26 21:21:20
Added: src/modules/perl modperl_module.c modperl_module.h
Log:
module to create an apache module on the fly to support directive handlers
Revision ChangesPath
1.1 modperl-2.0/src/modules/perl/modperl_module.c
Index: modperl_module.c
===
#include mod_perl.h
typedef struct {
server_rec *server;
const char *name;
int namelen;
} modperl_module_cfg_t;
typedef struct {
module *modp;
const char *cmd_data;
const char *func_name;
} modperl_module_cmd_data_t;
static modperl_module_cfg_t *modperl_module_cfg_new(apr_pool_t *p)
{
modperl_module_cfg_t *cfg =
(modperl_module_cfg_t *)apr_pcalloc(p, sizeof(*cfg));
return cfg;
}
static modperl_module_cmd_data_t *modperl_module_cmd_data_new(apr_pool_t *p)
{
modperl_module_cmd_data_t *cmd_data =
(modperl_module_cmd_data_t *)apr_pcalloc(p, sizeof(*cmd_data));
return cmd_data;
}
static void *modperl_module_config_dir_create(apr_pool_t *p, char *dir)
{
return modperl_module_cfg_new(p);
}
static void *modperl_module_config_srv_create(apr_pool_t *p, server_rec *s)
{
return modperl_module_cfg_new(p);
}
static SV **modperl_module_config_hash_get(pTHX_ int create)
{
SV **svp;
/* XXX: could make this lookup faster */
svp = hv_fetch(PL_modglobal,
ModPerl::Module::ConfigTable,
MP_SSTRLEN(ModPerl::Module::ConfigTable),
create);
return svp;
}
void modperl_module_config_table_set(pTHX_ PTR_TBL_t *table)
{
SV **svp = modperl_module_config_hash_get(aTHX_ TRUE);
sv_setiv(*svp, (IV)table);
}
PTR_TBL_t *modperl_module_config_table_get(pTHX_ int create)
{
PTR_TBL_t *table = NULL;
SV *sv, **svp = modperl_module_config_hash_get(aTHX_ create);
if (!svp) {
return NULL;
}
sv = *svp;
if (!SvIOK(sv) create) {
table = ptr_table_new();
sv_setiv(sv, (IV)table);
}
else {
table = (PTR_TBL_t *)SvIV(sv);
}
return table;
}
typedef struct {
PerlInterpreter *perl;
PTR_TBL_t *table;
void *ptr;
} config_obj_cleanup_t;
/*
* any per-dir CREATE or MERGE that happens at request time
* needs to be removed from the pointer table.
*/
static apr_status_t modperl_module_config_obj_cleanup(void *data)
{
config_obj_cleanup_t *cleanup =
(config_obj_cleanup_t *)data;
dTHXa(cleanup-perl);
modperl_svptr_table_delete(aTHX_ cleanup-table, cleanup-ptr);
MP_TRACE_c(MP_FUNC, deleting ptr 0x%lx from table 0x%lx\n,
(unsigned long)cleanup-ptr,
(unsigned long)cleanup-table);
return APR_SUCCESS;
}
static void modperl_module_config_obj_cleanup_register(pTHX_
apr_pool_t *p,
PTR_TBL_t *table,
void *ptr)
{
config_obj_cleanup_t *cleanup =
(config_obj_cleanup_t *)apr_palloc(p, sizeof(*cleanup));
cleanup-table = table;
cleanup-ptr = ptr;
#ifdef USE_ITHREADS
cleanup-perl = aTHX;
#endif
apr_pool_cleanup_register(p, cleanup,
modperl_module_config_obj_cleanup,
apr_pool_cleanup_null);
}
static void *modperl_module_config_merge(apr_pool_t *p,
void *basev, void *addv,
const char *method)
{
GV *gv;
modperl_module_cfg_t *mrg = NULL,
*base = (modperl_module_cfg_t *)basev,
*add = (modperl_module_cfg_t *)addv,
*tmp = base-server ? base : add;
server_rec *s = tmp-server;
int is_startup = (p == s-process-pconf);
#ifdef USE_ITHREADS
modperl_interp_t *interp = modperl_interp_pool_select(p, s);
dTHXa(interp-perl);
#endif
PTR_TBL_t *table = modperl_module_config_table_get(aTHX_ TRUE);
SV *mrg_obj = Nullsv,
*base_obj = ptr_table_fetch(table, base),
*add_obj = ptr_table_fetch(table, add);
HV *stash;
if (!base_obj || (base_obj == add_obj)) {
return add_obj;
}
stash = SvSTASH(SvRV(base_obj));
MP_TRACE_c(MP_FUNC, looking for method %s in package `%s'\n,
method, SvCLASS(base_obj));
/* XXX: should do this lookup at startup time */
if ((gv = gv_fetchmethod_autoload(stash, method, FALSE)) isGV(gv)) {
int count;
dSP;
mrg = modperl_module_cfg_new(p);
memcpy(mrg, tmp, sizeof(*mrg));
