Mount zipfs early - see [87b69745be]

6 files changed, 178 insertions, 150 deletions

diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2499501..4a72808 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3743,7 +3743,8 @@ MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
 MODULE_SCOPE int	TclZipfs_Init(Tcl_Interp *interp);
 MODULE_SCOPE int	TclIsZipfsPath(const char *path);
 MODULE_SCOPE void	TclZipfsFinalize(void);
-MODULE_SCOPE int 	TclZipfsLocateTclLibrary(void);
+MODULE_SCOPE Tcl_Obj *	TclGetObjNameOfShlib(void);
+MODULE_SCOPE void	TclSetObjNameOfShlib(Tcl_Obj *namePtr, Tcl_Encoding);
 
 /*
  * Many parsing tasks need a common definition of whitespace.
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 950cae6..7e321f6 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -32,6 +32,11 @@
 static ProcessGlobalValue executableName = {
     0, 0, NULL, NULL, NULL, NULL, NULL
 };
+#if !defined(STATIC_BUILD)
+static ProcessGlobalValue shlibName = {
+    0, 0, NULL, NULL, NULL, NULL, NULL
+};
+#endif
 
 /*
  * The following values are used in the flags arguments of Tcl*Scan*Element
@@ -4379,6 +4384,52 @@ Tcl_GetNameOfExecutable(void)
     return bytes;
 }
 
+#if !defined(STATIC_BUILD)
+/*
+ * TclSetObjNameOfShlib --
+ *
+ *	This function stores the absolute pathname of the Tcl shared library.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Stores the shared library name in the process global database.
+ */
+
+void
+TclSetObjNameOfShlib(
+    Tcl_Obj *name,
+    TCL_UNUSED(Tcl_Encoding))
+{
+    TclSetProcessGlobalValue(&shlibName, name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetObjNameOfShlib --
+ *
+ *	This function retrieves the absolute pathname of the Tcl shared
+ *	library.
+ *
+ * Results:
+ *	A pointer to an "fsPath" Tcl_Obj, or to an empty Tcl_Obj if the
+ *	pathname of the application is unknown.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetObjNameOfShlib(void)
+{
+    return TclGetProcessGlobalValue(&shlibName);
+}
+
+#endif /* !STATIC_BUILD - Tcl{Get,Set}NameOfShlib */
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index bb27ae9..0e51d26 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -434,9 +434,6 @@ static int		IsCryptHeaderValid(ZipEntry *z,
 static int		DecodeCryptHeader(Tcl_Interp *interp, ZipEntry *z,
 			    unsigned long keys[3],
 			    unsigned char cryptHdr[ZIP_CRYPT_HDR_LEN]);
-#if !defined(STATIC_BUILD)
-static int		ZipfsAppHookFindTclInit(const char *archive);
-#endif
 static int		ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr,
 			    void **clientDataPtr);
 static Tcl_Obj *	ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
@@ -475,6 +472,7 @@ static void		ZipChannelWatchChannel(void *instanceData,
 			    int mask);
 static int		ZipChannelWrite(void *instanceData,
 			    const char *buf, int toWrite, int *errloc);
+static int		TclZipfsInitEncodingDirs(void);
 
 /*
  * Define the ZIP filesystem dispatch table.
@@ -4313,87 +4311,75 @@ ZipFSListObjCmd(
  * TclZipfsLocateTclLibrary --
  *
  *	This procedure locates the root that Tcl's library files are mounted
- *	under if they are under a zipfs file system.
+ *	under if they are under a zipfs file system archive attached to the
+ *	executable or the shared library/DLL. The archives should have been
+ *	mounted (if present) before this function is called.
+ *
+ *	If the libraries are found, the encoding directory paths are set up.
  *
  * Results:
- *	TCL_OK if the library was found, TCL_ERROR otherwise.
+ *	None.
  *
  * Side effects:
- *	Initializes the global variable zipfs_literal_tcl_library. Will
- *	never be cleared.
+ *	May initializes the global variable zipfs_literal_tcl_library. Will
+ *	never be cleared. The encoding directory paths are initialized.
  *
  *-------------------------------------------------------------------------
  */
 
-int
-TclZipfsLocateTclLibrary(void)
+static void
+TclZipfsLocateTclLibrary(
+	int appZipfsPresent,	/* non-0 if app zipfs is to be checked */
+	int shlibZipfsPresent)  /* non-0 if shared lib is to be checked */
 {
     Tcl_Obj *vfsInitScript;
     int found;
-#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(STATIC_BUILD)
-#   define LIBRARY_SIZE	    64
-    HMODULE hModule;
-    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
-    char dllName[(MAX_PATH + LIBRARY_SIZE) * 3];
-#endif /* _WIN32 */
 
     if (zipfs_tcl_library_init) {
-	return zipfs_literal_tcl_library ? TCL_OK : TCL_ERROR;
+	return;
     }
 
     Tcl_MutexLock(&ZipFSLocateLibMutex);
     if (zipfs_tcl_library_init) {
-	/* Some other thread won the race */
+	/*
+	 * Some other thread won the race. Should only have one app thread
+	 * doing this, but be safe.
+	 */
 	Tcl_MutexUnlock(&ZipFSLocateLibMutex);
-	return zipfs_literal_tcl_library ? TCL_OK : TCL_ERROR;
-    }
-
-    /* Look for the library file system within the executable. */
-    vfsInitScript =
-	Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl", -1);
-    Tcl_IncrRefCount(vfsInitScript);
-    found = Tcl_FSAccess(vfsInitScript, F_OK);
-    Tcl_DecrRefCount(vfsInitScript);
-    if (found == TCL_OK) {
-	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
-	goto unlock_and_return;
+	return;
     }
 
-    /*
-     * Look for the library file system within the DLL/shared
-     * library.  Note that we must mount the zip file and dll before
-     * releasing to search.
-     */
-#if !defined(STATIC_BUILD)
-#if defined(_WIN32) || defined(__CYGWIN__)
-    hModule = (HMODULE)TclWinGetTclInstance();
-    GetModuleFileNameW(hModule, wName, MAX_PATH);
-#ifdef __CYGWIN__
-    cygwin_conv_path(3, wName, dllName, sizeof(dllName));
-#else
-    WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL);
-#endif
-
-    if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
-	goto unlock_and_return;
-    }
-#elif !defined(NO_DLFCN_H)
-    Dl_info dlinfo;
-    if (dladdr((const void *)TclZipfs_TclLibrary, &dlinfo) && (dlinfo.dli_fname != NULL)
-	    && (ZipfsAppHookFindTclInit(dlinfo.dli_fname) == TCL_OK)) {
-	goto unlock_and_return;
+    if (appZipfsPresent) {
+	vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl", -1);
+	Tcl_IncrRefCount(vfsInitScript);
+	found = Tcl_FSAccess(vfsInitScript, F_OK);
+	Tcl_DecrRefCount(vfsInitScript);
+	if (found == TCL_OK) {
+	    /* Note this MUST be constant string as never deallocted */
+	    zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+	    goto unlock_and_return;
+	}
     }
-#else
-    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
-	goto unlock_and_return;
+    if (shlibZipfsPresent) {
+	vfsInitScript = Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl", -1);
+	Tcl_IncrRefCount(vfsInitScript);
+	found = Tcl_FSAccess(vfsInitScript, F_OK);
+	Tcl_DecrRefCount(vfsInitScript);
+	if (found == TCL_OK) {
+	    /* Note this MUST be constant string as never deallocted */
+	    zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
+	    goto unlock_and_return;
+	}
     }
-#endif /* _WIN32 */
-#endif /* !defined(STATIC_BUILD) */
 
 unlock_and_return:
     zipfs_tcl_library_init = 1;
     Tcl_MutexUnlock(&ZipFSLocateLibMutex);
-    return zipfs_literal_tcl_library ? TCL_OK : TCL_ERROR;
+    if (zipfs_literal_tcl_library) {
+	/* Found it, set up encoding dirs */
+	(void)TclZipfsInitEncodingDirs();
+    }
+    return;
 }
 
 /*
@@ -4439,8 +4425,6 @@ TclZipfs_TclLibrary(void)
  *	A standard Tcl result.
  *
  * Side effects:
- *	May initialise the cache of where such library files are to be found.
- *	This cache is never cleared.
  *
  *-------------------------------------------------------------------------
  */
@@ -6400,45 +6384,6 @@ TclZipfs_Init(
     return TCL_OK;
 }
 
-#if !defined(STATIC_BUILD)
-static int
-ZipfsAppHookFindTclInit(
-    const char *archive)
-{
-    Tcl_Obj *vfsInitScript;
-    int found;
-
-    if (zipfs_literal_tcl_library) {
-	return TCL_ERROR;
-    }
-    if (TclZipfs_Mount(NULL, archive, ZIPFS_ZIP_MOUNT, NULL)) {
-	/* Either the file doesn't exist or it is not a zip archive */
-	return TCL_ERROR;
-    }
-
-    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
-    Tcl_IncrRefCount(vfsInitScript);
-    found = Tcl_FSAccess(vfsInitScript, F_OK);
-    Tcl_DecrRefCount(vfsInitScript);
-    if (found == 0) {
-	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
-	return TCL_OK;
-    }
-
-    TclNewLiteralStringObj(vfsInitScript,
-	    ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
-    Tcl_IncrRefCount(vfsInitScript);
-    found = Tcl_FSAccess(vfsInitScript, F_OK);
-    Tcl_DecrRefCount(vfsInitScript);
-    if (found == 0) {
-	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
-	return TCL_OK;
-    }
-
-    return TCL_ERROR;
-}
-#endif
-
 /*
  *------------------------------------------------------------------------
  *
@@ -6552,46 +6497,45 @@ TclZipfs_AppHook(
 #endif
     archive = Tcl_GetNameOfExecutable();
     TclZipfs_Init(NULL);
+
+    /* Always mount archives attached to the application and shared library */
+    int appZipfsPresent =
+	(TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL) == TCL_OK);
+    int shlibZipfsPresent = 0;
+#if !defined(STATIC_BUILD)
+    Tcl_Obj *shlibPathObj = TclGetObjNameOfShlib();
+    if (shlibPathObj &&
+	TclZipfs_Mount(NULL, Tcl_GetString(shlibPathObj), ZIPFS_ZIP_MOUNT, NULL) == TCL_OK) {
+	shlibZipfsPresent = 1;
+    }
+#endif
+
     /*
-     * Look for init.tcl in one of the locations mounted later in this
-     * function. Errors ignored as other locations may be available.
+     * NOTE archive and shlibjPathObj both come from thread cache of process
+     * globals and liable to be changed by other initialization code. Do not
+     * hold on to them.
      */
-    if (TclZipfsLocateTclLibrary() == TCL_OK) {
-	(void) TclZipfsInitEncodingDirs();
-    }
 
-    if (!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) {
-	int found;
+    /*
+     * After BOTH are mounted, look for init.tcl in one of the mounts.
+     * Errors ignored as other locations may be available.
+     */
+    TclZipfsLocateTclLibrary(appZipfsPresent, shlibZipfsPresent);
+
+    if (appZipfsPresent) {
 	Tcl_Obj *vfsInitScript;
 
 	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	Tcl_IncrRefCount(vfsInitScript);
 	if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
-	    /*
-	     * Startup script should be set before calling Tcl_AppInit
-	     */
-
+	    /* Startup script should be set before calling Tcl_AppInit */
 	    Tcl_SetStartupScript(vfsInitScript, NULL);
 	} else {
 	    Tcl_DecrRefCount(vfsInitScript);
 	}
 
-	/*
-	 * Set Tcl Encodings
-	 */
-
-	if (!zipfs_literal_tcl_library) {
-	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
-	    Tcl_IncrRefCount(vfsInitScript);
-	    found = Tcl_FSAccess(vfsInitScript, F_OK);
-	    Tcl_DecrRefCount(vfsInitScript);
-	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
-		return result;
-	    }
-	}
 #ifdef SUPPORT_BUILTIN_ZIP_INSTALL
+#error "SUPPORT_BUILTIN_ZIP_INSTALL not implemented - TODO"
     } else if (*argcPtr > 1) {
 	/*
 	 * If the first argument is "install", run the supplied installer
@@ -6622,10 +6566,15 @@ TclZipfs_AppHook(
 		Tcl_SetStartupScript(vfsInitScript, NULL);
 	    }
 	    return result;
-	} else if (!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) {
-	    int found;
+	} else if (TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL) == TCL_OK) {
 	    Tcl_Obj *vfsInitScript;
 
+	    if (!zipfs_literal_tcl_library) {
+		if (TclZipfsLocateTclLibrary() == TCL_OK) {
+		    (void) TclZipfsInitEncodingDirs();
+		}
+	    }
+
 	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
 	    Tcl_IncrRefCount(vfsInitScript);
 	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
@@ -6637,16 +6586,6 @@ TclZipfs_AppHook(
 	    } else {
 		Tcl_DecrRefCount(vfsInitScript);
 	    }
-	    /* Set Tcl Encodings */
-	    TclNewLiteralStringObj(vfsInitScript,
-		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
-	    Tcl_IncrRefCount(vfsInitScript);
-	    found = Tcl_FSAccess(vfsInitScript, F_OK);
-	    Tcl_DecrRefCount(vfsInitScript);
-	    if (found == TCL_OK) {
-		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
-		return result;
-	    }
 	}
 #ifdef _WIN32
 	Tcl_DStringFree(&ds);
diff --git a/unix/Makefile.in b/unix/Makefile.in
index e6b9b9d..ea246e3 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1834,7 +1834,11 @@ tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c
 
 tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR)
-	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c
+	$(CC) -c $(CC_SWITCHES) \
+		-D_GNU_SOURCE \
+		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
+		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
+		$(UNIX_DIR)/tclUnixFile.c
 
 tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c $(UNIX_DIR)/tclUnixNotfy.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 91e9ffb..65fde80 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -12,6 +12,9 @@
 
 #include "tclInt.h"
 #include "tclFileSystem.h"
+#if !defined(NO_DLFCN_H)
+#include <dlfcn.h>
+#endif
 
 static int		NativeMatchType(Tcl_Interp *interp,
 			    const char* nativeEntry, const char* nativeName,
@@ -26,15 +29,17 @@ static int		NativeMatchType(Tcl_Interp *interp,
  *	application, given its argv[0] value. For Cygwin, argv[0] is
  *	ignored and the path is determined the same as under win32.
  *
+ *	In the case of shared Tcl library, the absolute path name of the
+ *	Tcl library is also determined.
+ *
  * Results:
  *	None.
  *
  * Side effects:
- *	The computed path name is stored as a ProcessGlobalValue.
+ *	The computed path name(s) are stored as ProcessGlobalValue entries.
  *
  *---------------------------------------------------------------------------
  */
-
 #ifdef __CYGWIN__
 void
 TclpFindExecutable(
@@ -42,7 +47,7 @@ TclpFindExecutable(
 {
     size_t length;
     wchar_t buf[PATH_MAX] = L"";
-    char name[PATH_MAX * 3 + 1];
+    char name[PATH_MAX * TCL_UTF_MAX + 1];
 
     GetModuleFileNameW(NULL, buf, PATH_MAX);
     cygwin_conv_path(3, buf, name, sizeof(name));
@@ -51,8 +56,15 @@ TclpFindExecutable(
 	/* Strip '.exe' part. */
 	length -= 4;
     }
-    TclSetObjNameOfExecutable(
-	    Tcl_NewStringObj(name, length), NULL);
+    TclSetObjNameOfExecutable(Tcl_NewStringObj(name, length), NULL);
+
+#if !defined(STATIC_BUILD)
+    HMODULE hModule = (HMODULE)TclWinGetTclInstance();
+    if (GetModuleFileNameW(hModule, buf, PATH_MAX) < PATH_MAX) {
+	cygwin_conv_path(3, buf, name, sizeof(name));
+    }
+    TclSetObjNameOfShlib(Tcl_NewStringObj(name, TCL_AUTO_LENGTH), NULL);
+#endif
 }
 #else
 void
@@ -141,7 +153,7 @@ TclpFindExecutable(
     }
     TclNewObj(obj);
     TclSetObjNameOfExecutable(obj, NULL);
-    goto done;
+    goto getShlibName;
 
     /*
      * If the name starts with "/" then just store it
@@ -156,13 +168,13 @@ TclpFindExecutable(
     {
 	Tcl_ExternalToUtfDStringEx(NULL, NULL, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
 	TclSetObjNameOfExecutable(Tcl_DStringToObj(&utfName), NULL);
-	goto done;
+	goto getShlibName;
     }
 
     if (TclpGetCwd(NULL, &cwd) == NULL) {
 	TclNewObj(obj);
 	TclSetObjNameOfExecutable(obj, NULL);
-	goto done;
+	goto getShlibName;
     }
 
     /*
@@ -192,7 +204,18 @@ TclpFindExecutable(
 	    TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
     TclSetObjNameOfExecutable(Tcl_DStringToObj(&utfName), NULL);
 
-  done:
+  getShlibName:
+#if !defined(STATIC_BUILD)
+    name = CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE;
+# if !defined(NO_DLFCN_H)
+    Dl_info dlinfo;
+    if (dladdr((const void *)TclpFindExecutable, &dlinfo) && dlinfo.dli_fname) {
+	name = dlinfo.dli_fname;
+    }
+# endif
+    TclSetObjNameOfShlib(Tcl_NewStringObj(name, TCL_AUTO_LENGTH), NULL);
+#endif /* STATIC_BUILD */
+
     Tcl_DStringFree(&buffer);
 }
 #endif
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index c520478..f66484a 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -862,12 +862,22 @@ TclpFindExecutable(
     TCL_UNUSED(const char *))
 {
     WCHAR wName[MAX_PATH];
-    char name[MAX_PATH * 3];
+    char name[MAX_PATH * TCL_UTF_MAX];
 
-    GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR));
+    GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(wName[0]));
     WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
     TclWinNoBackslash(name);
     TclSetObjNameOfExecutable(Tcl_NewStringObj(name, TCL_INDEX_NONE), NULL);
+
+#if !defined(STATIC_BUILD)
+    HMODULE hModule = (HMODULE)TclWinGetTclInstance();
+    if (hModule) {
+	GetModuleFileNameW(hModule, wName, sizeof(wName) / sizeof(wName[0]));
+	WideCharToMultiByte(CP_UTF8, 0, wName, -1,
+				name, sizeof(name), NULL, NULL);
+	TclSetObjNameOfShlib(Tcl_NewStringObj(name, TCL_AUTO_LENGTH), NULL);
+    }
+#endif
 }
 
 /*