change#3569 deleted some essential code, revert; avoid use of

atexit() to make DynaLoader work properly on AIX under mod_perl
(from Jens-Uwe Mager <jum@helios.de>)

p4raw-link: @3569 on //depot/perl: 054b02d6604bb3beeebed2d8a040d025b131c9a6

p4raw-id: //depot/perl@5958

1 files changed, 74 insertions, 15 deletions

diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs
index 35242ed652..d6acc689af 100644
--- a/ext/DynaLoader/dl_aix.xs
+++ b/ext/DynaLoader/dl_aix.xs
@@ -36,6 +36,8 @@
 #include <sys/types.h>
 #include <sys/ldr.h>
 #include <a.out.h>
+#undef FREAD
+#undef FWRITE
 #include <ldfcn.h>
 
 #ifdef USE_64_BIT_ALL
@@ -87,6 +89,8 @@
 
 /* If using PerlIO, redefine these macros from <ldfcn.h> */
 #ifdef USE_PERLIO
+#undef FSEEK
+#undef FREAD
 #define FSEEK(ldptr,o,p)        PerlIO_seek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr)+o):o,p)
 #define FREAD(p,s,n,ldptr)      PerlIO_read(IOPTR(ldptr),p,s*n)
 #endif
@@ -116,8 +120,8 @@ typedef struct Module {
 } Module, *ModulePtr;
 
 /*
- * We keep a list of all loaded modules to be able to call the fini
- * handlers at atexit() time.
+ * We keep a list of all loaded modules to be able to reference count
+ * duplicate dlopen's.
  */
 static ModulePtr modList;		/* XXX threaded */
 
@@ -130,7 +134,7 @@ static int errvalid;			/* XXX threaded */
 
 static void caterr(char *);
 static int readExports(ModulePtr);
-static void terminate(void);
+static void *findMain(void);
 
 static char *strerror_failed   = "(strerror failed)";
 static char *strerror_r_failed = "(strerror_r failed)";
@@ -197,15 +201,15 @@ void *dlopen(char *path, int mode)
 {
 	dTHX;
 	register ModulePtr mp;
-	static int inited;			/* XXX threaded */
+	static void *mainModule;		/* XXX threaded */
 
 	/*
 	 * Upon the first call register a terminate handler that will
 	 * close all libraries.
 	 */
-	if (!inited) {
-		inited++;
-		atexit(terminate);
+	if (mainModule == NULL) {
+		if ((mainModule = findMain()) == NULL)
+			return NULL;
 	}
 	/*
 	 * Scan the list of modules if have the module already loaded.
@@ -273,9 +277,13 @@ void *dlopen(char *path, int mode)
 	/*
 	 * Assume anonymous exports come from the module this dlopen
 	 * is linked into, that holds true as long as dlopen and all
-	 * of the perl core are in the same shared object.
+	 * of the perl core are in the same shared object. Also bind
+	 * against the main part, in the case a perl is not the main
+	 * part, e.g mod_perl as DSO in Apache so perl modules can
+	 * also reference Apache symbols.
 	 */
-	if (loadbind(0, (void *)dlopen, mp->entry) == -1) {
+	if (loadbind(0, (void *)dlopen, mp->entry) == -1 ||
+	    loadbind(0, mainModule, mp->entry)) {
 	        int saverrno = errno;
 
 		dlclose(mp);
@@ -393,12 +401,6 @@ int dlclose(void *handle)
 	return result;
 }
 
-static void terminate(void)
-{
-	while (modList)
-		dlclose(modList);
-}
-
 /* Added by Wayne Scott 
  * This is needed because the ldopen system call calls
  * calloc to allocated a block of date.  The ldclose call calls free.
@@ -590,6 +592,52 @@ static int readExports(ModulePtr mp)
 	return 0;
 }
 
+/*
+ * Find the main modules entry point. This is used as export pointer
+ * for loadbind() to be able to resolve references to the main part.
+ */
+static void * findMain(void)
+{
+	struct ld_info *lp;
+	char *buf;
+	int size = 4*1024;
+	int i;
+	void *ret;
+
+	if ((buf = safemalloc(size)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strerrorcat(errbuf, errno);
+		return NULL;
+	}
+	while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
+		safefree(buf);
+		size += 4*1024;
+		if ((buf = safemalloc(size)) == NULL) {
+			errvalid++;
+			strcpy(errbuf, "findMain: ");
+			strerrorcat(errbuf, errno);
+			return NULL;
+		}
+	}
+	if (i == -1) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strerrorcat(errbuf, errno);
+		safefree(buf);
+		return NULL;
+	}
+	/*
+	 * The first entry is the main module. The entry point
+	 * returned by load() does actually point to the data
+	 * segment origin.
+	 */
+	lp = (struct ld_info *)buf;
+	ret = lp->ldinfo_dataorg;
+	safefree(buf);
+	return ret;
+}
+
 /* dl_dlopen.xs
  * 
  * Platform:	SunOS/Solaris, possibly others which use dlopen.
@@ -642,6 +690,17 @@ dl_load_file(filename, flags=0)
 	else
 	    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));
+    RETVAL = (dlclose(libref) == 0 ? 1 : 0);
+    if (!RETVAL)
+        SaveError(aTHX_ "%s", dlerror()) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+  OUTPUT:
+    RETVAL
 
 void *
 dl_find_symbol(libhandle, symbolname)