Merge 8.7 - zipfs file exists, stat

3 files changed, 204 insertions, 61 deletions

diff --git a/doc/zipfs.n b/doc/zipfs.n
index 247cac2..f9cbdc5 100644
--- a/doc/zipfs.n
+++ b/doc/zipfs.n
@@ -77,8 +77,9 @@ the compressed size of the file, and
 .IP (4)
 the offset of the compressed data in the ZIP archive file.
 .PP
-Note: querying the mount point gives the start of the zip data as the offset
+As a special case, querying the mount point gives the start of the zip data as the offset
 in (4), which can be used to truncate the zip information from an executable.
+Querying an ancestor of a mount point will raise an error.
 .RE
 .TP
 \fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 91716b2..f65d27a 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -205,7 +205,7 @@ typedef struct ZipFile {
     struct ZipEntry *entries;	/* List of files in archive */
     struct ZipEntry *topEnts;	/* List of top-level dirs in archive */
     char *mountPoint;		/* Mount point name */
-    size_t mountPointLen;	/* Length of mount point name */
+    Tcl_Size mountPointLen;	/* Length of mount point name */
 #ifdef _WIN32
     HANDLE mountHandle;		/* Handle used for direct file access. */
 #endif /* _WIN32 */
@@ -307,13 +307,14 @@ static const char *zipfs_literal_tcl_library = NULL;
 
 static int		CopyImageFile(Tcl_Interp *interp, const char *imgName,
 			    Tcl_Channel out);
-static inline int	DescribeMounted(Tcl_Interp *interp,
+static int		DescribeMounted(Tcl_Interp *interp,
 			    const char *mountPoint);
 static int		InitReadableChannel(Tcl_Interp *interp,
 			    ZipChannel *info, ZipEntry *z);
 static int		InitWritableChannel(Tcl_Interp *interp,
 			    ZipChannel *info, ZipEntry *z, int trunc);
-static inline int	ListMountPoints(Tcl_Interp *interp);
+static int		ListMountPoints(Tcl_Interp *interp);
+static int		ContainsMountPoint(const char *path, int pathLen);
 static void		SerializeCentralDirectoryEntry(
 			    const unsigned char *start,
 			    const unsigned char *end, unsigned char *buf,
@@ -1061,6 +1062,75 @@ ZipFSLookupZip(
 }
 
 /*
+ *------------------------------------------------------------------------
+ *
+ * ContainsMountPoint --
+ *
+ *    Check if there is a mount point anywhere under the specified path.
+ *    Although the function will work for any path, for efficiency reasons
+ *    it should be called only after checking ZipFSLookup does not find
+ *    the path.
+ *
+ *    Caller must hold read lock before calling.
+ *
+ * Results:
+ *    1 - there is at least one mount point under the path
+ *    0 - otherwise
+ *
+ * Side effects:
+ *    None.
+ *
+ *------------------------------------------------------------------------
+ */
+static int
+ContainsMountPoint (const char *path, int pathLen)
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+
+    if (ZipFS.zipHash.numEntries == 0) {
+	return 0;
+    }
+    if (pathLen < 0)
+	pathLen = strlen(path);
+
+    /*
+     * We are looking for the case where the path is //zipfs:/a/b
+     * and there is a mount point //zipfs:/a/b/c/.. below it
+     */
+    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
+	 hPtr = Tcl_NextHashEntry(&search)) {
+	ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+
+	if (zf->mountPointLen == 0) {
+	    /* 
+	     * Enumerate the contents of the ZIP; it's mounted on the root.
+	     * TODO - a holdover from androwish? Tcl does not allow mounting
+	     * outside of the //zipfs:/ area.
+	     */
+	    ZipEntry *z;
+
+	    for (z = zf->topEnts; z; z = z->tnext) {
+		int lenz = (int) strlen(z->name);
+		if ((lenz >= pathLen) &&
+		    (z->name[pathLen] == '/' || z->name[pathLen] == '\0') &&
+		    (strncmp(z->name, path, pathLen) == 0)) {
+		    return 1;
+		}
+	    }
+	} else if ((zf->mountPointLen >= pathLen) &&
+		 (zf->mountPoint[pathLen] == '/' ||
+		  zf->mountPoint[pathLen] == '\0' ||
+		  pathLen == ZIPFS_VOLUME_LEN) &&
+		 (strncmp(zf->mountPoint, path, pathLen) == 0)) {
+	    /* Matched standard mount */
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+/*
  *-------------------------------------------------------------------------
  *
  * AllocateZipFile, AllocateZipEntry, AllocateZipChannel --
@@ -1978,7 +2048,7 @@ ZipfsSetup(void)
  *-------------------------------------------------------------------------
  */
 
-static inline int
+static int
 ListMountPoints(
     Tcl_Interp *interp)
 {
@@ -2028,7 +2098,7 @@ ListMountPoints(
  *-------------------------------------------------------------------------
  */
 
-static inline int
+static int
 DescribeMounted(
     Tcl_Interp *interp,
     const char *mountPoint)
@@ -3780,6 +3850,11 @@ ZipFSExistsObjCmd(
 
     ReadLock();
     exists = ZipFSLookup(filename) != NULL;
+    if (!exists) {
+	/* An ancestor directory of a file ? */
+	exists = ContainsMountPoint(filename, -1);
+    }
+
     Unlock();
 
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
@@ -4939,6 +5014,11 @@ ZipEntryStat(
 	buf->st_ctime = z->timestamp;
 	buf->st_atime = z->timestamp;
 	ret = 0;
+    } else if (ContainsMountPoint(path, -1)) {
+	/* An intermediate dir under which a mount exists */
+	memset(buf, 0, sizeof(Tcl_StatBuf));
+	buf->st_mode = S_IFDIR | 0555;
+	ret = 0;
     }
     Unlock();
     return ret;
@@ -4966,17 +5046,23 @@ ZipEntryAccess(
     char *path,
     int mode)
 {
-    ZipEntry *z;
-
     if (mode & 3) {
 	return -1;
     }
+
     ReadLock();
-    z = ZipFSLookup(path);
+    int access;
+    ZipEntry *z = ZipFSLookup(path);
+    /* Could a real zip entry or an intermediate directory of a mount point */
+    if (z || ContainsMountPoint(path, -1)) {
+	access = 0;
+    } else {
+	access = -1;
+    }
     Unlock();
-    return (z ? 0 : -1);
+    return access;
 }
-
+
 /*
  *-------------------------------------------------------------------------
  *
@@ -5225,19 +5311,31 @@ ZipFSMatchInDirectoryProc(
 	goto end;
     }
 
-    /*
-     * Can we skip the complexity of actual globbing? Without a pattern, yes;
-     * it's a directory existence test.
-     */
-
-    if (!pattern || (pattern[0] == '\0')) {
-	ZipEntry *z = ZipFSLookup(path);
-
-	if (z && ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
-		|| (dirOnly && z->isDirectory))) {
-	    AppendWithPrefix(result, prefixBuf, z->name, -1);
+    /* Does the path exist in the hash table? */
+    ZipEntry *z = ZipFSLookup(path);
+    if (z) {
+	/*
+	 * Can we skip the complexity of actual globbing? Without a pattern,
+	 * yes; it's a directory existence test.
+	 */
+	if (!pattern || (pattern[0] == '\0')) {
+	    /* TODO - can't seem to get to this code from script for tests. */
+	    /* Follow logic of what tclUnixFile.c does */
+	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory) ||
+		(dirOnly && z->isDirectory)) {
+		Tcl_ListObjAppendElement(NULL, result, pathPtr);
+	    }
+	    goto end;
+	}
+    } else {
+	/* Not in the hash table but could be an intermediate dir in a mount */
+	if (!pattern || (pattern[0] == '\0')) {
+	    /* TODO - can't seem to get to this code from script for tests. */
+	    if (dirOnly && ContainsMountPoint(path, len)) {
+		Tcl_ListObjAppendElement(NULL, result, pathPtr);
+	    }
+	    goto end;
 	}
-	goto end;
     }
 
     /*
@@ -5261,7 +5359,7 @@ ZipFSMatchInDirectoryProc(
 
     for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
 	    hPtr; hPtr = Tcl_NextHashEntry(&search)) {
-	ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+	z = (ZipEntry *) Tcl_GetHashValue(hPtr);
 
 	if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory)
 		|| (!dirOnly && z->isDirectory))) {
@@ -5312,10 +5410,10 @@ ZipFSMatchMountPoints(
 {
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    size_t l;
+    int l;
     Tcl_Size normLength;
     const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength);
-    size_t len = normLength;
+    Tcl_Size len = normLength;
 
     if (len < 1) {
 	/*
@@ -5343,14 +5441,16 @@ ZipFSMatchMountPoints(
 
 	    /*
 	     * Enumerate the contents of the ZIP; it's mounted on the root.
+	     * TODO - a holdover from androwish? Tcl does not allow mounting
+	     * outside of the //zipfs:/ area.
 	     */
 
 	    for (z = zf->topEnts; z; z = z->tnext) {
-		size_t lenz = strlen(z->name);
+		Tcl_Size lenz = strlen(z->name);
 
 		if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0)
 			&& (z->name[len] == '/')
-			&& (CountSlashes(z->name) == l)
+			&& ((int) CountSlashes(z->name) == l)
 			&& Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) {
 		    AppendWithPrefix(result, prefix, z->name, lenz);
 		}
@@ -5358,7 +5458,7 @@ ZipFSMatchMountPoints(
 	} else if ((zf->mountPointLen > len + 1)
 		&& (strncmp(zf->mountPoint, path, len) == 0)
 		&& (zf->mountPoint[len] == '/')
-		&& (CountSlashes(zf->mountPoint) == l)
+		&& ((int) CountSlashes(zf->mountPoint) == l)
 		&& Tcl_StringCaseMatch(zf->mountPoint + len + 1,
 			pattern, 0)) {
 	    /*
@@ -5394,7 +5494,6 @@ ZipFSPathInFilesystemProc(
 {
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    int ret = -1;
     Tcl_Size len;
     char *path;
 
@@ -5403,39 +5502,88 @@ ZipFSPathInFilesystemProc(
 	return -1;
     }
     path = Tcl_GetStringFromObj(pathPtr, &len);
+    /*
+     * TODO - why not make ZIPFS_VOLUME both necessary AND sufficient? 
+     * Currently we only claim ownership if there is a matching mount.
+     */
     if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
 	return -1;
+    } else if (len == ZIPFS_VOLUME_LEN && ZipFS.zipHash.numEntries != 0) {
+	/* zipfs root and at least one entry */
+	return TCL_OK;
     }
 
+    int ret = TCL_OK;
+
     ReadLock();
     hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
     if (hPtr) {
-	ret = TCL_OK;
 	goto endloop;
     }
 
+    /*
+     * Not in hash table but still could be owned by zipfs in two other cases:
+     * Assuming there is a mount point //zipfs:/a/b/c,
+     *  1. The path is under the mount point, e.g. //zipfs:/a/b/c/f but that
+     *     file does not exist.
+     *  2. The path is an intermediate directory in a mount point, e.g.
+     *     //zipfs:/a/b
+     */
+
     for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
 	    hPtr = Tcl_NextHashEntry(&search)) {
 	ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);
 
 	if (zf->mountPointLen == 0) {
+	    /* 
+	     * Mounted on the root (/)
+	     * TODO - a holdover from androwish? Tcl does not allow mounting
+	     * outside of the //zipfs:/ area.
+	     */
 	    ZipEntry *z;
 
 	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
-		Tcl_Size lenz = strlen(z->name);
-
-		if ((len >= lenz) &&
-			(strncmp(path, z->name, lenz) == 0)) {
-		    ret = TCL_OK;
+		if (strncmp(path, z->name, len) == 0) {
+		    int lenz = (int)strlen(z->name);
+		    if (len == lenz) {
+			/* Would have been in hash table? But nm ... */
+			goto endloop;
+		    } else if (len > lenz) {
+			/* Case 1 above */
+			if (path[lenz] == '/') {
+			    goto endloop;
+			}
+		    } else { /* len < lenz */
+			/* Case 2 above */
+			if (z->name[len] == '/') {
+			    goto endloop;
+			}
+		    }
+		}
+	    }
+	} else {
+	    /* Not mounted on root - the norm in Tcl core */
+
+	    /* Lengths are known so check them before strnmp for efficiency*/
+	    assert(len != ZIPFS_VOLUME_LEN); /* Else already handled at top */
+	    if (len == zf->mountPointLen) {
+		/* A non-root or root mount. */
+		goto endloop;
+	    } else if (len > zf->mountPointLen) {
+		/* Case 1 above */
+		if (path[zf->mountPointLen] == '/' &&
+		strncmp(path, zf->mountPoint, zf->mountPointLen) == 0) {
+		    goto endloop;
+		}
+	    } else { /* len < zf->mountPointLen */
+		if (zf->mountPoint[len] == '/' &&
+		strncmp(path, zf->mountPoint, len) == 0) {
 		    goto endloop;
 		}
 	    }
-	} else if (((size_t) len >= zf->mountPointLen) &&
-		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
-	    ret = TCL_OK;
-	    break;
 	}
     }
+    ret = -1; /* Not our file */
 
   endloop:
     Unlock();
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 1073141..52dbcf1 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -706,7 +706,7 @@ namespace eval test_ns_zipfs {
     testzipfslist no-pattern-mount-on-empty "" {test.zip {}} {{} test testdir testdir/test2} -constraints !zipfslib
     testzipfslist no-pattern-mount-on-root "" [list test.zip [zipfs root]] {{} test testdir testdir/test2} -constraints !zipfslib
     testzipfslist no-pattern-mount-on-slash "" [list test.zip /] {{} test testdir testdir/test2} -constraints !zipfslib
-    testzipfslist no-pattern-mount-on-level3 "" [list test.zip testmt/a/b] {{} testmt testmt/a testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2} -constraints {bug-02acab5aea !zipfslib}
+    testzipfslist no-pattern-mount-on-level3 "" [list test.zip testmt/a/b] {{} testmt testmt/a testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2} -constraints {knownBug !zipfslib}
     testzipfslist no-pattern-multiple "" {test.zip testmountA test.zip testmountB/subdir} {
         testmountA testmountA/test testmountA/testdir testmountA/testdir/test2
         testmountB/subdir testmountB/subdir/test testmountB/subdir/testdir testmountB/subdir/testdir/test2
@@ -739,15 +739,14 @@ namespace eval test_ns_zipfs {
             cleanup
         } -result $result {*}$args
     }
-    testzipfsexists native-file      [info nameofexecutable]                   0
-    testzipfsexists nonexistent-file [file join $defaultMountPoint nosuchfile] 0
-    testzipfsexists file             [file join $defaultMountPoint test]       1
-    testzipfsexists dir              [file join $defaultMountPoint testdir]    1
-    testzipfsexists mountpoint       $defaultMountPoint                        1
-    testzipfsexists root             [zipfs root]                              1 \
-        $defaultMountPoint -constraints bug-02acab5aea
-    testzipfsexists level3           [file join $defaultMountPoint a b]        1 \
-        [file join $defaultMountPoint a b c] -constraints bug-02acab5aea
+    testzipfsexists native-file [info nameofexecutable]                   0
+    testzipfsexists enoent      [file join $defaultMountPoint nosuchfile] 0
+    testzipfsexists file        [file join $defaultMountPoint test]       1
+    testzipfsexists dir         [file join $defaultMountPoint testdir]    1
+    testzipfsexists mountpoint  $defaultMountPoint                        1
+    testzipfsexists root        [zipfs root]                              1 $defaultMountPoint
+    testzipfsexists level3      [file join $defaultMountPoint a b]        1 [file join $defaultMountPoint a b c]
+    testzipfsexists level3-enoent [file join $defaultMountPoint a c]      0 [file join $defaultMountPoint a b c]
 
     #
     # zipfs find
@@ -809,13 +808,12 @@ namespace eval test_ns_zipfs {
 
     testzipfsfind level3 [file join [zipfs root] testmt a] {
         test.zip testmt/a/b
-    } [zipfspaths testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2] \
-        -constraints bug-02acab5aea
+    } [zipfspaths testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2]
 
     testzipfsfind level3-root [zipfs root] {
         test.zip testmt/a/b
     } [zipfspaths testmt testmt/a testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2] \
-        -constraints bug-02acab5aea
+        -constraints bug-9e039ee0b9
 
     test zipfs-find-native-absolute "zipfs find on native file system" -setup {
         set dir [makeDirectory zipfs-native-absolute]
@@ -897,7 +895,7 @@ namespace eval test_ns_zipfs {
         cleanup
     } -body {
         zipfs info [file join [zipfs root] testmt a]
-    } -result {{} 0 0 0} -constraints bug-02acab5aea
+    } -result {path "//zipfs:/testmt/a" not found in any zipfs volume} -returnCodes error
 
     #
     # zipfs canonical -
@@ -1276,21 +1274,17 @@ namespace eval test_ns_zipfs {
         lsort -stride 2 [file stat [zipfs root]]
     } -result [fixupstat {atime 0 ctime 0 dev 0 gid 0 ino 0 mode 16749 mtime 0 nlink 0 size 0 type directory uid 0}]
 
-    test zipfs-file-stat-root-subdir-mount "Read stat of root when mount is subdir" -constraints {
-        bug-02acab5aea
-    } -setup {
+    test zipfs-file-stat-root-subdir-mount "Read stat of root when mount is subdir" -setup {
         mount [zippath test.zip]
     } -cleanup cleanup -body {
         lsort -stride 2 [file stat [zipfs root]]
     } -result [fixupstat {atime 0 ctime 0 dev 0 gid 0 ino 0 mode 16749 mtime 0 nlink 0 size 0 type directory uid 0}]
 
-    test zipfs-file-stat-level3 "Stat on a directory that is intermediary in a mount point" -constraints {
-        bug-02acab5aea
-    } -setup {
+    test zipfs-file-stat-level3 "Stat on a directory that is intermediary in a mount point" -setup {
         mount [zippath test.zip] [file join $defaultMountPoint mt2]
     } -cleanup cleanup -body {
         lsort -stride 2 [file stat $defaultMountPoint]
-    }
+    } -result [fixupstat {atime 0 ctime 0 dev 0 gid 0 ino 0 mode 16749 mtime 0 nlink 0 size 0 type directory uid 0}]
 
     #
     # glob of zipfs file