Merge 8.7 - Fix [8259d74a64] - panic on exit

generic/tclIO.c

@@ -698,8 +698,9 @@ TclFinalizeIOSubsystem(void)
     FreeBinaryEncoding();
     TclpFinalizeSockets();
     TclpFinalizePipes();
+    TclZipfsFinalize();
 }
-
+
 /*
  *----------------------------------------------------------------------
  *

generic/tclInt.h

@@ -3598,8 +3598,9 @@ MODULE_SCOPE void *	TclpThreadGetGlobalTSD(void *tsdKeyPtr);
 MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
 			    const char *msg, Tcl_Size length);
 /* Tip 430 */
-MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
-MODULE_SCOPE int    TclIsZipfsPath(const char *path);
+MODULE_SCOPE int	TclZipfs_Init(Tcl_Interp *interp);
+MODULE_SCOPE int	TclIsZipfsPath(const char *path);
+MODULE_SCOPE void	TclZipfsFinalize(void);
 
 /*
  * Many parsing tasks need a common definition of whitespace.

generic/tclZipfs.c

@@ -16,7 +16,7 @@
  *	projects.
  *
  * Helpful docs:
- * https://pkware.cachefly.net/webdocs/APPNOTE/APPNOTE-6.3.9.TXT 
+ * https://pkware.cachefly.net/webdocs/APPNOTE/APPNOTE-6.3.9.TXT
  * https://libzip.org/specifications/appnote_iz.txt
  */
 
@@ -319,6 +319,7 @@ static int		InitWritableChannel(Tcl_Interp *interp,
 			    ZipChannel *info, ZipEntry *z, int trunc);
 static int		ListMountPoints(Tcl_Interp *interp);
 static int		ContainsMountPoint(const char *path, int pathLen);
+static void		CleanupMount(ZipFile *zf);
 static void		SerializeCentralDirectoryEntry(
 			    const unsigned char *start,
 			    const unsigned char *end, unsigned char *buf,
@@ -364,10 +365,7 @@ static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
 			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 static int		ZipMapArchive(Tcl_Interp *interp, ZipFile *zf,
 			    void *handle);
-static void		ZipfsExitHandler(void *clientData);
-static void		ZipfsMountExitHandler(void *clientData);
 static void		ZipfsSetup(void);
-static void		ZipfsFinalize(void);
 static int		ZipChannelClose(void *instanceData,
 			    Tcl_Interp *interp, int flags);
 static Tcl_DriverGetHandleProc	ZipChannelGetFile;
@@ -1663,9 +1661,15 @@ ZipFSOpenArchive(
 	    ZIPFS_POSIX_ERROR(interp, "file read error");
 	    goto error;
 	}
-	Tcl_Close(interp, zf->chan);
-	zf->chan = NULL;
     }
+    /* 
+     * Close the Tcl channel. If the file was mapped, the mapping is
+     * unaffected. It is important to close the channel otherwise there is a
+     * potential chicken and egg issue at finalization time as the channels
+     * are closed before the file systems are dismounted.
+     */
+    Tcl_Close(interp, zf->chan);
+    zf->chan = NULL;
     return ZipFSFindTOC(interp, needZip, zf);
 
     /*
@@ -1885,7 +1889,6 @@ ZipFSCatalogFilesystem(
      */
 
     zf->mountPoint = (char *) Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
-    Tcl_CreateExitHandler(ZipfsMountExitHandler, zf);
     zf->mountPointLen = strlen(zf->mountPoint);
 
     zf->nameLength = strlen(zipname);
@@ -2133,7 +2136,6 @@ ZipfsSetup(void)
 	    Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
     strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
     ZipFS.initialized = 1;
-    Tcl_CreateExitHandler(ZipfsExitHandler, NULL);
 }
 
 /*
@@ -2186,6 +2188,42 @@ ListMountPoints(
     return TCL_OK;
 }
 
+/*
+ *------------------------------------------------------------------------
+ *
+ * CleanupMount --
+ *
+ *    Releases all resources associated with a mounted archive. There
+ *    must not be any open files in the archive.
+ * 
+ *    Caller MUST be holding WriteLock() before calling this function.
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *    Memory associated with the mounted archive is deallocated.
+ *------------------------------------------------------------------------
+ */
+static void
+CleanupMount(ZipFile *zf)        /* Mount point */
+{
+    ZipEntry *z, *znext;
+    Tcl_HashEntry *hPtr;
+    for (z = zf->entries; z; z = znext) {
+	znext = z->next;
+	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
+	if (hPtr) {
+	    Tcl_DeleteHashEntry(hPtr);
+	}
+	if (z->data) {
+	    Tcl_Free(z->data);
+	}
+	Tcl_Free(z);
+    }
+    zf->entries = NULL;
+}
+
 /*
  *-------------------------------------------------------------------------
  *
@@ -2328,6 +2366,7 @@ TclZipfs_MountBuffer(
 {
     ZipFile *zf;
 
+    /* TODO - how come a *read* lock suffices for initialzing ? */
     ReadLock();
     if (!ZipFS.initialized) {
 	ZipfsSetup();
@@ -2418,7 +2457,6 @@ TclZipfs_Unmount(
     const char *mountPoint)	/* Mount point path. */
 {
     ZipFile *zf;
-    ZipEntry *z, *znext;
     Tcl_HashEntry *hPtr;
     Tcl_DString dsm;
     int ret = TCL_OK, unmounted = 0;
@@ -2456,19 +2494,9 @@ TclZipfs_Unmount(
      * still cleaning things up.
      */
 
-    for (z = zf->entries; z; z = znext) {
-	znext = z->next;
-	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
-	if (hPtr) {
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-	if (z->data) {
-	    Tcl_Free(z->data);
-	}
-	Tcl_Free(z);
-    }
+    CleanupMount(zf);
     ZipFSCloseArchive(interp, zf);
-    Tcl_DeleteExitHandler(ZipfsMountExitHandler, zf);
+
     Tcl_Free(zf);
     unmounted = 1;
 
@@ -6171,53 +6199,46 @@ ZipfsAppHookFindTclInit(
 }
 #endif
 
-static void
-ZipfsExitHandler(
-    TCL_UNUSED(void *)
-)
+void TclZipfsFinalize(void)
 {
+    /*
+     * Finalization steps:
+     * For every mounted archive, if it no longer has any open handles
+     * clean up the mount and associated zip file entries.
+     * If there are no more mounted archives, clean up and free the
+     * ZipFS.fileHash and ZipFS.zipHash tables.
+     */
+    WriteLock();
+
     Tcl_HashEntry *hPtr;
-    Tcl_HashSearch search;
-    if (ZipFS.initialized != -1) {
-	hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
-	if (hPtr == NULL) {
-	    ZipfsFinalize();
-	} else {
-	    /* ZipFS.fallbackEntryEncoding was already freed by
-	     * ZipfsMountExitHandler
-	    */
+    Tcl_HashSearch zipSearch;
+    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &zipSearch); hPtr;
+	    hPtr = Tcl_NextHashEntry(&zipSearch)) {
+	ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+	if (zf->numOpen == 0) {
+	    Tcl_DeleteHashEntry(hPtr);
+	    CleanupMount(zf);
+	    ZipFSCloseArchive(NULL, zf);
+	    Tcl_Free(zf);
 	}
     }
-}
-
-static void
-ZipfsFinalize(void) {
-    Tcl_FSUnregister(&zipfsFilesystem);
-    Tcl_DeleteHashTable(&ZipFS.fileHash);
-    Tcl_Free(ZipFS.fallbackEntryEncoding);
-    ZipFS.initialized = -1;
-}
-
-static void
-ZipfsMountExitHandler(
-    void *clientData)
-{
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch search;
-
-    ZipFile *zf = (ZipFile *) clientData;
-
-    if (TCL_OK != TclZipfs_Unmount(NULL, zf->mountPoint)) {
-	Tcl_Panic("tried to unmount busy filesystem");
-    }
 
-    hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+    hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &zipSearch);
     if (hPtr == NULL) {
-	ZipfsFinalize();
+	hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &zipSearch);
+	if (hPtr == NULL) {
+	    /* Both hash tables empty. Free all resources */
+	    Tcl_FSUnregister(&zipfsFilesystem);
+	    Tcl_DeleteHashTable(&ZipFS.fileHash);
+	    Tcl_DeleteHashTable(&ZipFS.zipHash);
+	    Tcl_Free(ZipFS.fallbackEntryEncoding);
+	    ZipFS.initialized = 0;
+	}
     }
 
+    Unlock();
 }
-
+
 /*
  *-------------------------------------------------------------------------
  *

tests/zipfs.test

@@ -1508,6 +1508,19 @@ namespace eval test_ns_zipfs {
         list [catch {read $fd} message] [close $fd] $message
         close $fd
     } -result {file size error (may be zip64)} -returnCodes error
+
+    test bug-8259d74a64 "Crash exiting with open files" -setup {
+        set path [zippath test.zip]
+        set script "zipfs mount $path /\n"
+        append script {open [zipfs root]test} \n
+        append script "exit\n"
+    } -body {
+        set fd [open |[info nameofexecutable] r+]
+        puts $fd $script
+        flush $fd
+        read $fd
+        close $fd
+    } -result ""
 }