From 266b11e5cca3940dd8531fcbadd6e4e92a5d482c Mon Sep 17 00:00:00 2001 From: Vince Darley Date: Thu, 8 Nov 2001 10:38:43 +0000 Subject: [PATCH] better vfs interps --- doc/vfs.n | 9 +- generic/vfs.c | 191 +++++++++++++++++++++++++++---------------- library/pkgIndex.tcl | 20 +++-- library/vfsUrl.tcl | 2 +- tests/vfs.test | 4 +- 5 files changed, 139 insertions(+), 87 deletions(-) diff --git a/doc/vfs.n b/doc/vfs.n index 7774c53..b01876a 100644 --- 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 9a0de31..184c713 100644 --- 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); + } +} /* *---------------------------------------------------------------------- @@ -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 f2f2b57..32250ad 100644 --- 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 49d45eb..b5a6517 100644 --- 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 94d88bb..959194a 100644 --- 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 -- 2.23.0