From 10363f533bd5e1381d878f9aa7acf2c438d7763d Mon Sep 17 00:00:00 2001 From: Vince Darley Date: Sat, 11 Aug 2001 18:02:06 +0000 Subject: [PATCH] docs and leaks fixed --- doc/vfs.n | 27 +++++++------ generic/vfs.c | 103 +++++++++++++++++++++++++++++++++----------------- 2 files changed, 83 insertions(+), 47 deletions(-) diff --git a/doc/vfs.n b/doc/vfs.n index e1dccbd..a0eeafc 100644 --- a/doc/vfs.n +++ b/doc/vfs.n @@ -94,33 +94,36 @@ Note that most filesystem operations will only require the \fIrelative\fR argument to work correctly, but the other arguments are actually required for correct operation of some subcommands. .PP -The actual commands are as follows: +The actual commands are as follows (where \fIr-r-a\fR represents the +standard argument triplet of \fIroot\fR, \fIrelative\fR and +\fIactualpath\fR): .TP -\fI...\fR \fIaccess\fR \fIr-r-a\fR \fImode\fR +\fIcommand\fR \fIaccess\fR \fIr-r-a\fR \fImode\fR Return 1 or throw an error depending on whether the given access mode (which is an integer) is compatible with the file. .TP -\fI...\fR \fIcreatedirectory\fR \fIr-r-a\fR +\fIcommand\fR \fIcreatedirectory\fR \fIr-r-a\fR Create a directory with the given name. .TP -\fI...\fR \fIdeletefile\fR \fIr-r-a\fR +\fIcommand\fR \fIdeletefile\fR \fIr-r-a\fR Delete the given file. .TP -\fI...\fR \fIfileattributes\fR \fIr-r-a\fR \fI?index?\fR \fI?value?\fR +\fIcommand\fR \fIfileattributes\fR \fIr-r-a\fR \fI?index?\fR \fI?value?\fR If neither index nor value is given, then return a list of all -acceptable attribute values. If \fIindex\fR is given, but no value, -then retrieve the value of the \fIindex\fR'th attribute for the given +acceptable attribute names. If \fIindex\fR is given, but no value, +then retrieve the value of the \fIindex\fR'th attribute (counting in +order over the list returned when no argument is given) for the given file. If a value is also given then set the \fIindex\fR'th attribute of the given file to that value. .TP -\fI...\fR \fImatchindirectory\fR \fIr-r-a\fR \fIpattern\fR \fItypes\fR +\fIcommand\fR \fImatchindirectory\fR \fIr-r-a\fR \fIpattern\fR \fItypes\fR Return the list of files or directories in the given path (which is always the name of an existing directory), which match the \fIpattern\fR and are compatible with the \fItypes\fR given. It is very important that the command correctly handle \fItypes\fR requests for directories only (and files only). .TP -\fI...\fR \fIopen\fR \fIr-r-a\fR \fImode\fR \fIpermissions\fR +\fIcommand\fR \fIopen\fR \fIr-r-a\fR \fImode\fR \fIpermissions\fR For this command, \fImode\fR is a list of POSIX open modes or a string such as "rw". If the open involves creating a file, then \fIpermissions\fR dictates what modes to create it with. If the @@ -131,10 +134,10 @@ The second item, if given, is a Tcl-callback to be used when the channel is closed, so that the vfs can clean up as appropriate. If the open operation was not successful, an error should be thrown. .TP -\fI...\fR \fIremovedirectory\fR \fIr-r-a\fR +\fIcommand\fR \fIremovedirectory\fR \fIr-r-a\fR Delete the given directory. .TP -\fI...\fR \fIstat\fR \fIr-r-a\fR +\fIcommand\fR \fIstat\fR \fIr-r-a\fR Return a list of even length containing field-name and value pairs for the contents of a stat structure. The order is not important. The option names are dev (long), ino (long), mode (int), nlink (long), @@ -144,7 +147,7 @@ type of each argument is given in brackets. The procedure should therefore return with something like \fIreturn [list dev 0 type file mtime 1234 ...]\fR. .TP -\fI...\fR \fIutime\fR \fIr-r-a\fR \fIactime\fR \fImtime\fR +\fIcommand\fR \fIutime\fR \fIr-r-a\fR \fIactime\fR \fImtime\fR Set the access and modification times of the given file (these are read with 'stat'). diff --git a/generic/vfs.c b/generic/vfs.c index ca4b499..96aee88 100644 --- a/generic/vfs.c +++ b/generic/vfs.c @@ -6,7 +6,7 @@ * virtual file system support, and therefore allows * vfs's to be implemented in Tcl. * - * Copyright (c) Vince Darley. + * Copyright (c) 2001 Vince Darley. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -33,12 +33,18 @@ EXTERN int Vfs_Init _ANSI_ARGS_((Tcl_Interp*)); /* - * Native representation for a path in a Tcl vfs. + * Structure used for the native representation of a path in a Tcl vfs. + * To fully specify a file, the string representation is also required. */ typedef struct VfsNativeRep { - int splitPosition; - Tcl_Obj* fsCmd; + int splitPosition; /* The index into the string representation + * of the file which indicates where the + * vfs filesystem is mounted. + */ + Tcl_Obj* fsCmd; /* The Tcl command string which should be + * used to perform all filesystem actions + * on this file. */ } VfsNativeRep; /* @@ -46,12 +52,24 @@ typedef struct VfsNativeRep { * a channel that we can properly clean up all resources * when the channel is closed. This is required when using * 'open' on things inside the vfs. + * + * When the channel in question is begin closed, we will + * temporarily register the channel with the given interpreter, + * evaluate the closeCallBack, and then detach the channel + * from the interpreter and return (allowing Tcl to continue + * closing the channel as normal). + * + * Nothing in the callback can prevent the channel from + * being closed. */ typedef struct VfsChannelCleanupInfo { - Tcl_Channel channel; - Tcl_Obj* closeCallback; - Tcl_Interp* interp; + Tcl_Channel channel; /* The channel which needs cleaning up */ + Tcl_Obj* closeCallback; /* The Tcl command string to evaluate + * when the channel is closing, which will + * carry out any cleanup that is necessary. */ + Tcl_Interp* interp; /* The interpreter in which to evaluate the + * cleanup operation. */ } VfsChannelCleanupInfo; @@ -64,7 +82,7 @@ static int VfsFilesystemObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Obj *CONST objv[])); /* - * Now we define the filesystem + * Now we define the virtual filesystem callbacks */ static Tcl_FSStatProc VfsStat; @@ -201,9 +219,8 @@ Vfs_Init(interp) * VfsFilesystemObjCmd -- * * This procedure implements the "vfs::filesystem" command. It is - * used to (un)register the vfs filesystem, and to mount/unmount - * particular interfaces to new filesystems, or to query for - * what is mounted where. + * used to mount/unmount particular interfaces to new filesystems, + * or to query for what is mounted where. * * Results: * A standard Tcl result. @@ -386,6 +403,10 @@ VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) { return TCL_OK; } +/* + * Simple helper function to extract the native vfs representation of a + * path object, or NULL if no such representation exists. + */ VfsNativeRep* VfsGetNativePath(Tcl_Obj* pathObjPtr) { return (VfsNativeRep*) Tcl_FSGetInternalRep(pathObjPtr, &vfsFilesystem); @@ -615,8 +636,8 @@ VfsOpenFileChannel(cmdInterp, pathPtr, modeString, permissions) * it? */ { Tcl_Channel chan = NULL; - VfsChannelCleanupInfo *channelRet = NULL; Tcl_Obj *mountCmd = NULL; + Tcl_Obj *closeCallback = NULL; Tcl_SavedResult savedResult; int returnVal; Tcl_Interp* interp; @@ -647,23 +668,16 @@ VfsOpenFileChannel(cmdInterp, pathPtr, modeString, permissions) returnVal = TCL_ERROR; } else { Tcl_Obj *element; - Tcl_Channel theChannel = NULL; Tcl_ListObjIndex(interp, resultObj, 0, &element); - theChannel = Tcl_GetChannel(interp, Tcl_GetString(element), 0); + chan = Tcl_GetChannel(interp, Tcl_GetString(element), 0); - if (theChannel == NULL) { + if (chan == NULL) { returnVal == TCL_ERROR; } else { - channelRet = (VfsChannelCleanupInfo*) - ckalloc(sizeof(VfsChannelCleanupInfo)); - channelRet->channel = theChannel; - channelRet->interp = interp; if (reslen == 2) { Tcl_ListObjIndex(interp, resultObj, 1, &element); - channelRet->closeCallback = element; - Tcl_IncrRefCount(channelRet->closeCallback); - } else { - channelRet->closeCallback = NULL; + closeCallback = element; + Tcl_IncrRefCount(closeCallback); } } } @@ -701,22 +715,25 @@ VfsOpenFileChannel(cmdInterp, pathPtr, modeString, permissions) Tcl_DecrRefCount(mountCmd); - if (channelRet != NULL) { + if (chan != NULL) { /* - * This is a pain. We got the Channel from some Tcl code. - * This means it was registered with the interpreter. But we - * want a pristine channel which hasn't been registered with - * anyone. We use Tcl_DetachChannel to do this for us. + * We got the Channel from some Tcl code. This means it was + * registered with the interpreter. But we want a pristine + * channel which hasn't been registered with anyone. We use + * Tcl_DetachChannel to do this for us. We must use the + * correct interpreter. */ - chan = channelRet->channel; - /* We must use the correct interpreter */ Tcl_DetachChannel(interp, chan); - if (channelRet->closeCallback != NULL) { - Tcl_CreateCloseHandler(chan, &VfsCloseProc, (ClientData)channelRet); + if (closeCallback != NULL) { + VfsChannelCleanupInfo *channelRet = NULL; + channelRet = (VfsChannelCleanupInfo*) + ckalloc(sizeof(VfsChannelCleanupInfo)); + channelRet->channel = chan; + channelRet->interp = interp; + channelRet->closeCallback = closeCallback; /* The channelRet structure will be freed in the callback */ - } else { - ckfree((char*)channelRet); + Tcl_CreateCloseHandler(chan, &VfsCloseProc, (ClientData)channelRet); } } return chan; @@ -726,6 +743,15 @@ VfsOpenFileChannel(cmdInterp, pathPtr, modeString, permissions) * IMPORTANT: This procedure must *not* modify the interpreter's result * this leads to the objResultPtr being corrupted (somehow), and curious * crashes in the future (which are very hard to debug ;-). + * + * This is particularly important since we are evaluating arbitrary + * Tcl code in the callback. + * + * Also note we are relying on the close-callback to occur just before + * the channel is about to be properly closed, but after all output + * has been flushed. That way we can, in the callback, read in the + * entire contents of the channel and, say, compress it for storage + * into a tclkit or zip archive. */ void VfsCloseProc(ClientData clientData) { @@ -799,11 +825,14 @@ VfsMatchInDirectory( if (vfsResultPtr != NULL) { if (returnVal == TCL_OK) { + Tcl_IncrRefCount(vfsResultPtr); Tcl_ListObjAppendList(cmdInterp, returnPtr, vfsResultPtr); + Tcl_DecrRefCount(vfsResultPtr); } else { Tcl_SetObjResult(cmdInterp, vfsResultPtr); } } + return returnVal; } @@ -888,6 +917,7 @@ VfsRemoveDirectory( /* Assume there was a problem with the directory being non-empty */ if (errorPtr != NULL) { *errorPtr = pathPtr; + Tcl_IncrRefCount(*errorPtr); } Tcl_SetErrno(EEXIST); } @@ -956,7 +986,10 @@ VfsFileAttrsGet(cmdInterp, index, pathPtr, objPtrRef) if (returnVal != -1) { if (returnVal == TCL_OK) { - Tcl_IncrRefCount(*objPtrRef); + /* + * Our caller expects a ref count of zero in + * the returned object pointer. + */ } else { /* Leave error message in correct interp */ Tcl_SetObjResult(cmdInterp, *objPtrRef); -- 2.23.0