dougm 01/04/09 16:57:23
Modified: src/modules/perl mod_perl.c modperl_interp.c
modperl_interp.h modperl_types.h modperl_util.c
modperl_util.h
Log:
implement "the dso fix" 2.0 style
Revision Changes Path
1.43 +15 -2 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- mod_perl.c 2001/04/06 02:18:15 1.42
+++ mod_perl.c 2001/04/09 23:57:22 1.43
@@ -3,12 +3,21 @@
#ifndef USE_ITHREADS
static apr_status_t modperl_shutdown(void *data)
{
- PerlInterpreter *perl = (PerlInterpreter *)data;
+ modperl_cleanup_data_t *cdata = (modperl_cleanup_data_t *)data;
+ PerlInterpreter *perl = (PerlInterpreter *)cdata->data;
+ apr_array_header_t *handles;
+
PL_perl_destruct_level = 2;
MP_TRACE_i(MP_FUNC, "destroying interpreter=0x%lx\n",
(unsigned long)perl);
+
perl_destruct(perl);
perl_free(perl);
+
+ if ((handles = modperl_xs_dl_handles_get(cdata->pool)) {
+ modperl_xs_dl_handles_close(handles);
+ }
+
return APR_SUCCESS;
}
#endif
@@ -20,6 +29,9 @@
int status;
char **argv;
int argc;
+#ifndef USE_ITHREADS
+ modperl_cleanup_data_t *cdata;
+#endif
#ifdef MP_USE_GTOP
MP_TRACE_m_do(
@@ -61,7 +73,8 @@
#endif
#ifndef USE_ITHREADS
- apr_pool_cleanup_register(p, (void*)perl,
+ cdata = modperl_cleanup_data_new(p, (void*)perl);
+ apr_pool_cleanup_register(p, cdata,
modperl_shutdown, apr_pool_cleanup_null);
#endif
1.31 +37 -8 modperl-2.0/src/modules/perl/modperl_interp.c
Index: modperl_interp.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- modperl_interp.c 2001/04/06 02:18:15 1.30
+++ modperl_interp.c 2001/04/09 23:57:22 1.31
@@ -16,6 +16,25 @@
return MP_interp_scope_desc[scope];
}
+void modperl_interp_clone_init(modperl_interp_t *interp)
+{
+ dTHXa(interp->perl);
+
+ MpInterpCLONED_On(interp);
+
+ PERL_SET_CONTEXT(aTHX);
+
+ /* XXX: hack for bug fixed in 5.6.1 */
+ if (PL_scopestack_ix == 0) {
+ ENTER;
+ }
+
+ /* clear @DynaLoader::dl_librefs so we only dlclose() those
+ * which are opened by the clone
+ */
+ modperl_xs_dl_handles_clear(aTHX);
+}
+
modperl_interp_t *modperl_interp_new(apr_pool_t *p,
modperl_interp_pool_t *mip,
PerlInterpreter *perl)
@@ -35,15 +54,8 @@
interp->perl = perl_clone(perl, FALSE);
- {
- /* XXX: hack for bug fixed in 5.6.1 */
- dTHXa(interp->perl);
- if (PL_scopestack_ix == 0) {
- ENTER;
- }
- }
+ modperl_interp_clone_init(interp);
- MpInterpCLONED_On(interp);
PERL_SET_CONTEXT(mip->parent->perl);
#ifdef MP_USE_GTOP
@@ -60,6 +72,8 @@
void modperl_interp_destroy(modperl_interp_t *interp)
{
+ apr_pool_t *p = NULL;
+ apr_array_header_t *handles;
dTHXa(interp->perl);
MP_TRACE_i(MP_FUNC, "interp == 0x%lx\n",
@@ -71,8 +85,23 @@
PERL_SET_CONTEXT(interp->perl);
PL_perl_destruct_level = 2;
+
+ /* we cant use interp->mip->ap_pool without locking
+ * apr_pool_create() will mutex lock for us
+ * XXX: could roll something without using apr_pool_t
+ * to avoid locking
+ */
+ (void)apr_pool_create(&p, NULL);
+ handles = modperl_xs_dl_handles_get(aTHX_ p);
+
perl_destruct(interp->perl);
perl_free(interp->perl);
+
+ if (handles) {
+ modperl_xs_dl_handles_close(handles);
+ }
+
+ apr_pool_destroy(p);
}
apr_status_t modperl_interp_cleanup(void *data)
1.11 +2 -0 modperl-2.0/src/modules/perl/modperl_interp.h
Index: modperl_interp.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- modperl_interp.h 2001/04/06 02:18:15 1.10
+++ modperl_interp.h 2001/04/09 23:57:22 1.11
@@ -9,6 +9,8 @@
#ifdef USE_ITHREADS
const char *modperl_interp_scope_desc(modperl_interp_scope_e scope);
+void modperl_interp_clone_init(modperl_interp_t *interp);
+
modperl_interp_t *modperl_interp_new(apr_pool_t *p,
modperl_interp_pool_t *mip,
PerlInterpreter *perl);
1.34 +5 -0 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- modperl_types.h 2001/04/06 02:18:15 1.33
+++ modperl_types.h 2001/04/09 23:57:22 1.34
@@ -205,4 +205,9 @@
MpAV *handlers_connection[MP_HANDLER_NUM_CONNECTION];
} modperl_config_con_t;
+typedef struct {
+ apr_pool_t *pool;
+ void *data;
+} modperl_cleanup_data_t;
+
#endif /* MODPERL_TYPES_H */
1.6 +78 -0 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_util.c 2001/03/14 04:22:51 1.5
+++ modperl_util.c 2001/04/09 23:57:22 1.6
@@ -86,3 +86,81 @@
{
return apr_psprintf(p, "%s:%u", s->server_hostname, s->port);
}
+
+#define dl_librefs "DynaLoader::dl_librefs"
+#define dl_modules "DynaLoader::dl_modules"
+
+void modperl_xs_dl_handles_clear(pTHXo)
+{
+ AV *librefs = get_av(dl_librefs, FALSE);
+ if (librefs) {
+ av_clear(librefs);
+ }
+}
+
+apr_array_header_t *modperl_xs_dl_handles_get(pTHX_ apr_pool_t *p)
+{
+ I32 i;
+ AV *librefs = get_av(dl_librefs, FALSE);
+ AV *modules = get_av(dl_modules, FALSE);
+ apr_array_header_t *handles;
+
+ if (!librefs) {
+ MP_TRACE_g(MP_FUNC,
+ "Could not get @%s for unloading.\n",
+ dl_librefs);
+ return NULL;
+ }
+
+ handles = apr_array_make(p, AvFILL(librefs)-1, sizeof(void *));
+
+ for (i=0; i<=AvFILL(librefs); i++) {
+ void *handle;
+ SV *handle_sv = *av_fetch(librefs, i, FALSE);
+ SV *module_sv = *av_fetch(modules, i, FALSE);
+
+ if(!handle_sv) {
+ MP_TRACE_g(MP_FUNC,
+ "Could not fetch $%s[%d]!\n",
+ dl_librefs, (int)i);
+ continue;
+ }
+ handle = (void *)SvIV(handle_sv);
+
+ MP_TRACE_g(MP_FUNC, "%s dl handle == 0x%lx\n",
+ SvPVX(module_sv), (unsigned long)handle);
+ if (handle) {
+ *(void **)apr_array_push(handles) = handle;
+ }
+ }
+
+ av_clear(modules);
+ av_clear(librefs);
+
+ return handles;
+}
+
+void modperl_xs_dl_handles_close(apr_array_header_t *handles)
+{
+ int i;
+
+ if (!handles) {
+ return;
+ }
+
+ for (i=0; i < handles->nelts; i++) {
+ void *handle = ((void **)handles->elts)[i];
+ MP_TRACE_g(MP_FUNC, "close 0x%lx\n",
+ (unsigned long)handle);
+ dlclose(handle); /*XXX*/
+ }
+}
+
+modperl_cleanup_data_t *modperl_cleanup_data_new(apr_pool_t *p, void *data)
+{
+ modperl_cleanup_data_t *cdata =
+ (modperl_cleanup_data_t *)apr_pcalloc(p, sizeof(*cdata));
+ cdata->pool = p;
+ cdata->data = data;
+ return cdata;
+}
1.7 +8 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_util.h 2001/03/14 05:22:50 1.6
+++ modperl_util.h 2001/04/09 23:57:22 1.7
@@ -29,4 +29,12 @@
char *modperl_server_desc(server_rec *s, apr_pool_t *p);
+void modperl_xs_dl_handles_clear(pTHXo);
+
+apr_array_header_t *modperl_xs_dl_handles_get(pTHX_ apr_pool_t *p);
+
+void modperl_xs_dl_handles_close(apr_array_header_t *handles);
+
+modperl_cleanup_data_t *modperl_cleanup_data_new(apr_pool_t *p, void *data);
+
#endif /* MODPERL_UTIL_H */
