unload extension shared objects when exiting, implemented

only for dl_dlopen.xs (from Alan Burlison)

p4raw-id: //depot/perl@5381

4 files changed, 102 insertions, 8 deletions

diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL
index 8341b36130..6a3d4a3391 100644
--- a/ext/DynaLoader/DynaLoader_pm.PL
+++ b/ext/DynaLoader/DynaLoader_pm.PL
@@ -28,7 +28,7 @@ package DynaLoader;
 #
 # Tim.Bunce@ig.co.uk, August 1994
 
-$VERSION = "1.03";	# avoid typo warning
+$VERSION = "1.04";	# avoid typo warning
 
 require AutoLoader;
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;
@@ -411,7 +411,7 @@ sub dl_find_symbol_anywhere
 
 DynaLoader - Dynamically load C libraries into Perl code
 
-dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules
+dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_unload_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules
 
 =head1 SYNOPSIS
 
@@ -463,6 +463,7 @@ DynaLoader Interface Summary
   $symref  = dl_find_symbol_anywhere($symbol)          Perl
 
   $libref  = dl_load_file($filename, $flags)           C
+  $status  = dl_unload_file($libref)                   C
   $symref  = dl_find_symbol($libref, $symbol)          C
   @symbols = dl_undef_symbols()                        C
   dl_install_xsub($name, $symref [, $filename])        C
@@ -640,6 +641,43 @@ current values of @dl_require_symbols and @dl_resolve_using if required.
 Linux, and is a common choice when providing a "wrapper" on other
 mechanisms as is done in the OS/2 port.)
 
+=item dl_unload_file()
+
+Syntax:
+
+    $status = dl_unload_file($libref)
+
+Dynamically unload $libref, which must be an opaque 'library reference' as
+returned from dl_load_file.  Returns one on success and zero on failure.
+
+This function is optional and may not necessarily be provided on all platforms.
+If it is defined, it is called automatically when the interpreter exits for
+every shared object or library loaded by DynaLoader::bootstrap.  All such
+library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
+loads the libraries.  The files are unloaded in the reverse order in to they
+were initially loaded.
+
+This unloading is usually necessary when embedding a shared-object perl (e.g.
+one configured with -Duseshrplib) within a larger application, and the perl
+interpreter is created and destroyed several times within the lifetime of the
+application.  In this case it is possible that the system dynamic linker will
+unload and then subsequently reload the shared libperl without relocating any
+references to it from any files DynaLoaded by the previous incarnation of the
+interpreter.  As a result, any shared objects opened by DynaLoader may point to
+a now invalid 'ghost' of the libperl shared object, causing apparently random
+memory corruption and crashes.  This behaviour is most commonly seen when using
+Apache and mod_perl built with the APXS mechanism.
+
+    SunOS: dlclose($libref)
+    HP-UX: ???
+    Linux: ???
+    NeXT:  ???
+    VMS:   ???
+
+(The dlclose() function is also used by Solaris and some versions of
+Linux, and is a common choice when providing a "wrapper" on other
+mechanisms as is done in the OS/2 port.)
+
 =item dl_loadflags()
 
 Syntax:
diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL
index bcd45ae757..83cbd770b0 100644
--- a/ext/DynaLoader/Makefile.PL
+++ b/ext/DynaLoader/Makefile.PL
@@ -12,6 +12,7 @@ WriteMakefile(
 		    'XSLoader_pm.PL'=>'XSLoader.pm'},
     PM		=> {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm',
 		    'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'},
+    depend      => {'DynaLoader.o' => 'dlutils.c'},
     clean	=> {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' .
 			     'XSLoader.pm'},
 );
diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index 135f5112f2..8020e23d97 100644
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -5,11 +5,13 @@
  * Created:	10th July 1994
  *
  * Modified:
- * 15th July 1994   - Added code to explicitly save any error messages.
- * 3rd August 1994  - Upgraded to v3 spec.
- * 9th August 1994  - Changed to use IV
- * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
- *                    basic FreeBSD support, removed ClearError
+ * 15th July 1994     - Added code to explicitly save any error messages.
+ * 3rd August 1994    - Upgraded to v3 spec.
+ * 9th August 1994    - Changed to use IV
+ * 10th August 1994   - Tim Bunce: Added RTLD_LAZY, switchable debugging,
+ *                      basic FreeBSD support, removed ClearError
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ *                      files when the interpreter exits
  *
  */
 
@@ -37,6 +39,17 @@
      RTLD_LAZY (==2) on Solaris 2.
 
 
+   dlclose
+   -------
+     int
+     dlclose(handle)
+     void * handle;
+
+     This function takes the handle returned by a previous invocation of
+     dlopen and closes the associated dynamic object file.  It returns zero
+     on success, and non-zero on failure.
+
+
    dlsym
    ------
      void *
@@ -57,7 +70,7 @@
      Returns a null-terminated string which describes the last error
      that occurred with either dlopen or dlsym. After each call to
      dlerror the error message will be reset to a null pointer. The
-     SaveError function is used to save the error as soo as it happens.
+     SaveError function is used to save the error as soon as it happens.
 
 
    Return Types
@@ -180,6 +193,19 @@ dl_load_file(filename, flags=0)
 	sv_setiv( ST(0), PTR2IV(RETVAL));
 }
 
+
+int
+dl_unload_file(libref)
+    void *	libref
+  CODE:
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
+    if ((RETVAL = dlclose(libref) == 0 ? 1 : 0) == 0);
+        SaveError("%s", dlerror()) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+  OUTPUT:
+    RETVAL
+
+
 void *
 dl_find_symbol(libhandle, symbolname)
     void *	libhandle
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 664e331e7b..fc4cd75e4e 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -3,6 +3,9 @@
  * Currently this file is simply #included into dl_*.xs/.c files.
  * It should really be split into a dlutils.h and dlutils.c
  *
+ * Modified:
+ * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
+ *                      files when the interpreter exits
  */
 
 
@@ -25,6 +28,31 @@ static int dl_debug = 0;	/* value copied from $DynaLoader::dl_error */
 #endif
 
 
+/* Close all dlopen'd files */
+static void
+dl_unload_all_files(pTHXo_ void *unused)
+{
+    CV *sub;
+    AV *dl_librefs;
+    SV *dl_libref;
+
+    if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
+        dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
+        while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
+           dSP;
+           ENTER;
+           SAVETMPS;
+           PUSHMARK(SP);
+           XPUSHs(sv_2mortal(dl_libref));
+           PUTBACK;
+           call_sv(sub, G_DISCARD);
+           FREETMPS;
+           LEAVE;
+        }
+    }
+}
+
+
 static void
 dl_generic_private_init(pTHXo)	/* called by dl_*.xs dl_private_init() */
 {
@@ -41,6 +69,7 @@ dl_generic_private_init(pTHXo)	/* called by dl_*.xs dl_private_init() */
     if (!dl_loaded_files)
 	dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
 #endif
+    call_atexit(&dl_unload_all_files, (void*)0);
 }