diff options
Diffstat (limited to 'generic/tclIOUtil.c')
| -rw-r--r-- | generic/tclIOUtil.c | 238 |
1 files changed, 186 insertions, 52 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 2406215..96a33f8 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.17 2001/08/30 08:53:14 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.18 2001/09/04 18:06:34 vincentdarley Exp $ */ #include "tclInt.h" @@ -41,11 +41,14 @@ static int TclNormalizeToUniquePath static int SetFsPathFromAbsoluteNormalized _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static int FindSplitPos _ANSI_ARGS_((char *path, char *separator)); -static Tcl_Filesystem* Tcl_FSGetFileSystemForPath - _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); +static Tcl_PathType FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, + Tcl_Filesystem **filesystemPtrPtr, + int *driveNameLengthPtr)); static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); +static int CrossFilesystemCopy _ANSI_ARGS_((Tcl_Obj *source, + Tcl_Obj *target)); /* * Define the 'path' object type, which Tcl uses to represent @@ -244,7 +247,7 @@ typedef struct FilesystemRecord { * filesystem (can be NULL) */ Tcl_Filesystem *fsPtr; /* Pointer to filesystem dispatch * table. */ - int refCount; /* How many Tcl_Obj's use this + int fileRefCount; /* How many Tcl_Obj's use this * filesystem. */ struct FilesystemRecord *nextPtr; /* The next filesystem registered @@ -337,7 +340,6 @@ static Tcl_Filesystem nativeFilesystem = { &TclpObjRenameFile, &TclpObjCopyDirectory, &TclpLoadFile, - &TclpUnloadFile, &TclpObjGetCwd, &TclpObjChdir }; @@ -534,7 +536,11 @@ Tcl_FSRegister(clientData, fsPtr) newFilesystemPtr->clientData = clientData; newFilesystemPtr->fsPtr = fsPtr; - newFilesystemPtr->refCount = 0; + /* + * We start with a refCount of 1. If this drops to zero, then + * anyone is welcome to ckfree us. + */ + newFilesystemPtr->fileRefCount = 1; /* * Is this lock and wait strictly speaking necessary? Since any @@ -624,8 +630,11 @@ Tcl_FSUnregister(fsPtr) * lead to memory exceptions). */ filesystemEpoch++; - - ckfree((char *)tmpFsRecPtr); + + tmpFsRecPtr->fileRefCount--; + if (tmpFsRecPtr->fileRefCount <= 0) { + ckfree((char *)tmpFsRecPtr); + } retVal = TCL_OK; } else { @@ -862,7 +871,7 @@ TclNormalizeToUniquePath(interp, pathPtr) /* * We could add an efficiency check like this: * - * if (retVal == Tcl_DStringLength(pathPtr)) {break;} + * if (retVal == length-of(pathPtr)) {break;} * * but there's not much benefit. */ @@ -1563,7 +1572,7 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { - Tcl_SetResult(interp, "glob couldn't determine" + Tcl_SetResult(interp, "glob couldn't determine " "the current working directory", TCL_STATIC); } return TCL_ERROR; @@ -1909,9 +1918,8 @@ NativeFileAttrsGet(interp, index, fileName, objPtrRef) Tcl_Obj *fileName; /* filename we are operating on. */ Tcl_Obj **objPtrRef; /* for output. */ { - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, fileName); return (*tclpFileAttrProcs[index].getProc)(interp, index, - transPtr, objPtrRef); + fileName, objPtrRef); } /* @@ -1941,9 +1949,8 @@ NativeFileAttrsSet(interp, index, fileName, objPtr) Tcl_Obj *fileName; /* filename we are operating on. */ Tcl_Obj *objPtr; /* set to this value. */ { - Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, fileName); return (*tclpFileAttrProcs[index].setProc)(interp, index, - transPtr, objPtr); + fileName, objPtr); } /* @@ -2186,19 +2193,15 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc; if (proc != NULL) { int retVal = (*proc)(interp, pathPtr, sym1, sym2, - proc1Ptr, proc2Ptr, clientDataPtr); - if (retVal != -1) { - /* - * We handled it. Remember which unload file - * proc to use. - */ - (*unloadProcPtr) = fsPtr->unloadFileProc; - } + proc1Ptr, proc2Ptr, clientDataPtr, + unloadProcPtr); return retVal; } else { Tcl_Filesystem *copyFsPtr; - /* Get a temporary filename to use, first to - * copy the file into, and then to load. */ + /* + * Get a temporary filename to use, first to + * copy the file into, and then to load. + */ Tcl_Obj *copyToPtr = TclpTempFileName(); if (copyToPtr == NULL) { return -1; @@ -2207,14 +2210,16 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr); if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) { - /* We already know we can't use Tcl_FSLoadFile from + /* + * We already know we can't use Tcl_FSLoadFile from * this filesystem, and we must avoid a possible - * infinite loop. */ + * infinite loop. + */ Tcl_DecrRefCount(copyToPtr); return -1; } - if (Tcl_FSCopyFile(pathPtr, copyToPtr) == 0) { + if (CrossFilesystemCopy(pathPtr, copyToPtr) == TCL_OK) { /* * Do we need to set appropriate permissions * on the file? This may be required on some @@ -2427,6 +2432,31 @@ Tcl_FSListVolumes(void) * Tcl_FSGetPathType -- * * Determines whether a given path is relative to the current + * directory, relative to the current volume, or absolute. + * + * Results: + * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or + * TCL_PATH_VOLUME_RELATIVE. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_PathType +Tcl_FSGetPathType(pathObjPtr) + Tcl_Obj *pathObjPtr; +{ + return FSGetPathType(pathObjPtr, NULL, NULL); +} + +/* + *---------------------------------------------------------------------- + * + * FSGetPathType -- + * + * Determines whether a given path is relative to the current * directory, relative to the current volume, or absolute. If the * caller wishes to know which filesystem claimed the path (in the * case for which the path is absolute), then a reference to a @@ -2445,20 +2475,22 @@ Tcl_FSListVolumes(void) *---------------------------------------------------------------------- */ -Tcl_PathType -Tcl_FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) +static Tcl_PathType +FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) Tcl_Obj *pathObjPtr; Tcl_Filesystem **filesystemPtrPtr; int *driveNameLengthPtr; { if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { - return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); + return GetPathType(pathObjPtr, filesystemPtrPtr, + driveNameLengthPtr, NULL); } else { FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (fsPathPtr->cwdPtr != NULL) { return TCL_PATH_RELATIVE; } else { - return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); + return GetPathType(pathObjPtr, filesystemPtrPtr, + driveNameLengthPtr, NULL); } } } @@ -2469,13 +2501,9 @@ Tcl_FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) * Tcl_FSSplitPath -- * * This function takes the given Tcl_Obj, which should be a valid - * path, and returns a Tcl List object containing each segment - * of that path as an element. + * path, and returns a Tcl List object containing each segment of + * that path as an element. * - * Note this function currently calls the older Split(Plat)Path - * functions, which require more memory allocation than is - * desirable. - * * Results: * Returns list object with refCount of zero. If the passed in * lenPtr is non-NULL, we use it to return the number of elements @@ -2502,7 +2530,7 @@ Tcl_FSSplitPath(pathPtr, lenPtr) * Perform platform specific splitting. */ - if (Tcl_FSGetPathType(pathPtr, &fsPtr, &driveNameLength) + if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength) == TCL_PATH_ABSOLUTE) { if (fsPtr == &nativeFilesystem) { return TclpNativeSplitPath(pathPtr, lenPtr); @@ -2574,11 +2602,6 @@ Tcl_FSSplitPath(pathPtr, lenPtr) * first 'elements' elements as valid path segments. If elements < 0, * we use the entire list. * - * Note this function currently calls the older Tcl_JoinPath - * routine, which therefore requires more memory allocation and - * deallocation than necessary. We could easily rewrite this for - * greater efficiency. - * * Results: * Returns object with refCount of zero. * @@ -2710,7 +2733,7 @@ Tcl_FSJoinPath(listObj, elements) * * GetPathType -- * - * Helper function used by Tcl_FSGetPathType. + * Helper function used by FSGetPathType. * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or @@ -2817,7 +2840,8 @@ GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) FsReleaseIterator(); if (type != TCL_PATH_ABSOLUTE) { - type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef); + type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, + driveNameRef); if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { *filesystemPtrPtr = &nativeFilesystem; } @@ -2904,12 +2928,80 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr) if (retVal == -1) { Tcl_SetErrno(EXDEV); } + if ((retVal != TCL_OK) && (errno == EXDEV)) { + retVal = CrossFilesystemCopy(srcPathPtr, destPathPtr); + } return retVal; } /* *--------------------------------------------------------------------------- * + * CrossFilesystemCopy -- + * + * Helper for above function, and for Tcl_FSLoadFile, to copy + * files from one filesystem to another. This function will + * overwrite the target file if it already exists. + * + * Results: + * Standard Tcl error code. + * + * Side effects: + * A file may be created. + * + *--------------------------------------------------------------------------- + */ +static int +CrossFilesystemCopy(source, target) + Tcl_Obj *source; /* Pathname of file to be copied (UTF-8). */ + Tcl_Obj *target; /* Pathname of file to copy to (UTF-8). */ +{ + int result = TCL_ERROR; + int prot = 0666; + + Tcl_Channel out = Tcl_FSOpenFileChannel(NULL, target, "w", prot); + if (out != NULL) { + /* It looks like we can copy it over */ + Tcl_Channel in = Tcl_FSOpenFileChannel(NULL, source, + "r", prot); + if (in == NULL) { + /* This is very strange, we checked this above */ + Tcl_Close(NULL, out); + } else { + struct stat sourceStatBuf; + struct utimbuf tval; + /* + * Copy it synchronously. We might wish to add an + * asynchronous option to support vfs's which are + * slow (e.g. network sockets). + */ + Tcl_SetChannelOption(NULL, in, "-translation", "binary"); + Tcl_SetChannelOption(NULL, out, "-translation", "binary"); + + if (TclCopyChannel(NULL, in, out, -1, NULL) == TCL_OK) { + result = TCL_OK; + } + /* + * If the copy failed, assume that copy channel left + * a good error message. + */ + Tcl_Close(NULL, in); + Tcl_Close(NULL, out); + + /* Set modification date of copied file */ + if (Tcl_FSLstat(source, &sourceStatBuf) != 0) { + tval.actime = sourceStatBuf.st_atime; + tval.modtime = sourceStatBuf.st_mtime; + Tcl_FSUtime(source, &tval); + } + } + } + return result; +} + +/* + *--------------------------------------------------------------------------- + * * Tcl_FSDeleteFile -- * * The appropriate function for the filesystem to which pathPtr @@ -2972,7 +3064,7 @@ Tcl_FSCreateDirectory(pathPtr) /* *--------------------------------------------------------------------------- * - * Tcl_FSRenameFile -- + * Tcl_FSCopyDirectory -- * * If the two paths given belong to the same filesystem, we call * that filesystems copy-directory function. Otherwise we simply @@ -3045,6 +3137,33 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr) if (fsPtr != NULL) { Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc; if (proc != NULL) { + if (recursive) { + /* + * We check whether the cwd lies inside this directory + * and move it if it does. + */ + Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); + if (cwdPtr != NULL) { + char *cwdStr, *normPathStr; + int cwdLen, normLen; + Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); + if (normPath != NULL) { + normPathStr = Tcl_GetStringFromObj(normPath, &normLen); + cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen); + if ((cwdLen >= normLen) && (strncmp(normPathStr, + cwdStr, (size_t) normLen) == 0)) { + /* + * the cwd is inside the directory, so we + * perform a 'cd [file dirname $path]' + */ + Tcl_Obj *dirPtr = TclFileDirname(NULL, pathPtr); + Tcl_FSChdir(dirPtr); + Tcl_DecrRefCount(dirPtr); + } + } + Tcl_DecrRefCount(cwdPtr); + } + } return (*proc)(pathPtr, recursive, errorPtr); } } @@ -3449,7 +3568,11 @@ FreeFsPathInternalRep(pathObjPtr) } } if (fsPathPtr->fsRecPtr != NULL) { - fsPathPtr->fsRecPtr->refCount--; + fsPathPtr->fsRecPtr->fileRefCount--; + if (fsPathPtr->fsRecPtr->fileRefCount <= 0) { + /* It has been unregistered already */ + ckfree((char *)fsPathPtr->fsRecPtr); + } } ckfree((char*) fsPathPtr); @@ -3506,7 +3629,7 @@ DupFsPathInternalRep(srcPtr, copyPtr) copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; if (copyFsPathPtr->fsRecPtr != NULL) { - copyFsPathPtr->fsRecPtr->refCount++; + copyFsPathPtr->fsRecPtr->fileRefCount++; } copyPtr->typePtr = &tclFsPathType; @@ -3633,7 +3756,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * action, which might loop back through here. */ if ((path[0] != '\0') && - (Tcl_FSGetPathType(pathObjPtr, NULL, NULL) == TCL_PATH_RELATIVE)) { + (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) { Tcl_Obj *cwd = Tcl_FSGetCwd(interp); if (cwd == NULL) { @@ -3749,6 +3872,17 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) } if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { + /* + * There is still one possibility we should consider; if the + * file belongs to a different filesystem, perhaps it is + * actually linked through to a file in our own filesystem + * which we do care about. The way we can check for this + * is we ask what filesystem this path belongs to. + */ + Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr); + if (actualFs == fsPtr) { + return Tcl_FSGetInternalRep(pathObjPtr, fsPtr); + } return NULL; } @@ -4129,7 +4263,7 @@ NativeFilesystemPathType(pathObjPtr) * as a valid file path, then NULL is returned. * * Results: - * NULL or a filesystem which will accept this path. +.* NULL or a filesystem which will accept this path. * * Side effects: * The object may be converted to a path type. @@ -4137,7 +4271,7 @@ NativeFilesystemPathType(pathObjPtr) *--------------------------------------------------------------------------- */ -static Tcl_Filesystem* +Tcl_Filesystem* Tcl_FSGetFileSystemForPath(pathObjPtr) Tcl_Obj* pathObjPtr; { @@ -4213,7 +4347,7 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) srcFsPathPtr->fsRecPtr = fsRecPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = filesystemEpoch; - fsRecPtr->refCount++; + fsRecPtr->fileRefCount++; retVal = fsRecPtr->fsPtr; } } |