summaryrefslogtreecommitdiffstats
path: root/generic/tclIOUtil.c
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2001-09-04 18:06:34 (GMT)
committervincentdarley <vincentdarley>2001-09-04 18:06:34 (GMT)
commit6fca271a5115b8b8e94f10dce8efb41fcedb53a9 (patch)
treefe242e0e386c2472085adf41540fa813c334a000 /generic/tclIOUtil.c
parentbaf84f971d4274324372aab6f0fd968c63d7dcd4 (diff)
downloadtcl-6fca271a5115b8b8e94f10dce8efb41fcedb53a9.zip
tcl-6fca271a5115b8b8e94f10dce8efb41fcedb53a9.tar.gz
tcl-6fca271a5115b8b8e94f10dce8efb41fcedb53a9.tar.bz2
minor fs, vfs fixes
Diffstat (limited to 'generic/tclIOUtil.c')
-rw-r--r--generic/tclIOUtil.c238
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;
}
}