More fixes, update docs

4 files changed, 157 insertions, 84 deletions

diff --git a/doc/zipfs.3 b/doc/zipfs.3
index 77a6a57..af1281c 100644
--- a/doc/zipfs.3
+++ b/doc/zipfs.3
@@ -91,20 +91,43 @@ The function \fImay\fR modify the variables pointed to by \fIargcPtr\fR and
 \fIargvPtr\fR to remove arguments; the current implementation does not do so,
 but callers \fIshould not\fR assume that this will be true in the future.
 .PP
-\fBTclZipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
-given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
-Errors during that process are reported in the interpreter \fIinterp\fR.  If
-\fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
-file systems is written into \fIinterp\fR's result as a sequence of mount
-points and ZIP file names.  The result of this call is a standard Tcl result
+\fBTclZipfs_Mount\fR is used to mount ZIP archives and to retrieve information
+about currently mounted archives. If \fImountpoint\fR and \fIzipname\fR are both
+specified (i.e. non-NULL), the function mounts the ZIP archive \fIzipname\fR on
+the mount point given in \fImountpoint\fR. If \fIpassword\fR is not NULL, it
+should point to the NUL terminated password protecting the archive. If not under
+the zipfs file system root, \fImountpoint\fR is normalized with respect to it.
+For example, a mount point passed as either \fBmt\fR \fB/mt\fR would be
+normalized to \fB//zipfs:/mt\fR. An error is raised if the mount point includes
+a drive or UNC volume. On success, \fIinterp\fR's result is set to the
+normalized mount point path.
+.PP
+If \fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
+file systems is stored in \fIinterp\fR's result as a sequence of mount
+points and ZIP file names.
+.PP
+If \fImountpoint\fR is not NULL but \fIzipfile\fR
+is NULL, the path to the archive mounted at that mount point is stored
+as \fIinterp\fR's result. The function returns a standard Tcl result
 code.
 .PP
-\fBTclZipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
-\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
-assumed to be not password protected.  Errors during that process are reported
-in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
-the buffer is internally copied before mounting or not. The result of this
-call is a standard Tcl result code.
+\fBTclZipfs_MountBuffer\fR is similar to \fBTclZipfs_Mount\fR except that the
+content of a ZIP archive is passed in the buffer pointed to by \fIdata\fR.
+If \fImountpoint\fR and
+\fIdata\fR are both non-NULL, the function
+mounts the ZIP archive content \fIdata\fR on the mount point
+given in \fImountpoint\fR.
+The
+\fIcopy\fR argument determines whether the buffer is internally copied before
+mounting or not. The ZIP archive is assumed to be not password protected.
+On success, \fIinterp\fR's result is set to the normalized mount point
+path.
+If \fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
+file systems is stored in \fIinterp\fR's result as a sequence of mount
+points and ZIP file names. If \fImountpoint\fR is not NULL but \fIdata\fR
+is NULL, the path to the archive mounted at that mount point is stored
+as \fIinterp\fR's result. The function returns a standard Tcl result
+code.
 .PP
 \fBTclZipfs_Unmount\fR undoes the effect of \fBTclZipfs_Mount\fR, i.e., it
 unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
diff --git a/doc/zipfs.n b/doc/zipfs.n
index fa361ef..a730497 100644
--- a/doc/zipfs.n
+++ b/doc/zipfs.n
@@ -123,6 +123,12 @@ filesystem at \fImountpoint\fR.  After this command executes, files contained
 in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
 If \fImountpoint\fR is
 specified as an empty string, it is defaulted to the \fB[zipfs root]\fR.
+The command returns the normalized mount point path.
+.PP
+If not under the zipfs file system root, \fImountpoint\fR is normalized with
+respect to it. For example, a mount point passed as either \fBmt\fR \fB/mt\fR 
+would be normalized to \fB//zipfs:/mt\fR. An error is raised if the mount point
+includes a drive or UNC volume.
 .PP
 \fBNB:\fR because the current working directory is a concept maintained by the
 operating system, using \fBcd\fR into a mounted archive will only work in the
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index d840224..a074db1 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -1011,7 +1011,6 @@ NormalizeMountPoint(Tcl_Interp *interp, const char *mountPath, Tcl_DString *dsPt
      * Several things need to happen here
      * - Absolute paths containing volumes (drive letter or UNC) raise error
      *   except of course if the volume is zipfs root
-     * - \ need to be converted to /
      * - \ -> / and // -> / conversions (except if UNC which is error)
      * - . and .. have to be dealt with
      * The first is explicitly checked, the others are dealt with a
@@ -1029,7 +1028,7 @@ NormalizeMountPoint(Tcl_Interp *interp, const char *mountPath, Tcl_DString *dsPt
 	unnormalizedObj = Tcl_DStringToObj(dsPtr);
     } else {
 	if (joinedPath[0] != '/' || joinedPath[1] == '/') {
-	    /* D:/x, D:x or //unc */
+	    /* mount path was D:/x, D:x or //unc */
 	    goto invalidMountPath;
 	}
 	unnormalizedObj = Tcl_ObjPrintf(ZIPFS_VOLUME "%s", joinedPath + 1);
@@ -1099,10 +1098,16 @@ MapPathToZipfs(Tcl_Interp *interp,
 
     joiner[0] = mountPath;
     joiner[1] = path;
+#ifndef _WIN32
+    /* On Unix C:/foo/bat is not treated as absolute by JoinPath so check ourself */
+    if (path[0] && path[1] == ':') {
+	joiner[1] += 2;
+    }
+#endif
     joinedPath = Tcl_JoinPath(2, joiner, dsPtr);
 
     if (strncmp(ZIPFS_VOLUME, joinedPath, ZIPFS_VOLUME_LEN)) {
-	/* path was not relative. Strip off the volume */
+	/* path was not relative. Strip off the volume (e.g. UNC) */
 	Tcl_Size numParts;
 	const char **partsPtr;
 	Tcl_SplitPath(path, &numParts, &partsPtr);
@@ -2347,26 +2352,52 @@ TclZipfs_Mount(
 	ret = DescribeMounted(interp, mountPoint);
 	Unlock();
     } else {
+	/* Have both a mount point and a file (name) to mount there. */
+
+	Tcl_Obj *zipPathObj;
+	Tcl_Obj *normZipPathObj;
+
 	Unlock();
 
-	/* Have both a mount point and a file (name) to mount there. */
-	if (passwd == NULL ||
-	    (ret = IsPasswordValid(interp, passwd, strlen(passwd))) == TCL_OK) {
-	    zf = AllocateZipFile(interp, strlen(mountPoint));
-	    if (zf == NULL) {
-		ret = TCL_ERROR;
-	    } else {
-		ret = ZipFSOpenArchive(interp, zipname, 1, zf);
-		if (ret != TCL_OK) {
-		    ckfree(zf);
-		} else {
-		    ret = ZipFSCatalogFilesystem(
-			interp, zf, mountPoint, passwd, zipname);
-		    /* Note zf is already freed on error! */
+	zipPathObj = Tcl_NewStringObj(zipname, -1);
+	Tcl_IncrRefCount(zipPathObj);
+	normZipPathObj = Tcl_FSGetNormalizedPath(interp, zipPathObj);
+	if (normZipPathObj == NULL) {
+	    Tcl_SetObjResult(
+		interp,
+		Tcl_ObjPrintf("could not normalize zip filename \"%s\"", zipname));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", NULL);
+	    ret = TCL_ERROR;
+	} else {
+	    Tcl_IncrRefCount(normZipPathObj);
+	    const char *normPath = Tcl_GetString(normZipPathObj);
+	    if (passwd == NULL ||
+		(ret = IsPasswordValid(interp, passwd, strlen(passwd))) ==
+		    TCL_OK) {
+		zf = AllocateZipFile(interp, strlen(mountPoint));
+		if (zf == NULL) {
+		    ret = TCL_ERROR;
+		}
+		else {
+		    ret = ZipFSOpenArchive(interp, normPath, 1, zf);
+		    if (ret != TCL_OK) {
+			ckfree(zf);
+		    }
+		    else {
+			ret = ZipFSCatalogFilesystem(
+			    interp, zf, mountPoint, passwd, normPath);
+			/* Note zf is already freed on error! */
+		    }
 		}
 	    }
+	    Tcl_DecrRefCount(normZipPathObj);
+	    if (ret == TCL_OK && interp) {
+		Tcl_DStringResult(interp, &ds);
+	    }
 	}
+	Tcl_DecrRefCount(zipPathObj);
     }
+
     Tcl_DStringFree(&ds);
     return ret;
 }
@@ -2377,7 +2408,7 @@ TclZipfs_Mount(
  * TclZipfs_MountBuffer --
  *
  *	This procedure is invoked to mount a given ZIP archive file on a given
- *	mountpoint with optional ZIP password.
+ *	mountpoint.
  *
  * Results:
  *	A standard Tcl result.
@@ -2472,6 +2503,9 @@ TclZipfs_MountBuffer(
 	    ret = ZipFSCatalogFilesystem(
 		interp, zf, mountPoint, NULL, "Memory Buffer");
 	}
+	if (ret == TCL_OK && interp) {
+	    Tcl_DStringResult(interp, &ds);
+	}
     }
 
 done:
@@ -2581,7 +2615,6 @@ ZipFSMountObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     const char *mountPoint = NULL, *zipFile = NULL, *password = NULL;
-    Tcl_Obj *zipFileObj = NULL;
     int result;
 
     if (objc > 4) {
@@ -2598,16 +2631,7 @@ ZipFSMountObjCmd(
 	    mountPoint = Tcl_GetString(objv[1]);
 	} else {
 	    /* 2 < objc < 4 */
-	    zipFileObj = Tcl_FSGetNormalizedPath(interp, objv[1]);
-	    if (!zipFileObj) {
-		Tcl_SetObjResult(
-		    interp,
-		    Tcl_NewStringObj("could not normalize zip filename", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", NULL);
-		return TCL_ERROR;
-	    }
-	    Tcl_IncrRefCount(zipFileObj);
-	    zipFile = Tcl_GetString(zipFileObj);
+	    zipFile = Tcl_GetString(objv[1]);
 	    mountPoint = Tcl_GetString(objv[2]);
 	    if (objc > 3) {
 		password = Tcl_GetString(objv[3]);
@@ -2616,9 +2640,6 @@ ZipFSMountObjCmd(
     }
 
     result = TclZipfs_Mount(interp, zipFile, mountPoint, password);
-    if (zipFileObj != NULL) {
-	Tcl_DecrRefCount(zipFileObj);
-    }
     return result;
 }
 
@@ -3964,7 +3985,7 @@ ZipFSCanonicalObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    char *mntPoint = NULL;
+    const char *mntPoint = NULL;
     Tcl_DString dsPath, dsMount;
 
     if (objc < 2 || objc > 3) {
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 88bee93..025d4c1 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -390,7 +390,7 @@ namespace eval test_ns_zipfs {
     # Wrapper to ease transition if Tcl changes order of argument to zipfs mount
     # or the zipfs prefix
     proc mount [list zippath [list mountpoint $defMountPt]] {
-        zipfs mount $zippath $mountpoint
+        return [zipfs mount $zippath $mountpoint]
     }
 
     # Make full path to zip file
@@ -464,23 +464,21 @@ namespace eval test_ns_zipfs {
     proc testmount {id zippath checkPath mountpoint args} {
         set zippath [zippath $zippath]
         test zipfs-mount-$id "zipfs mount $id" -body {
-            mount $zippath $mountpoint
-            set canon [zipfs canonical $mountpoint]
+            set canon [mount $zippath $mountpoint]
             list [file exists [file join $canon $checkPath]] \
-                [mounttarget $canon]
+                [zipfs mount $canon] [zipfs mount $mountpoint]
         } -cleanup {
             zipfs unmount $mountpoint
-        } -result [list 1 $zippath] {*}$args
+        } -result [list 1 $zippath $zippath] {*}$args
 
         # Mount memory buffer
         test zipfs-mount_data-$id "zipfs mount_data $id" -body {
-            zipfs mount_data [readbin $zippath] $mountpoint
-            set canon [zipfs canonical $mountpoint]
+            set canon [zipfs mount_data [readbin $zippath] $mountpoint]
             list [file exists [file join $canon $checkPath]] \
-                [mounttarget $canon]
+                [zipfs mount $canon] [zipfs mount $mountpoint]
         } -cleanup {
             cleanup
-        } -result [list 1 {Memory Buffer}] {*}$args
+        } -result [list 1 {Memory Buffer} {Memory Buffer}] {*}$args
 
     }
 
@@ -498,12 +496,28 @@ namespace eval test_ns_zipfs {
     testbadmount bad-file-count-high  incons-file-count-high.zip   "truncated directory"
     testbadmount bad-file-count-low   incons-file-count-low.zip    "short file count"
 
+    test zipfs-mount-on-drive "Mount point include drive" -body {
+        zipfs mount [zippath test.zip] C:/foo
+    } -result {Invalid mount path "C:/foo"} -returnCodes error -constraints win
+    test zipfs-mount_data-on-drive "Mount point include drive" -body {
+        zipfs mount_data [readbin [zippath test.zip]] C:/foo
+    } -result {Invalid mount path "C:/foo"} -returnCodes error -constraints win
+    test zipfs-mount-on-unc "Mount point is unc" -body {
+        zipfs mount [zippath test.zip] //unc/share/foo
+    } -result {Invalid mount path "//unc/share/foo"} -returnCodes error
+    test zipfs-mount_data-on-unc "Mount point include unc" -body {
+        zipfs mount_data [readbin [zippath test.zip]] //unc/share/foo
+    } -result {Invalid mount path "//unc/share/foo"} -returnCodes error
+
+    # Good mounts
     testmount basic             test.zip           testdir/test2 $defMountPt
     testmount basic-on-default  test.zip           testdir/test2 ""
     testmount basic-on-root     test.zip           testdir/test2 [zipfs root]
     testmount basic-on-slash    test.zip           testdir/test2 /
+    testmount basic-on-bslash   test.zip           testdir/test2 \\ -constraints win
     testmount basic-on-relative test.zip           testdir/test2 testmount
     testmount basic-on-absolute test.zip           testdir/test2 /testmount
+    testmount basic-on-absolute-bslash test.zip    testdir/test2 \\testmount -constraints win
     testmount zip-at-end        junk-at-start.zip  testdir/test2 $defMountPt
     testmount zip-at-start      junk-at-end.zip    testdir/test2 $defMountPt
     testmount zip-in-zip [file join [zipfs root] test2 test.zip] testdir/test2 $defMountPt -setup {
@@ -672,6 +686,18 @@ namespace eval test_ns_zipfs {
     } -result {{} {test2 test3} test2-overlay}
 
     #
+    # paths inside a zip
+    # TODO - paths encoded in utf-8 vs fallback encoding
+    test zipfs-content-paths-1 "Test absolute and full paths" -setup {
+        mount [zippath test-paths.zip]
+    } -cleanup {
+        cleanup
+    } -body {
+        # Primarily verifies that drive letters are stripped and paths maintained
+        lsort [zipfs list]
+    } -result {//zipfs:/testmount //zipfs:/testmount/filename.txt //zipfs:/testmount/src //zipfs:/testmount/src/tcltk //zipfs:/testmount/src/tcltk/wip //zipfs:/testmount/src/tcltk/wip/tcl //zipfs:/testmount/src/tcltk/wip/tcl/tests //zipfs:/testmount/src/tcltk/wip/tcl/tests/zipfiles //zipfs:/testmount/src/tcltk/wip/tcl/tests/zipfiles/abspath.txt //zipfs:/testmount/src/tcltk/wip/tcl/tests/zipfiles/fullpath.txt}
+
+    #
     # zipfs list
     testnumargs "zipfs list" "" "?(-glob|-regexp)? ?pattern?"
 
@@ -899,44 +925,41 @@ namespace eval test_ns_zipfs {
     } -result {path "//zipfs:/testmt/a" not found in any zipfs volume} -returnCodes error
 
     #
-    # zipfs canonical -
-    # TODO - semantics are very unclear. Can produce nonsensical paths like
-    # //zipfs:/n/zipfs:/m/test. Minimal sanity tests for now.
+    # zipfs canonical
     test zipfs-canonical-minargs {zipfs canonical min args} -body {
         zipfs canonical
-    } -returnCodes error -result {wrong # args: should be "zipfs canonical ?mountpoint? filename ?inZipfs?"}
+    } -returnCodes error -result {wrong # args: should be "zipfs canonical ?mountpoint? filename"}
     test zipfs-canonical-maxargs {zipfs canonical max args} -body {
-        zipfs canonical a b c d
-    } -returnCodes error -result {wrong # args: should be "zipfs canonical ?mountpoint? filename ?inZipfs?"}
+        zipfs canonical a b c
+    } -returnCodes error -result {wrong # args: should be "zipfs canonical ?mountpoint? filename"}
     proc testzipfscanonical {id cmdargs result args} {
         test zipfs-canonical-$id "zipfs canonical $id" \
             -body [list zipfs canonical {*}$cmdargs] \
             -result $result {*}$args
     }
-    testzipfscanonical default-relative             PATH        [file join [zipfs root] PATH]
-    testzipfscanonical default-absolute             /PATH       [file join [zipfs root] PATH]
-    testzipfscanonical root-relative-1       [list [zipfs root] PATH] [file join [zipfs root] PATH]
-    testzipfscanonical root-relative-2       [list / PATH] [file join [zipfs root] PATH]
-    testzipfscanonical root-absolute-1       [list [zipfs root] /PATH] [file join [zipfs root] PATH]
-    testzipfscanonical root-absolute-2       [list / /PATH] [file join [zipfs root] PATH]
-    testzipfscanonical absolute-relative            {/MT PATH}   [file join [zipfs root] MT PATH]
-    testzipfscanonical absolute-absolute            {/MT /PATH}  [file join [zipfs root] PATH]
-    testzipfscanonical relative-relative            {MT PATH}   [file join [zipfs root] MT PATH]
-    testzipfscanonical relative-absolute            {MT /PATH}  [file join [zipfs root] PATH]
-    testzipfscanonical mountpoint-trailslash-relative {MT/ PATH}  [file join [zipfs root] MT PATH]
-    testzipfscanonical mountpoint-trailslash-absolute {MT/ /PATH} [file join [zipfs root] PATH]
-    testzipfscanonical mountpoint-root-relative       [list [zipfs root] PATH] [file join [zipfs root] PATH]
-    testzipfscanonical mountpoint-root-absolute       [list [zipfs root] /PATH] [file join [zipfs root] PATH]
-    testzipfscanonical mountpoint-empty-relative      {{} PATH} [file join [zipfs root] PATH]
-
-    testzipfscanonical driveletter X: [zipfs root] -constraints win
-    testzipfscanonical drivepath X:/foo/bar [file join [zipfs root] foo bar] -constraints win
-    testzipfscanonical drivepath {MT X:/foo/bar} [file join [zipfs root] MT foo bar] -constraints win
-    # (backslashes need additional escaping passed to testzipfscanonical)
-    testzipfscanonical backslashes X:\\\\foo\\\\bar [file join [zipfs root] foo bar] -constraints win
-    testzipfscanonical backslashes-1 X:/foo\\\\bar [file join [zipfs root] foo bar] -constraints win
-    testzipfscanonical zipfspath //zipfs:/x/y [file join [zipfs root] x y]
-    testzipfscanonical zipfspath {MT //zipfs:/x/y} [file join [zipfs root] mt x y]
+    testzipfscanonical default-relative      [list a]               [file join [zipfs root] a]
+    testzipfscanonical default-absolute      [list /a]              [file join [zipfs root] a]
+    testzipfscanonical root-relative-1       [list [zipfs root] a]  [file join [zipfs root] a]
+    testzipfscanonical root-relative-2       [list / a]             [file join [zipfs root] a]
+    testzipfscanonical root-absolute-1       [list [zipfs root] /a] [file join [zipfs root] a]
+    testzipfscanonical root-absolute-2       [list / /a]            [file join [zipfs root] a]
+    testzipfscanonical absolute-relative     [list /MT a]           [file join [zipfs root] MT a]
+    testzipfscanonical absolute-absolute     [list /MT /a]          [file join [zipfs root] MT a]
+    testzipfscanonical relative-relative     [list MT a]            [file join [zipfs root] MT a]
+    testzipfscanonical relative-absolute     [list MT /a]           [file join [zipfs root] MT a]
+    testzipfscanonical mountpoint-trailslash-relative [list MT/ a]  [file join [zipfs root] MT a]
+    testzipfscanonical mountpoint-trailslash-absolute [list MT/ /a] [file join [zipfs root] MT a]
+    testzipfscanonical mountpoint-root-relative       [list [zipfs root] a]  [file join [zipfs root] a]
+    testzipfscanonical mountpoint-root-absolute       [list [zipfs root] /a] [file join [zipfs root] a]
+    testzipfscanonical mountpoint-empty-relative      [list {} a] [file join [zipfs root] a]
+
+    testzipfscanonical driveletter   [list X:]               [zipfs root] -constraints win
+    testzipfscanonical drivepath     [list X:/foo/bar]       [file join [zipfs root] foo bar] -constraints win
+    testzipfscanonical drivepath     [list MT X:/foo/bar]    [file join [zipfs root] MT foo bar] -constraints win
+    testzipfscanonical backslashes   [list X:\\\\foo\\\\bar] [file join [zipfs root] foo bar] -constraints win
+    testzipfscanonical backslashes-1 [list X:/foo\\\\bar]    [file join [zipfs root] foo bar] -constraints win
+    testzipfscanonical zipfspath     [list //zipfs:/x/y]     [file join [zipfs root] x y]
+    testzipfscanonical zipfspath     [list MT //zipfs:/x/y]  [file join [zipfs root] x y]
 
     #
     # Read/uncompress