filesystem boundary fix

diff --git a/generic/vfs.c b/generic/vfs.c
index 1b3104ad31e38a200b2f5c9c950c4e9eb0ee72ba..010952f957df940ab3fe3de32d1060f2c2c60191 100644 (file)
--- a/generic/vfs.c
+++ b/generic/vfs.c
@@ -46,6 +46,13 @@ EXTERN int Vfs_Init _ANSI_ARGS_((Tcl_Interp*));
 static void Vfs_AddVolume    _ANSI_ARGS_((Tcl_Obj*));
 static int  Vfs_RemoveVolume _ANSI_ARGS_((Tcl_Obj*));
 
+/* So we can compile against Tcl 8.4 and Tcl 8.5 or newer */
+#ifndef TCL_FILESYSTEM_VERSION_2
+#define TCL_FILESYSTEM_VERSION_2       ((Tcl_FSVersion) 0x2)
+typedef Tcl_Obj* (Tcl_FSListMountsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
+#define VFS_COMPILE_WITH_84
+#endif
+
 /* 
  * Stores the list of volumes registered with the vfs (and therefore
  * also registered with Tcl).  It is maintained as a valid Tcl list at
@@ -193,6 +200,7 @@ static Tcl_FSFilesystemSeparatorProc VfsFilesystemSeparator;
 static Tcl_FSFreeInternalRepProc VfsFreeInternalRep;
 static Tcl_FSDupInternalRepProc VfsDupInternalRep;
 static Tcl_FSListVolumesProc VfsListVolumes;
+static Tcl_FSListMountsProc VfsListMountsInDir;
 
 static Tcl_Filesystem vfsFilesystem = {
     "tclvfs",
@@ -219,7 +227,11 @@ static Tcl_Filesystem vfsFilesystem = {
     &VfsUtime,
     /* We choose not to support symbolic links inside our vfs's */
     NULL,
+#ifdef VFS_COMPILE_WITH_84
     &VfsListVolumes,
+#else
+    &VfsListMountsInDir,
+#endif
     &VfsFileAttrStrings,
     &VfsFileAttrsGet,
     &VfsFileAttrsSet,
@@ -320,12 +332,32 @@ int
 Vfs_Init(interp)
     Tcl_Interp *interp;                /* Interpreter for application. */
 {
-    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
-       return TCL_ERROR;
-    }
-    if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
-       return TCL_ERROR;
+    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+       if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
+           return TCL_ERROR;
+       }
+       if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
+           return TCL_ERROR;
+       }
+       vfsFilesystem.version = TCL_FILESYSTEM_VERSION_1;
+#ifdef VFS_COMPILE_WITH_84
+       vfsFilesystem.listMountsProc = &VfsListVolumes;
+#else
+       vfsFilesystem.listMountsProc = (Tcl_FSListMountsProc*)&VfsListVolumes;
+#endif
+    } else {
+       if (Tcl_PkgRequire(interp, "Tcl", "8.5", 0) == NULL) {
+           return TCL_ERROR;
+       }
+       vfsFilesystem.version = TCL_FILESYSTEM_VERSION_2;
+#ifdef VFS_COMPILE_WITH_84
+       vfsFilesystem.listMountsProc = 
+          (Tcl_FSListVolumesProc*)&VfsListMountsInDir;
+#else
+       vfsFilesystem.listMountsProc = &VfsListMountsInDir;
+#endif
     }
+    
     /* 
      * Safe interpreters are not allowed to modify the filesystem!
      * (Since those modifications will affect other interpreters).
@@ -333,7 +365,8 @@ Vfs_Init(interp)
     if (Tcl_IsSafe(interp)) {
         return TCL_ERROR;
     }
-    if (Tcl_PkgProvide(interp, "vfs", "1.2.1") == TCL_ERROR) {
+    
+    if (Tcl_PkgProvide(interp, "vfs", "1.3.0") == TCL_ERROR) {
         return TCL_ERROR;
     }
 
@@ -666,7 +699,6 @@ Vfs_ListMounts(void)
     Tcl_MutexUnlock(&vfsMountsMutex);
     return res;
 }
-
 \f
 /*
  *----------------------------------------------------------------------
@@ -1759,6 +1791,51 @@ VfsUtime(pathPtr, tval)
     return returnVal;
 }
 
+static Tcl_Obj*
+VfsListMountsInDir(Tcl_Obj *pathPtr)
+{
+    if (pathPtr == NULL) {
+       Tcl_Obj *retVal;
+       
+       Tcl_MutexLock(&vfsVolumesMutex);
+       if (vfsVolumes != NULL) {
+           Tcl_IncrRefCount(vfsVolumes);
+           retVal = vfsVolumes;
+       } else {
+           retVal = NULL;
+       }
+       Tcl_MutexUnlock(&vfsVolumesMutex);
+    
+       return retVal;
+    } else {
+       VfsMount *mountIter;
+       int len;
+       CONST char *prefix;
+       Tcl_Obj *res = Tcl_NewObj();
+
+       prefix = Tcl_GetStringFromObj(Tcl_FSGetNormalizedPath(NULL, pathPtr), 
+                                     &len);
+                                 
+       Tcl_MutexLock(&vfsMountsMutex);
+
+       /* Build list of mounts */
+       mountIter = listOfMounts;
+       while (mountIter != NULL) {
+           if (mountIter->mountLen > (len+1) 
+               && !strncmp(mountIter->mountPoint, prefix, len) 
+               && mountIter->mountPoint[len] == '/'
+               && strchr(mountIter->mountPoint+len+1, '/') == NULL) {
+               Tcl_Obj* mount = Tcl_NewStringObj(mountIter->mountPoint, 
+                                                 mountIter->mountLen);
+               Tcl_ListObjAppendElement(NULL, res, mount);
+           }
+           mountIter = mountIter->nextMount;
+       }
+       Tcl_MutexUnlock(&vfsMountsMutex);
+       return res;
+    }
+}
+
 static Tcl_Obj*
 VfsListVolumes(void)
 {