better vfs interps

diff --git a/doc/vfs.n b/doc/vfs.n
index 7774c53c8c13876a1f166bea3754a4371f1bdfc3..b01876a143f6e992b26bcb9eb601531ac292ec9d 100644 (file)
--- a/doc/vfs.n
+++ b/doc/vfs.n
@@ -62,13 +62,14 @@ declaring to the vfs package that any subdirectories of a given
 \fIpath\fR in the filesystem should be handled by the given \fIcommand\fR
 which should be a Tcl command or procedure.  If the \fI?-volume?\fR
 flag is given, the given mount point is also registered with Tcl as
-a new volume (like a new drive).
+a new volume (like a new drive).  This is useful (and required for
+reasonable operation) for mounts like \fIftp://\fR.  For paths mounted
+inside the native filesystem, it should of course not be given.
 .TP
-\fBvfs::filesystem\fR \fIunmount\fR \fI?-volume?\fR \fIpath\fR 
+\fBvfs::filesystem\fR \fIunmount\fR \fIpath\fR 
 This unmounts the virtual filesystem which was mounted at \fIpath\fR
 hence removing it from Tcl's filesystem, or throws an error if no
-filesystem was mounted there.  The \fI?-volume?\fR flag should be
-given if it was also given when the path was mounted.
+filesystem was mounted there.
 .TP
 \fBvfs::filesystem\fR \fIinfo\fR \fI?path?\fR
 If no arguments are given, this returns a list of all filesystems

diff --git a/generic/vfs.c b/generic/vfs.c
index 9a0de312b1dffb56c43b40a74caf8d8a569fddbb..184c7131607e418305f3c1b7f4662e3a35e26871 100644 (file)
--- a/generic/vfs.c
+++ b/generic/vfs.c
@@ -54,17 +54,17 @@ static Tcl_Obj *vfsVolumes = NULL;
  * To fully specify a file, the string representation is also required.
  */
 
-typedef struct vfsInterpCmd {
+typedef struct Vfs_InterpCmd {
     Tcl_Obj *mountCmd;
     Tcl_Interp *interp;
-} vfsInterpCmd;
+} Vfs_InterpCmd;
 
 typedef struct VfsNativeRep {
     int splitPosition;    /* The index into the string representation
                            * of the file which indicates where the 
                            * vfs filesystem is mounted.
                            */
-    vfsInterpCmd* fsCmd;  /* The Tcl command string which should be
+    Vfs_InterpCmd* fsCmd;  /* The Tcl command string which should be
                            * used to perform all filesystem actions
                            * on this file. */
 } VfsNativeRep;
@@ -172,21 +172,25 @@ static Tcl_Filesystem vfsFilesystem = {
 typedef struct vfsMount {
     CONST char* mountPoint;
     int mountLen;
-    vfsInterpCmd interpCmd;
+    int isVolume;
+    Vfs_InterpCmd interpCmd;
     struct vfsMount* nextMount;
 } vfsMount;
 
 /* And some helper procedures */
 
-static VfsNativeRep*     VfsGetNativePath(Tcl_Obj* pathObjPtr);
-static Tcl_CloseProc     VfsCloseProc;
-static void              VfsExitProc(ClientData clientData);
-static Tcl_Obj*          VfsCommand(Tcl_Interp **iRef, CONST char* cmd, 
-                                   Tcl_Obj * pathPtr);
-static int addMount(Tcl_Obj* mountPoint, Tcl_Interp *interp, Tcl_Obj* mountCmd);
-static int removeMount(Tcl_Obj* mountPoint, Tcl_Interp* interp);
-static vfsInterpCmd* findMount(CONST char* mountPoint);
-static Tcl_Obj* listMounts(void);
+static int             Vfs_AddMount(Tcl_Obj* mountPoint, int isVolume, 
+                       Tcl_Interp *interp, Tcl_Obj* mountCmd);
+static int             Vfs_RemoveMount(Tcl_Obj* mountPoint, Tcl_Interp* interp);
+static Vfs_InterpCmd*  Vfs_FindMount(CONST char* mountPoint);
+static Tcl_Obj*        Vfs_ListMounts(void);
+static void            VfsUnregisterWithInterp _ANSI_ARGS_((ClientData, Tcl_Interp*));
+static void            VfsRegisterWithInterp _ANSI_ARGS_((Tcl_Interp*));
+static VfsNativeRep*   VfsGetNativePath(Tcl_Obj* pathObjPtr);
+static Tcl_CloseProc   VfsCloseProc;
+static void            VfsExitProc(ClientData clientData);
+static Tcl_Obj*        VfsCommand(Tcl_Interp **iRef, CONST char* cmd, 
+                                 Tcl_Obj * pathPtr);
 
 /* 
  * Hard-code platform dependencies.  We do not need to worry 
@@ -201,10 +205,16 @@ static Tcl_Obj* listMounts(void);
 
 static vfsMount* listOfMounts = NULL;
 
-int addMount(Tcl_Obj* mountPoint, Tcl_Interp* interp, Tcl_Obj* mountCmd) {
+int Vfs_AddMount(Tcl_Obj* mountPoint, int isVolume, Tcl_Interp* interp, Tcl_Obj* mountCmd) {
     char *strRep;
     int len;
-    vfsMount *newMount = (vfsMount*) ckalloc(sizeof(vfsMount));
+    vfsMount *newMount;
+    
+    if (mountPoint == NULL || interp == NULL || mountCmd == NULL) {
+        return TCL_ERROR;
+    }
+    
+    newMount = (vfsMount*) ckalloc(sizeof(vfsMount));
     
     if (newMount == NULL) {
         return TCL_ERROR;
@@ -221,28 +231,38 @@ int addMount(Tcl_Obj* mountPoint, Tcl_Interp* interp, Tcl_Obj* mountCmd) {
     strcpy((char*)newMount->mountPoint, strRep);
     newMount->interpCmd.mountCmd = mountCmd;
     newMount->interpCmd.interp = interp;
+    newMount->isVolume = isVolume;
     Tcl_IncrRefCount(mountCmd);
+    if (isVolume) {
+       Vfs_AddVolume(mountPoint);
+    }
+    Tcl_FSMountsChanged(&vfsFilesystem);
     
     newMount->nextMount = listOfMounts;
     listOfMounts = newMount;
     return TCL_OK;
 }
 
-int removeMount(Tcl_Obj* mountPoint, Tcl_Interp *interp) {
-    char *strRep;
-    int len;
+int Vfs_RemoveMount(Tcl_Obj* mountPoint, Tcl_Interp *interp) {
+    /* These two are only used if mountPoint is non-NULL */
+    char *strRep = NULL;
+    int len = 0;
+    
     vfsMount *mountIter;
     /* Set to NULL just to avoid warnings */
     vfsMount *lastMount = NULL;
     
-    strRep = Tcl_GetStringFromObj(mountPoint, &len);
-    
+    if (mountPoint != NULL) {
+       strRep = Tcl_GetStringFromObj(mountPoint, &len);
+    }
+       
     mountIter = listOfMounts;
     
     while (mountIter != NULL) {
-        if (mountIter->mountLen == len && 
-         !strcmp(mountIter->mountPoint, strRep) &&
-         (interp == mountIter->interpCmd.interp)) {
+        if ((interp == mountIter->interpCmd.interp) 
+           && ((mountPoint == NULL) ||
+               (mountIter->mountLen == len && 
+                !strcmp(mountIter->mountPoint, strRep)))) {
            /* We've found the mount. */
            if (mountIter == listOfMounts) {
                listOfMounts = mountIter->nextMount;
@@ -250,9 +270,21 @@ int removeMount(Tcl_Obj* mountPoint, Tcl_Interp *interp) {
                lastMount->nextMount = mountIter->nextMount;
            }
            /* Free the allocated memory */
+           if (mountIter->isVolume) {
+               if (mountPoint == NULL) {
+                   Tcl_Obj *volObj = Tcl_NewStringObj(mountIter->mountPoint, 
+                                                      mountIter->mountLen);
+                   Tcl_IncrRefCount(volObj);
+                   Vfs_RemoveVolume(volObj);
+                   Tcl_DecrRefCount(volObj);
+               } else {
+                   Vfs_RemoveVolume(mountPoint);
+               }
+           }
            ckfree((char*)mountIter->mountPoint);
            Tcl_DecrRefCount(mountIter->interpCmd.mountCmd);
            ckfree((char*)mountIter);
+           Tcl_FSMountsChanged(&vfsFilesystem);
            return TCL_OK;
         }
        lastMount = mountIter;
@@ -261,7 +293,7 @@ int removeMount(Tcl_Obj* mountPoint, Tcl_Interp *interp) {
     return TCL_ERROR;
 }
 
-vfsInterpCmd* findMount(CONST char* mountPoint) {
+Vfs_InterpCmd* Vfs_FindMount(CONST char* mountPoint) {
     vfsMount *mountIter = listOfMounts;
     int len;
     
@@ -281,7 +313,7 @@ vfsInterpCmd* findMount(CONST char* mountPoint) {
     return NULL;
 }
 
-Tcl_Obj* listMounts(void) {
+Tcl_Obj* Vfs_ListMounts(void) {
     vfsMount *mountIter = listOfMounts;
     Tcl_Obj *res = Tcl_NewObj();
 
@@ -329,17 +361,47 @@ Vfs_Init(interp)
     }
 
     /*
-     * Create additional commands.
+     * Create 'vfs::filesystem' command, and interpreter-specific
+     * initialisation.
      */
 
     Tcl_CreateObjCommand(interp, "vfs::filesystem", VfsFilesystemObjCmd, 
-           (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
-    /* Register our filesystem */
-    Tcl_FSRegister((ClientData)NULL, &vfsFilesystem);
-    Tcl_CreateExitHandler(VfsExitProc, (ClientData)NULL);
-
+           (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    VfsRegisterWithInterp(interp);
     return TCL_OK;
 }
+
+void VfsRegisterWithInterp(interp)
+    Tcl_Interp *interp;
+{
+    ClientData vfsAlreadyRegistered;
+    /* 
+     * We need to know if the interpreter is deleted, so we can
+     * remove all interp-specific mounts.
+     */
+    Tcl_SetAssocData(interp, "vfs::inUse", (Tcl_InterpDeleteProc*) 
+                    VfsUnregisterWithInterp, (ClientData) NULL);
+    /* 
+     * Perform one-off registering of our filesystem if that
+     * has not happened before.
+     */
+    vfsAlreadyRegistered = Tcl_FSData(&vfsFilesystem);
+    if (vfsAlreadyRegistered == NULL) {
+       Tcl_FSRegister((ClientData)1, &vfsFilesystem);
+       Tcl_CreateExitHandler(VfsExitProc, (ClientData)NULL);
+    }
+}
+   
+void VfsUnregisterWithInterp(dummy, interp)
+    ClientData dummy;
+    Tcl_Interp *interp;
+{
+    int res = TCL_OK;
+    /* Remove all of this interpreters mount points */
+    while (res == TCL_OK) {
+        res = Vfs_RemoveMount(NULL, interp);
+    }
+}
 \f
 /*
  *----------------------------------------------------------------------
@@ -387,7 +449,6 @@ VfsFilesystemObjCmd(dummy, interp, objc, objv)
 
     switch ((enum options) index) {
        case VFS_MOUNT: {
-           Tcl_Obj * path;
            int i;
            if (objc < 4 || objc > 5) {
                Tcl_WrongNumArgs(interp, 1, objv, "mount ?-volume? path cmd");
@@ -402,16 +463,13 @@ VfsFilesystemObjCmd(dummy, interp, objc, objv)
                    return TCL_ERROR;
                }
                i = 3;
-               Vfs_AddVolume(objv[i]);
+               return Vfs_AddMount(objv[i], 1, interp, objv[i+1]);
            } else {
+               Tcl_Obj *path;
                i = 2;
+               path = Tcl_FSGetNormalizedPath(interp, objv[i]);
+               return Vfs_AddMount(path, 0, interp, objv[i+1]);
            }
-           path = Tcl_FSGetNormalizedPath(interp, objv[i]);
-           if (addMount(path, interp, objv[i+1]) == TCL_ERROR) {
-               return TCL_ERROR;
-           }
-           Tcl_FSMountsChanged(&vfsFilesystem);
-           return TCL_OK;
            break;
        }
        case VFS_INFO: {
@@ -420,49 +478,41 @@ VfsFilesystemObjCmd(dummy, interp, objc, objv)
                return TCL_ERROR;
            }
            if (objc == 2) {
-               Tcl_SetObjResult(interp, listMounts());
+               Tcl_SetObjResult(interp, Vfs_ListMounts());
            } else {
-               Tcl_Obj * path;
-               vfsInterpCmd *val;
+               Vfs_InterpCmd *val;
                
-               path = Tcl_FSGetNormalizedPath(interp, objv[2]);
-               val = findMount(Tcl_GetString(path));
+               val = Vfs_FindMount(Tcl_GetString(objv[2]));
                if (val == NULL) {
-                   return TCL_ERROR;
+                   Tcl_Obj *path = Tcl_FSGetNormalizedPath(interp, objv[2]);
+                   val = Vfs_FindMount(Tcl_GetString(path));
+                   if (val == NULL) {
+                       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                               "no such mount \"", Tcl_GetString(objv[2]), 
+                               "\"", (char *) NULL);
+                       return TCL_ERROR;
+                   }
                }
                Tcl_SetObjResult(interp, val->mountCmd);
            }
            break;
        }
        case VFS_UNMOUNT: {
-           Tcl_Obj * path;
-           int res, i;
-           if (objc < 3 || objc > 4) {
-               Tcl_WrongNumArgs(interp, 2, objv, "?-volume? path");
+           if (objc != 3) {
+               Tcl_WrongNumArgs(interp, 2, objv, "path");
                return TCL_ERROR;
            }
-           if (objc == 4) {
-               char *option = Tcl_GetString(objv[2]);
-               if (strcmp("-volume", option)) {
+           if (Vfs_RemoveMount(objv[2], interp) == TCL_ERROR) {
+               Tcl_Obj * path;
+               path = Tcl_FSGetNormalizedPath(interp, objv[2]);
+               if (Vfs_RemoveMount(path, interp) == TCL_ERROR) {
                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-                           "bad option \"", option,
-                           "\": must be -volume", (char *) NULL);
+                           "no such mount \"", Tcl_GetString(objv[2]), 
+                           "\"", (char *) NULL);
                    return TCL_ERROR;
                }
-               i = 3;
-           } else {
-               i = 2;
-           }
-           path = Tcl_FSGetNormalizedPath(interp, objv[i]);
-           res = removeMount(path, interp);
-
-           if (res == TCL_OK) {
-               if (i == 3) {
-                   Vfs_RemoveVolume(objv[i]);
-               }
-               Tcl_FSMountsChanged(&vfsFilesystem);
            }
-           return res;
+           return TCL_OK;
        }
     }
     return TCL_OK;
@@ -476,7 +526,7 @@ VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
     char remember = '\0';
     char *normed;
     VfsNativeRep *nativeRep;
-    vfsInterpCmd *interpCmd = NULL;
+    Vfs_InterpCmd *interpCmd = NULL;
     
     if (TclInExit()) {
        /* 
@@ -502,7 +552,7 @@ VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
      * checks here.
      */
     while (interpCmd == NULL) {
-       interpCmd = findMount(normed);
+       interpCmd = Vfs_FindMount(normed);
        if (interpCmd != NULL) break;
 
        if (splitPosition != len) {
@@ -520,7 +570,7 @@ VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
        if ((splitPosition > 0) && (splitPosition != len)) {
            remember = normed[splitPosition + 1];
            normed[splitPosition+1] = '\0';
-           interpCmd = findMount(normed);
+           interpCmd = Vfs_FindMount(normed);
                                     
            if (interpCmd != NULL) {
                splitPosition++;
@@ -1352,4 +1402,3 @@ void VfsExitProc(ClientData clientData)
        vfsVolumes = NULL;
     }
 }
-

diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl
index f2f2b5789dab07c062ac2144bbf95e5316141193..32250ad6003d062e375dd0e2328e6d1e329ef31c 100644 (file)
--- a/library/pkgIndex.tcl
+++ b/library/pkgIndex.tcl
@@ -1,12 +1,11 @@
 # Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script.  It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands.  When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
+# This file was generated by hand.
+# 
+# It invokes the "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically in response
+# to "package require" commands.  When this script is sourced, the
+# variable $dir must contain the full path name of this file's
+# directory.
 
 package require Tcl 8.4
 if {[info tclversion] == 8.4} {
@@ -15,7 +14,10 @@ if {[info tclversion] == 8.4} {
     }
 }
 
-lappend auto_path $dir
+if {[lsearch -exact $auto_path $dir] == -1} {
+    lappend auto_path $dir
+}
+
 if {[info exists tcl_platform(debug)]} {
     package ifneeded vfs 1.0 [list load [file join $dir vfs10d[info sharedlibextension]]]
 } else {

diff --git a/library/vfsUrl.tcl b/library/vfsUrl.tcl
index 49d45eb2d9b843cdb7e19037cc05fcced552d7dc..b5a65178a14a3781cb811f87b3e0c079ea0318a6 100644 (file)
--- a/library/vfsUrl.tcl
+++ b/library/vfsUrl.tcl
@@ -24,7 +24,7 @@ proc vfs::urltype::Mount {type} {
 
 proc vfs::urltype::Unmount {type} {
     set mountPoint [_typeToMount $type]
-    ::vfs::filesystem unmount -volume $mountPoint
+    ::vfs::filesystem unmount $mountPoint
 }
 
 proc vfs::urltype::_typeToMount {type} {

diff --git a/tests/vfs.test b/tests/vfs.test
index 94d88bbc99d742a5d34e3e889e3f0d042eb2df7c..959194a498d5d76526e882aab245861ba89cb9e4 100644 (file)
--- a/tests/vfs.test
+++ b/tests/vfs.test
@@ -19,12 +19,12 @@ package require vfs
 
 test vfs-1.1 {mount unmount} {
     vfs::filesystem mount foo bar
-    set res [list [catch {vfs::filesystem unmount foo bar blah} err]]
+    set res [list [catch {vfs::filesystem unmount foo bar} err]]
     lappend res $err
     vfs::filesystem unmount foo
     unset err
     set res
-} {1 {wrong # args: should be "vfs::filesystem unmount ?-volume? path"}}
+} {1 {wrong # args: should be "vfs::filesystem unmount path"}}
 
 # cleanup
 ::tcltest::cleanupTests