summaryrefslogtreecommitdiffstats
path: root/generic/tclIOUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIOUtil.c')
-rw-r--r--generic/tclIOUtil.c3224
1 files changed, 1663 insertions, 1561 deletions
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 8dfd7f5..da0fc8f 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1,28 +1,28 @@
-/*
+/*
* tclIOUtil.c --
*
- * This file contains the implementation of Tcl's generic
- * filesystem code, which supports a pluggable filesystem
- * architecture allowing both platform specific filesystems and
- * 'virtual filesystems'. All filesystem access should go through
- * the functions defined in this file. Most of this code was
- * contributed by Vince Darley.
+ * This file contains the implementation of Tcl's generic filesystem
+ * code, which supports a pluggable filesystem architecture allowing both
+ * platform specific filesystems and 'virtual filesystems'. All
+ * filesystem access should go through the functions defined in this
+ * file. Most of this code was contributed by Vince Darley.
*
- * Parts of this file are based on code contributed by Karl
- * Lehenbauer, Mark Diekhans and Peter da Silva.
+ * Parts of this file are based on code contributed by Karl Lehenbauer,
+ * Mark Diekhans and Peter da Silva.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2001-2004 Vincent Darley.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * 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.119 2005/05/23 20:19:44 das Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.120 2005/07/17 21:17:42 dkf Exp $
*/
#include "tclInt.h"
#ifdef __WIN32__
-#include "tclWinInt.h"
+# include "tclWinInt.h"
#endif
#include "tclFileSystem.h"
@@ -32,32 +32,32 @@
static FilesystemRecord * FsGetFirstFilesystem _ANSI_ARGS_((void));
static void FsThrExitProc _ANSI_ARGS_((ClientData cd));
-static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr,
+static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr,
CONST char *pattern));
static void FsAddMountsToGlobResult _ANSI_ARGS_((
Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
- CONST char *pattern,
+ CONST char *pattern,
Tcl_GlobTypeData *types));
-static void FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj,
+static void FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj,
ClientData clientData));
#ifdef TCL_THREADS
static void FsRecacheFilesystemList(void);
#endif
-/*
- * These form part of the native filesystem support. They are needed
- * here because we have a few native filesystem functions (which are
- * the same for win/unix) in this file. There is no need to place
- * them in tclInt.h, because they are not (and should not be) used
- * anywhere else.
+/*
+ * These form part of the native filesystem support. They are needed here
+ * because we have a few native filesystem functions (which are the same for
+ * win/unix) in this file. There is no need to place them in tclInt.h,
+ * because they are not (and should not be) used anywhere else.
*/
+
extern CONST char * tclpFileAttrStrings[];
extern CONST TclFileAttrProcs tclpFileAttrProcs[];
-/*
- * The following functions are obsolete string based APIs, and should
- * be removed in a future release (Tcl 9 would be a good time).
+/*
+ * The following functions are obsolete string based APIs, and should be
+ * removed in a future release (Tcl 9 would be a good time).
*/
/* Obsolete */
@@ -87,7 +87,7 @@ Tcl_Stat(path, oldStyleBuf)
* Note that ino_t/ino64_t is unsigned...
*/
- if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
+ if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
#ifdef HAVE_ST_BLOCKS
|| OUT_OF_RANGE(buf.st_blocks)
#endif
@@ -109,27 +109,27 @@ Tcl_Stat(path, oldStyleBuf)
#endif /* !TCL_WIDE_INT_IS_LONG */
/*
- * Copy across all supported fields, with possible type
- * coercions on those fields that change between the normal
- * and lf64 versions of the stat structure (on Solaris at
- * least.) This is slow when the structure sizes coincide,
- * but that's what you get for using an obsolete interface.
+ * Copy across all supported fields, with possible type coercions on
+ * those fields that change between the normal and lf64 versions of
+ * the stat structure (on Solaris at least.) This is slow when the
+ * structure sizes coincide, but that's what you get for using an
+ * obsolete interface.
*/
- oldStyleBuf->st_mode = buf.st_mode;
- oldStyleBuf->st_ino = (ino_t) buf.st_ino;
- oldStyleBuf->st_dev = buf.st_dev;
- oldStyleBuf->st_rdev = buf.st_rdev;
- oldStyleBuf->st_nlink = buf.st_nlink;
- oldStyleBuf->st_uid = buf.st_uid;
- oldStyleBuf->st_gid = buf.st_gid;
- oldStyleBuf->st_size = (off_t) buf.st_size;
- oldStyleBuf->st_atime = buf.st_atime;
- oldStyleBuf->st_mtime = buf.st_mtime;
- oldStyleBuf->st_ctime = buf.st_ctime;
+ oldStyleBuf->st_mode = buf.st_mode;
+ oldStyleBuf->st_ino = (ino_t) buf.st_ino;
+ oldStyleBuf->st_dev = buf.st_dev;
+ oldStyleBuf->st_rdev = buf.st_rdev;
+ oldStyleBuf->st_nlink = buf.st_nlink;
+ oldStyleBuf->st_uid = buf.st_uid;
+ oldStyleBuf->st_gid = buf.st_gid;
+ oldStyleBuf->st_size = (off_t) buf.st_size;
+ oldStyleBuf->st_atime = buf.st_atime;
+ oldStyleBuf->st_mtime = buf.st_mtime;
+ oldStyleBuf->st_ctime = buf.st_ctime;
#ifdef HAVE_ST_BLOCKS
- oldStyleBuf->st_blksize = buf.st_blksize;
- oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
+ oldStyleBuf->st_blksize = buf.st_blksize;
+ oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
#endif
}
return ret;
@@ -139,35 +139,37 @@ Tcl_Stat(path, oldStyleBuf)
int
Tcl_Access(path, mode)
CONST char *path; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+ int mode; /* Permission setting. */
{
int ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
Tcl_IncrRefCount(pathPtr);
ret = Tcl_FSAccess(pathPtr,mode);
Tcl_DecrRefCount(pathPtr);
+
return ret;
}
/* Obsolete */
Tcl_Channel
Tcl_OpenFileChannel(interp, path, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- CONST char *path; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
+ Tcl_Interp *interp; /* Interpreter for error reporting; can be
+ * NULL. */
+ CONST char *path; /* Name of file to open. */
+ CONST char *modeString; /* A list of POSIX open modes or a string such
+ * as "rw". */
+ int permissions; /* If the open involves creating a file, with
+ * what modes to create it? */
{
Tcl_Channel ret;
Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
+
Tcl_IncrRefCount(pathPtr);
ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
Tcl_DecrRefCount(pathPtr);
- return ret;
+ return ret;
}
/* Obsolete */
@@ -216,28 +218,28 @@ Tcl_EvalFile(interp, fileName)
return ret;
}
-
-/*
+/*
* The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
- * complete, general hooked filesystem APIs should be used instead.
- * This define decides whether to include the obsolete hooks and
- * related code. If these are removed, we'll also want to remove them
- * from stubs/tclInt. The only known users of these APIs are prowrap
- * and mktclapp. New code/extensions should not use them, since they
- * do not provide as full support as the full filesystem API.
- *
- * As soon as prowrap and mktclapp are updated to use the full
- * filesystem support, I suggest all these hooks are removed.
+ * complete, general hooked filesystem APIs should be used instead. This
+ * define decides whether to include the obsolete hooks and related code. If
+ * these are removed, we'll also want to remove them from stubs/tclInt. The
+ * only known users of these APIs are prowrap and mktclapp. New
+ * code/extensions should not use them, since they do not provide as full
+ * support as the full filesystem API.
+ *
+ * As soon as prowrap and mktclapp are updated to use the full filesystem
+ * support, I suggest all these hooks are removed.
*/
-#define USE_OBSOLETE_FS_HOOKS
+#define USE_OBSOLETE_FS_HOOKS
#ifdef USE_OBSOLETE_FS_HOOKS
+
/*
- * The following typedef declarations allow for hooking into the chain
- * of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
- * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function
- * a linked list is defined.
+ * The following typedef declarations allow for hooking into the chain of
+ * functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
+ * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
+ * list is defined.
*/
typedef struct StatProc {
@@ -251,24 +253,22 @@ typedef struct AccessProc {
} AccessProc;
typedef struct OpenFileChannelProc {
- TclOpenFileChannelProc_ *proc; /* Function to process a
- * 'Tcl_OpenFileChannel()' call */
+ TclOpenFileChannelProc_ *proc; /* Function to process a
+ * 'Tcl_OpenFileChannel()' call */
struct OpenFileChannelProc *nextPtr;
- /* The next 'Tcl_OpenFileChannel()'
- * function to call */
+ /* The next 'Tcl_OpenFileChannel()'
+ * function to call */
} OpenFileChannelProc;
/*
- * For each type of (obsolete) hookable function, a static node is
- * declared to hold the function pointer for the "built-in" routine
- * (e.g. 'TclpStat(...)') and the respective list is initialized as a
- * pointer to that node.
- *
- * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that
- * these statically declared list entry cannot be inadvertently removed.
+ * For each type of (obsolete) hookable function, a static node is declared to
+ * hold the function pointer for the "built-in" routine (e.g. 'TclpStat(...)')
+ * and the respective list is initialized as a pointer to that node.
*
- * This method avoids the need to call any sort of "initialization"
- * function.
+ * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that these
+ * statically declared list entry cannot be inadvertently removed.
+ *
+ * This method avoids the need to call any sort of "initialization" function.
*
* All three lists are protected by a global obsoleteFsHookMutex.
*/
@@ -281,60 +281,60 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
#endif /* USE_OBSOLETE_FS_HOOKS */
-/*
- * Declare the native filesystem support. These functions should
- * be considered private to Tcl, and should really not be called
- * directly by any code other than this file (i.e. neither by
- * Tcl's core nor by extensions). Similarly, the old string-based
- * Tclp... native filesystem functions should not be called.
- *
- * The correct API to use now is the Tcl_FS... set of functions,
- * which ensure correct and complete virtual filesystem support.
- *
- * We cannot make all of these static, since some of them
- * are implemented in the platform-specific directories.
+/*
+ * Declare the native filesystem support. These functions should be
+ * considered private to Tcl, and should really not be called directly by any
+ * code other than this file (i.e. neither by Tcl's core nor by extensions).
+ * Similarly, the old string-based Tclp... native filesystem functions should
+ * not be called.
+ *
+ * The correct API to use now is the Tcl_FS... set of functions, which ensure
+ * correct and complete virtual filesystem support.
+ *
+ * We cannot make all of these static, since some of them are implemented in
+ * the platform-specific directories.
*/
+
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
-/*
- * The only reason these functions are not static is that they
- * are either called by code in the native (win/unix) directories
- * or they are actually implemented in those directories. They
- * should simply not be called by code outside Tcl's native
- * filesystem core. i.e. they should be considered 'static' to
- * Tcl's filesystem code (if we ever built the native filesystem
- * support into a separate code library, this could actually be
- * enforced).
+/*
+ * The only reason these functions are not static is that they are either
+ * called by code in the native (win/unix) directories or they are actually
+ * implemented in those directories. They should simply not be called by code
+ * outside Tcl's native filesystem core i.e. they should be considered
+ * 'static' to Tcl's filesystem code (if we ever built the native filesystem
+ * support into a separate code library, this could actually be enforced).
*/
+
Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
Tcl_FSStatProc TclpObjStat;
-Tcl_FSAccessProc TclpObjAccess;
-Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
-Tcl_FSChdirProc TclpObjChdir;
-Tcl_FSLstatProc TclpObjLstat;
-Tcl_FSCopyFileProc TclpObjCopyFile;
-Tcl_FSDeleteFileProc TclpObjDeleteFile;
-Tcl_FSRenameFileProc TclpObjRenameFile;
-Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
-Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
-Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
-Tcl_FSUnloadFileProc TclpUnloadFile;
-Tcl_FSLinkProc TclpObjLink;
-Tcl_FSListVolumesProc TclpObjListVolumes;
-
-/*
- * Define the native filesystem dispatch table. If necessary, it
- * is ok to make this non-static, but it should only be accessed
- * by the functions actually listed within it (or perhaps other
- * helper functions of them). Anything which is not part of this
- * 'native filesystem implementation' should not be delving inside
- * here!
+Tcl_FSAccessProc TclpObjAccess;
+Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
+Tcl_FSChdirProc TclpObjChdir;
+Tcl_FSLstatProc TclpObjLstat;
+Tcl_FSCopyFileProc TclpObjCopyFile;
+Tcl_FSDeleteFileProc TclpObjDeleteFile;
+Tcl_FSRenameFileProc TclpObjRenameFile;
+Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
+Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
+Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
+Tcl_FSUnloadFileProc TclpUnloadFile;
+Tcl_FSLinkProc TclpObjLink;
+Tcl_FSListVolumesProc TclpObjListVolumes;
+
+/*
+ * Define the native filesystem dispatch table. If necessary, it is ok to
+ * make this non-static, but it should only be accessed by the functions
+ * actually listed within it (or perhaps other helper functions of them).
+ * Anything which is not part of this 'native filesystem implementation'
+ * should not be delving inside here!
*/
+
Tcl_Filesystem tclNativeFilesystem = {
"native",
sizeof(Tcl_Filesystem),
@@ -362,11 +362,11 @@ Tcl_Filesystem tclNativeFilesystem = {
&NativeFileAttrsGet,
&NativeFileAttrsSet,
&TclpObjCreateDirectory,
- &TclpObjRemoveDirectory,
+ &TclpObjRemoveDirectory,
&TclpObjDeleteFile,
&TclpObjCopyFile,
&TclpObjRenameFile,
- &TclpObjCopyDirectory,
+ &TclpObjCopyDirectory,
&TclpObjLstat,
&TclpDlopen,
/* Needs a cast since we're using version_2 */
@@ -374,15 +374,16 @@ Tcl_Filesystem tclNativeFilesystem = {
&TclpObjChdir
};
-/*
- * Define the tail of the linked list. Note that for unconventional
- * uses of Tcl without a native filesystem, we may in the future wish
- * to modify the current approach of hard-coding the native filesystem
- * in the lookup list 'filesystemList' below.
- *
- * We initialize the record so that it thinks one file uses it. This
- * means it will never be freed.
+/*
+ * Define the tail of the linked list. Note that for unconventional uses of
+ * Tcl without a native filesystem, we may in the future wish to modify the
+ * current approach of hard-coding the native filesystem in the lookup list
+ * 'filesystemList' below.
+ *
+ * We initialize the record so that it thinks one file uses it. This means it
+ * will never be freed.
*/
+
static FilesystemRecord nativeFilesystemRecord = {
NULL,
&tclNativeFilesystem,
@@ -390,26 +391,28 @@ static FilesystemRecord nativeFilesystemRecord = {
NULL
};
-/*
- * This is incremented each time we modify the linked list of
- * filesystems. Any time it changes, all cached filesystem
- * representations are suspect and must be freed.
- * For multithreading builds, change of the filesystem epoch
+/*
+ * This is incremented each time we modify the linked list of filesystems.
+ * Any time it changes, all cached filesystem representations are suspect and
+ * must be freed. For multithreading builds, change of the filesystem epoch
* will trigger cache cleanup in all threads.
*/
+
static int theFilesystemEpoch = 0;
/*
- * Stores the linked list of filesystems. A 1:1 copy of this
- * list is also maintained in the TSD for each thread. This
- * is to avoid synchronization issues.
+ * Stores the linked list of filesystems. A 1:1 copy of this list is also
+ * maintained in the TSD for each thread. This is to avoid synchronization
+ * issues.
*/
+
static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
TCL_DECLARE_MUTEX(filesystemMutex)
-/*
+/*
* Used to implement Tcl_FSGetCwd in a file-system independent way.
*/
+
static Tcl_Obj* cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
@@ -417,45 +420,55 @@ TCL_DECLARE_MUTEX(cwdMutex)
Tcl_ThreadDataKey tclFsDataKey;
-/*
- * Declare fallback support function and
- * information for Tcl_FSLoadFile
+/*
+ * Declare fallback support function and information for Tcl_FSLoadFile
*/
+
static Tcl_FSUnloadFileProc FSUnloadTempFile;
/*
- * One of these structures is used each time we successfully load a
- * file from a file system by way of making a temporary copy of the
- * file on the native filesystem. We need to store both the actual
- * unloadProc/clientData combination which was used, and the original
- * and modified filenames, so that we can correctly undo the entire
- * operation when we want to unload the code.
+ * One of these structures is used each time we successfully load a file from
+ * a file system by way of making a temporary copy of the file on the native
+ * filesystem. We need to store both the actual unloadProc/clientData
+ * combination which was used, and the original and modified filenames, so
+ * that we can correctly undo the entire operation when we want to unload the
+ * code.
*/
+
typedef struct FsDivertLoad {
Tcl_LoadHandle loadHandle;
- Tcl_FSUnloadFileProc *unloadProcPtr;
+ Tcl_FSUnloadFileProc *unloadProcPtr;
Tcl_Obj *divertedFile;
Tcl_Filesystem *divertedFilesystem;
ClientData divertedFileNativeRep;
} FsDivertLoad;
-
-/* Now move on to the basic filesystem implementation */
+
+/*
+ * Now move on to the basic filesystem implementation
+ */
static void
FsThrExitProc(cd)
ClientData cd;
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData*)cd;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;
- /* Trash the cwd copy */
+ /*
+ * Trash the cwd copy.
+ */
+
if (tsdPtr->cwdPathPtr != NULL) {
Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
}
if (tsdPtr->cwdClientData != NULL) {
NativeFreeInternalRep(tsdPtr->cwdClientData);
}
- /* Trash the filesystems cache */
+
+ /*
+ * Trash the filesystems cache.
+ */
+
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr->nextPtr;
@@ -467,7 +480,7 @@ FsThrExitProc(cd)
}
int
-TclFSCwdIsNative()
+TclFSCwdIsNative()
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
@@ -483,23 +496,23 @@ TclFSCwdIsNative()
*
* TclFSCwdPointerEquals --
*
- * Check whether the current working directory is equal to the
- * path given.
- *
+ * Check whether the current working directory is equal to the path
+ * given.
+ *
* Results:
* 1 (equal) or 0 (un-equal) as appropriate.
*
* Side effects:
- * If the paths are equal, but are not the same object, this
- * method will modify the given pathPtrPtr to refer to the same
- * object. In this case the object pointed to by pathPtrPtr will
- * have its refCount decremented, and it will be adjusted to
- * point to the cwd (with a new refCount).
+ * If the paths are equal, but are not the same object, this method will
+ * modify the given pathPtrPtr to refer to the same object. In this case
+ * the object pointed to by pathPtrPtr will have its refCount
+ * decremented, and it will be adjusted to point to the cwd (with a new
+ * refCount).
*
*----------------------------------------------------------------------
*/
-int
+int
TclFSCwdPointerEquals(pathPtrPtr)
Tcl_Obj** pathPtrPtr;
{
@@ -514,12 +527,12 @@ TclFSCwdPointerEquals(pathPtrPtr)
if (tsdPtr->cwdClientData != NULL) {
NativeFreeInternalRep(tsdPtr->cwdClientData);
}
- if (cwdPathPtr == NULL) {
- tsdPtr->cwdPathPtr = NULL;
- } else {
- tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
- Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
- }
+ if (cwdPathPtr == NULL) {
+ tsdPtr->cwdPathPtr = NULL;
+ } else {
+ tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
+ Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
+ }
if (cwdClientData == NULL) {
tsdPtr->cwdClientData = NULL;
} else {
@@ -530,26 +543,28 @@ TclFSCwdPointerEquals(pathPtrPtr)
Tcl_MutexUnlock(&cwdMutex);
if (tsdPtr->initialized == 0) {
- Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
+ Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
tsdPtr->initialized = 1;
}
if (pathPtrPtr == NULL) {
- return (tsdPtr->cwdPathPtr == NULL);
+ return (tsdPtr->cwdPathPtr == NULL);
}
-
+
if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
- return 1;
+ return 1;
} else {
int len1, len2;
CONST char *str1, *str2;
+
str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
if (len1 == len2 && !strcmp(str1,str2)) {
- /*
- * They are equal, but different objects. Update so they
- * will be the same object in the future.
+ /*
+ * They are equal, but different objects. Update so they will be
+ * the same object in the future.
*/
+
Tcl_DecrRefCount(*pathPtrPtr);
*pathPtrPtr = tsdPtr->cwdPathPtr;
Tcl_IncrRefCount(*pathPtrPtr);
@@ -567,10 +582,13 @@ FsRecacheFilesystemList(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;
- /* Trash the current cache */
+ /*
+ * Trash the current cache.
+ */
+
fsRecPtr = tsdPtr->filesystemList;
while (fsRecPtr != NULL) {
- tmpFsRecPtr = fsRecPtr->nextPtr;
+ tmpFsRecPtr = fsRecPtr->nextPtr;
if (--fsRecPtr->fileRefCount <= 0) {
ckfree((char *)fsRecPtr);
}
@@ -579,22 +597,25 @@ FsRecacheFilesystemList(void)
tsdPtr->filesystemList = NULL;
/*
- * Code below operates on shared data. We
- * are already called under mutex lock so
- * we can safely proceede.
+ * Code below operates on shared data. We are already called under mutex
+ * lock so we can safely proceede.
+ *
+ * Locate tail of the global filesystem list.
*/
- /* Locate tail of the global filesystem list */
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
tmpFsRecPtr = fsRecPtr;
fsRecPtr = fsRecPtr->nextPtr;
}
- /* Refill the cache honouring the order */
+ /*
+ * Refill the cache honouring the order.
+ */
+
fsRecPtr = tmpFsRecPtr;
while (fsRecPtr != NULL) {
- tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));
+ tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
*tmpFsRecPtr = *fsRecPtr;
tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
tmpFsRecPtr->prevPtr = NULL;
@@ -605,9 +626,12 @@ FsRecacheFilesystemList(void)
fsRecPtr = fsRecPtr->prevPtr;
}
- /* Make sure the above gets released on thread exit */
+ /*
+ * Make sure the above gets released on thread exit.
+ */
+
if (tsdPtr->initialized == 0) {
- Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
+ Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
tsdPtr->initialized = 1;
}
}
@@ -634,21 +658,23 @@ FsGetFirstFilesystem(void) {
}
/*
- * The epoch can be changed both by filesystems being added or
- * removed and by env(HOME) changing.
+ * The epoch can be changed both by filesystems being added or removed and by
+ * env(HOME) changing.
*/
+
int
-TclFSEpochOk (filesystemEpoch)
- int filesystemEpoch;
+TclFSEpochOk(filesystemEpoch)
+ int filesystemEpoch;
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
(void) FsGetFirstFilesystem();
return (filesystemEpoch == tsdPtr->filesystemEpoch);
}
-/*
+/*
* If non-NULL, clientData is owned by us and must be freed later.
*/
+
static void
FsUpdateCwd(cwdObj, clientData)
Tcl_Obj *cwdObj;
@@ -664,35 +690,41 @@ FsUpdateCwd(cwdObj, clientData)
Tcl_MutexLock(&cwdMutex);
if (cwdPathPtr != NULL) {
- Tcl_DecrRefCount(cwdPathPtr);
+ Tcl_DecrRefCount(cwdPathPtr);
}
if (cwdClientData != NULL) {
NativeFreeInternalRep(cwdClientData);
}
+
if (cwdObj == NULL) {
cwdPathPtr = NULL;
cwdClientData = NULL;
} else {
- /* This must be stored as string obj! */
- cwdPathPtr = Tcl_NewStringObj(str, len);
+ /*
+ * This must be stored as string obj!
+ */
+
+ cwdPathPtr = Tcl_NewStringObj(str, len);
Tcl_IncrRefCount(cwdPathPtr);
cwdClientData = TclNativeDupInternalRep(clientData);
}
+
cwdPathEpoch++;
tsdPtr->cwdPathEpoch = cwdPathEpoch;
Tcl_MutexUnlock(&cwdMutex);
if (tsdPtr->cwdPathPtr) {
- Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
+ Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
}
if (tsdPtr->cwdClientData) {
NativeFreeInternalRep(tsdPtr->cwdClientData);
}
+
if (cwdObj == NULL) {
tsdPtr->cwdPathPtr = NULL;
tsdPtr->cwdClientData = NULL;
} else {
- tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
+ tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
tsdPtr->cwdClientData = clientData;
Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
}
@@ -705,10 +737,10 @@ FsUpdateCwd(cwdObj, clientData)
*
* Clean up the filesystem. After this, calls to all Tcl_FS...
* functions will fail.
- *
- * We will later call TclResetFilesystem to restore the FS
- * to a pristine state.
- *
+ *
+ * We will later call TclResetFilesystem to restore the FS to a pristine
+ * state.
+ *
* Results:
* None.
*
@@ -723,42 +755,45 @@ TclFinalizeFilesystem()
{
FilesystemRecord *fsRecPtr;
- /*
- * Assumption that only one thread is active now. Otherwise
- * we would need to put various mutexes around this code.
+ /*
+ * Assumption that only one thread is active now. Otherwise we would need
+ * to put various mutexes around this code.
*/
-
+
if (cwdPathPtr != NULL) {
Tcl_DecrRefCount(cwdPathPtr);
cwdPathPtr = NULL;
- cwdPathEpoch = 0;
+ cwdPathEpoch = 0;
}
if (cwdClientData != NULL) {
NativeFreeInternalRep(cwdClientData);
cwdClientData = NULL;
}
- /*
- * Remove all filesystems, freeing any allocated memory
- * that is no longer needed
+ /*
+ * Remove all filesystems, freeing any allocated memory that is no longer
+ * needed
*/
fsRecPtr = filesystemList;
while (fsRecPtr != NULL) {
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
- if (fsRecPtr->fileRefCount <= 0) {
- /* The native filesystem is static, so we don't free it */
- if (fsRecPtr != &nativeFilesystemRecord) {
- ckfree((char *)fsRecPtr);
- }
- }
- fsRecPtr = tmpFsRecPtr;
+ if (fsRecPtr->fileRefCount <= 0) {
+ /*
+ * The native filesystem is static, so we don't free it.
+ */
+
+ if (fsRecPtr != &nativeFilesystemRecord) {
+ ckfree((char *)fsRecPtr);
+ }
+ }
+ fsRecPtr = tmpFsRecPtr;
}
filesystemList = NULL;
/*
- * Now filesystemList is NULL. This means that any attempt
- * to use the filesystem is likely to fail.
+ * Now filesystemList is NULL. This means that any attempt to use the
+ * filesystem is likely to fail.
*/
statProcList = NULL;
@@ -775,7 +810,7 @@ TclFinalizeFilesystem()
* TclResetFilesystem --
*
* Restore the filesystem to a pristine state.
- *
+ *
* Results:
* None.
*
@@ -789,18 +824,18 @@ void
TclResetFilesystem()
{
filesystemList = &nativeFilesystemRecord;
- /*
- * Note, at this point, I believe nativeFilesystemRecord ->
- * fileRefCount should equal 1 and if not, we should try to track
- * down the cause.
+
+ /*
+ * Note, at this point, I believe nativeFilesystemRecord -> fileRefCount
+ * should equal 1 and if not, we should try to track down the cause.
*/
-
+
#ifdef __WIN32__
- /*
- * Cleans up the win32 API filesystem proc lookup table. This must
- * happen very late in finalization so that deleting of copied
- * dlls can occur.
+ /*
+ * Cleans up the win32 API filesystem proc lookup table. This must happen
+ * very late in finalization so that deleting of copied dlls can occur.
*/
+
TclWinResetInterfaces();
#endif
}
@@ -810,36 +845,35 @@ TclResetFilesystem()
*
* Tcl_FSRegister --
*
- * Insert the filesystem function table at the head of the list of
- * functions which are used during calls to all file-system
- * operations. The filesystem will be added even if it is
- * already in the list. (You can use Tcl_FSData to
- * check if it is in the list, provided the ClientData used was
- * not NULL).
- *
- * Note that the filesystem handling is head-to-tail of the list.
- * Each filesystem is asked in turn whether it can handle a
- * particular request, _until_ one of them says 'yes'. At that
- * point no further filesystems are asked.
- *
- * In particular this means if you want to add a diagnostic
- * filesystem (which simply reports all fs activity), it must be
- * at the head of the list: i.e. it must be the last registered.
+ * Insert the filesystem function table at the head of the list of
+ * functions which are used during calls to all file-system operations.
+ * The filesystem will be added even if it is already in the list. (You
+ * can use Tcl_FSData to check if it is in the list, provided the
+ * ClientData used was not NULL).
+ *
+ * Note that the filesystem handling is head-to-tail of the list. Each
+ * filesystem is asked in turn whether it can handle a particular
+ * request, until one of them says 'yes'. At that point no further
+ * filesystems are asked.
+ *
+ * In particular this means if you want to add a diagnostic filesystem
+ * (which simply reports all fs activity), it must be at the head of the
+ * list: i.e. it must be the last registered.
*
* Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- * could not be allocated.
+ * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ * not be allocated.
*
* Side effects:
- * Memory allocated and modifies the link list for filesystems.
+ * Memory allocated and modifies the link list for filesystems.
*
*----------------------------------------------------------------------
*/
int
Tcl_FSRegister(clientData, fsPtr)
- ClientData clientData; /* Client specific data for this fs */
- Tcl_Filesystem *fsPtr; /* The filesystem record for the new fs. */
+ ClientData clientData; /* Client specific data for this fs */
+ Tcl_Filesystem *fsPtr; /* The filesystem record for the new fs. */
{
FilesystemRecord *newFilesystemPtr;
@@ -851,38 +885,41 @@ Tcl_FSRegister(clientData, fsPtr)
newFilesystemPtr->clientData = clientData;
newFilesystemPtr->fsPtr = fsPtr;
- /*
- * We start with a refCount of 1. If this drops to zero, then
- * anyone is welcome to ckfree us.
+
+ /*
+ * 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
- * iterators out there will have grabbed a copy of the head of
- * the list and be iterating away from that, if we add a new
- * element to the head of the list, it can't possibly have any
- * effect on any of their loops. In fact it could be better not
- * to wait, since we are adjusting the filesystem epoch, any
- * cached representations calculated by existing iterators are
+ /*
+ * Is this lock and wait strictly speaking necessary? Since any iterators
+ * out there will have grabbed a copy of the head of the list and be
+ * iterating away from that, if we add a new element to the head of the
+ * list, it can't possibly have any effect on any of their loops. In fact
+ * it could be better not to wait, since we are adjusting the filesystem
+ * epoch, any cached representations calculated by existing iterators are
* going to have to be thrown away anyway.
- *
- * However, since registering and unregistering filesystems is
- * a very rare action, this is not a very important point.
+ *
+ * However, since registering and unregistering filesystems is a very rare
+ * action, this is not a very important point.
*/
+
Tcl_MutexLock(&filesystemMutex);
newFilesystemPtr->nextPtr = filesystemList;
newFilesystemPtr->prevPtr = NULL;
if (filesystemList) {
- filesystemList->prevPtr = newFilesystemPtr;
+ filesystemList->prevPtr = newFilesystemPtr;
}
filesystemList = newFilesystemPtr;
- /*
- * Increment the filesystem epoch counter, since existing paths
- * might conceivably now belong to different filesystems.
+ /*
+ * Increment the filesystem epoch counter, since existing paths might
+ * conceivably now belong to different filesystems.
*/
+
theFilesystemEpoch++;
Tcl_MutexUnlock(&filesystemMutex);
@@ -894,29 +931,28 @@ Tcl_FSRegister(clientData, fsPtr)
*
* Tcl_FSUnregister --
*
- * Remove the passed filesystem from the list of filesystem
- * function tables. It also ensures that the built-in
- * (native) filesystem is not removable, although we may wish
- * to change that decision in the future to allow a smaller
- * Tcl core, in which the native filesystem is not used at
- * all (we could, say, initialise Tcl completely over a network
- * connection).
+ * Remove the passed filesystem from the list of filesystem function
+ * tables. It also ensures that the built-in (native) filesystem is not
+ * removable, although we may wish to change that decision in the future
+ * to allow a smaller Tcl core, in which the native filesystem is not
+ * used at all (we could, say, initialise Tcl completely over a network
+ * connection).
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed,
- * TCL_ERROR otherwise.
+ * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * otherwise.
*
* Side effects:
- * Memory may be deallocated (or will be later, once no "path"
- * objects refer to this filesystem), but the list of registered
- * filesystems is updated immediately.
+ * Memory may be deallocated (or will be later, once no "path" objects
+ * refer to this filesystem), but the list of registered filesystems is
+ * updated immediately.
*
*----------------------------------------------------------------------
*/
int
Tcl_FSUnregister(fsPtr)
- Tcl_Filesystem *fsPtr; /* The filesystem record to remove. */
+ Tcl_Filesystem *fsPtr; /* The filesystem record to remove. */
{
int retVal = TCL_ERROR;
FilesystemRecord *fsRecPtr;
@@ -924,9 +960,9 @@ Tcl_FSUnregister(fsPtr)
Tcl_MutexLock(&filesystemMutex);
/*
- * Traverse the 'filesystemList' looking for the particular node
- * whose 'fsPtr' member matches 'fsPtr' and remove that one from
- * the list. Ensure that the "default" node cannot be removed.
+ * Traverse the 'filesystemList' looking for the particular node whose
+ * 'fsPtr' member matches 'fsPtr' and remove that one from the list.
+ * Ensure that the "default" node cannot be removed.
*/
fsRecPtr = filesystemList;
@@ -940,19 +976,20 @@ Tcl_FSUnregister(fsPtr)
if (fsRecPtr->nextPtr) {
fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr;
}
- /*
- * Increment the filesystem epoch counter, since existing
- * paths might conceivably now belong to different
- * filesystems. This should also ensure that paths which
- * have cached the filesystem which is about to be deleted
- * do not reference that filesystem (which would of course
- * lead to memory exceptions).
+
+ /*
+ * Increment the filesystem epoch counter, since existing paths
+ * might conceivably now belong to different filesystems. This
+ * should also ensure that paths which have cached the filesystem
+ * which is about to be deleted do not reference that filesystem
+ * (which would of course lead to memory exceptions).
*/
+
theFilesystemEpoch++;
-
+
fsRecPtr->fileRefCount--;
if (fsRecPtr->fileRefCount <= 0) {
- ckfree((char *)fsRecPtr);
+ ckfree((char *)fsRecPtr);
}
retVal = TCL_OK;
@@ -962,7 +999,7 @@ Tcl_FSUnregister(fsPtr)
}
Tcl_MutexUnlock(&filesystemMutex);
- return (retVal);
+ return retVal;
}
/*
@@ -970,49 +1007,47 @@ Tcl_FSUnregister(fsPtr)
*
* Tcl_FSMatchInDirectory --
*
- * This routine is used by the globbing code to search a directory
- * for all files which match a given pattern. The appropriate
- * function for the filesystem to which pathPtr belongs will be
- * called. If pathPtr does not belong to any filesystem and if it
- * is NULL or the empty string, then we assume the pattern is to be
- * matched in the current working directory. To avoid each
- * filesystem's Tcl_FSMatchInDirectoryProc having to deal with this
- * issue, we create a pathPtr on the fly (equal to the cwd), and
- * then remove it from the results returned. This makes filesystems
- * easy to write, since they can assume the pathPtr passed to them
- * is an ordinary path. In fact this means we could remove such
- * special case handling from Tcl's native filesystems.
- *
- * If 'pattern' is NULL, then pathPtr is assumed to be a fully
- * specified path of a single file/directory which must be
- * checked for existence and correct type.
- *
- * Results:
- *
- * The return value is a standard Tcl result indicating whether an
- * error occurred in globbing. Error messages are placed in
- * interp, but good results are placed in the resultPtr given.
- *
+ * This routine is used by the globbing code to search a directory for
+ * all files which match a given pattern. The appropriate function for
+ * the filesystem to which pathPtr belongs will be called. If pathPtr
+ * does not belong to any filesystem and if it is NULL or the empty
+ * string, then we assume the pattern is to be matched in the current
+ * working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
+ * each filesystem from having to deal with this issue, we create a
+ * pathPtr on the fly (equal to the cwd), and then remove it from the
+ * results returned. This makes filesystems easy to write, since they
+ * can assume the pathPtr passed to them is an ordinary path. In fact
+ * this means we could remove such special case handling from Tcl's
+ * native filesystems.
+ *
+ * If 'pattern' is NULL, then pathPtr is assumed to be a fully specified
+ * path of a single file/directory which must be checked for existence
+ * and correct type.
+ *
+ * Results:
+ *
+ * The return value is a standard Tcl result indicating whether an error
+ * occurred in globbing. Error messages are placed in interp, but good
+ * results are placed in the resultPtr given.
+ *
* Recursive searches, e.g.
- *
- * glob -dir $dir -join * pkgIndex.tcl
- *
- * which must recurse through each directory matching '*' are
- * handled internally by Tcl, by passing specific flags in a
- * modified 'types' parameter. This means the actual filesystem
- * only ever sees patterns which match in a single directory.
+ * glob -dir $dir -join * pkgIndex.tcl
+ * which must recurse through each directory matching '*' are handled
+ * internally by Tcl, by passing specific flags in a modified 'types'
+ * parameter. This means the actual filesystem only ever sees patterns
+ * which match in a single directory.
*
* Side effects:
* The interpreter may have an error message inserted into it.
*
- *----------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
Tcl_Interp *interp; /* Interpreter to receive error messages. */
Tcl_Obj *resultPtr; /* List object to receive results. */
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
+ Tcl_Obj *pathPtr; /* Contains path to directory to search. */
CONST char *pattern; /* Pattern to match against. */
Tcl_GlobTypeData *types; /* Object containing list of acceptable types.
* May be NULL. In particular the directory
@@ -1023,24 +1058,25 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
int resLength, i, ret = -1;
if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
- /*
- * We don't currently allow querying of mounts by external code
- * (a valuable future step), so since we're the only function
- * that actually knows about mounts, this means we're being
- * called recursively by ourself. Return no matches.
+ /*
+ * We don't currently allow querying of mounts by external code (a
+ * valuable future step), so since we're the only function that
+ * actually knows about mounts, this means we're being called
+ * recursively by ourself. Return no matches.
*/
+
return TCL_OK;
}
-
+
if (pathPtr != NULL) {
- fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+ fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
} else {
fsPtr = NULL;
}
-
+
/*
- * Check if we've successfully mapped the path to a filesystem
- * within which to search.
+ * Check if we've successfully mapped the path to a filesystem within
+ * which to search.
*/
if (fsPtr != NULL) {
@@ -1056,9 +1092,9 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
return ret;
}
- /*
- * If the path isn't empty, we have no idea how to match files in
- * a directory which belongs to no known filesystem
+ /*
+ * If the path isn't empty, we have no idea how to match files in a
+ * directory which belongs to no known filesystem
*/
if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
@@ -1066,15 +1102,14 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
return -1;
}
- /*
- * We have an empty or NULL path. This is defined to mean we
- * must search for files within the current 'cwd'. We
- * therefore use that, but then since the proc we call will
- * return results which include the cwd we must then trim it
- * off the front of each path in the result. We choose to deal
- * with this here (in the generic code), since if we don't,
- * every single filesystem's implementation of
- * Tcl_FSMatchInDirectory will have to deal with it for us.
+ /*
+ * We have an empty or NULL path. This is defined to mean we must search
+ * for files within the current 'cwd'. We therefore use that, but then
+ * since the proc we call will return results which include the cwd we
+ * must then trim it off the front of each path in the result. We choose
+ * to deal with this here (in the generic code), since if we don't, every
+ * single filesystem's implementation of Tcl_FSMatchInDirectory will have
+ * to deal with it for us.
*/
cwd = Tcl_FSGetCwd(NULL);
@@ -1094,10 +1129,14 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
pattern, types);
if (ret == TCL_OK) {
FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);
- /* Note that we know resultPtr and tmpResultPtr are distinct */
+
+ /*
+ * Note that we know resultPtr and tmpResultPtr are distinct.
+ */
+
ret = Tcl_ListObjGetElements(interp, tmpResultPtr,
&resLength, &elemsPtr);
- for (i = 0; ret == TCL_OK && i < resLength; i++) {
+ for (i=0 ; ret==TCL_OK && i<resLength ; i++) {
ret = Tcl_ListObjAppendElement(interp, resultPtr,
TclFSMakePathRelative(interp, elemsPtr[i], cwd));
}
@@ -1113,18 +1152,18 @@ Tcl_FSMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
*
* FsAddMountsToGlobResult --
*
- * This routine is used by the globbing code to take the results
- * of a directory listing and add any mounted paths to that
- * listing. This is required so that simple things like
- * 'glob *' merge mounts and listings correctly.
- *
- * Results:
+ * This routine is used by the globbing code to take the results of a
+ * directory listing and add any mounted paths to that listing. This is
+ * required so that simple things like 'glob *' merge mounts and listings
+ * correctly.
+ *
+ * Results:
* None.
*
* Side effects:
* Modifies the resultPtr.
*
- *----------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static void
@@ -1151,52 +1190,57 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
if (Tcl_ListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
goto endOfMounts;
}
- for (i = 0; i < mLength; i++) {
+ for (i=0 ; i<mLength ; i++) {
Tcl_Obj *mElt;
int j;
int found = 0;
-
+
Tcl_ListObjIndex(NULL, mounts, i, &mElt);
- for (j = 0; j < gLength; j++) {
+ for (j=0 ; j<gLength ; j++) {
Tcl_Obj *gElt;
Tcl_ListObjIndex(NULL, resultPtr, j, &gElt);
if (Tcl_FSEqualPaths(mElt, gElt)) {
found = 1;
if (!dir) {
- /* We don't want to list this */
+ /*
+ * We don't want to list this.
+ */
+
Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
gLength--;
}
- /* Break out of for loop */
- break;
+ break; /* Break out of for loop */
}
}
if (!found && dir) {
- int len, mlen;
- CONST char *path;
- CONST char *mount;
-
- /*
- * We know mElt is absolute normalized and lies inside pathPtr,
- * so now we must add to the result the right
- * representation of mElt, i.e. the representation which
- * is relative to pathPtr.
- */
- mount = Tcl_GetStringFromObj(mElt, &mlen);
- path = Tcl_GetStringFromObj(Tcl_FSGetNormalizedPath(NULL, pathPtr),
- &len);
- if (path[len-1] == '/') {
- /* Deal with the root of the volume */
- len--;
- }
- mElt = TclNewFSPathObj(pathPtr, mount + len + 1, mlen - len);
- Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
- /*
- * No need to increment gLength, since we
- * don't want to compare mounts against
- * mounts.
+ int len, mlen;
+ CONST char *path;
+ CONST char *mount;
+
+ /*
+ * We know mElt is absolute normalized and lies inside pathPtr, so
+ * now we must add to the result the right representation of mElt,
+ * i.e. the representation which is relative to pathPtr.
+ */
+
+ mount = Tcl_GetStringFromObj(mElt, &mlen);
+ path = Tcl_GetStringFromObj(Tcl_FSGetNormalizedPath(NULL, pathPtr),
+ &len);
+ if (path[len-1] == '/') {
+ /*
+ * Deal with the root of the volume.
+ */
+
+ len--;
+ }
+ mElt = TclNewFSPathObj(pathPtr, mount + len + 1, mlen - len);
+ Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
+
+ /*
+ * No need to increment gLength, since we don't want to compare
+ * mounts against mounts.
*/
}
}
@@ -1210,47 +1254,44 @@ FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types)
*
* Tcl_FSMountsChanged --
*
- * Notify the filesystem that the available mounted filesystems
- * (or within any one filesystem type, the number or location of
- * mount points) have changed.
+ * Notify the filesystem that the available mounted filesystems (or
+ * within any one filesystem type, the number or location of mount
+ * points) have changed.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * The global filesystem variable 'theFilesystemEpoch' is
- * incremented. The effect of this is to make all cached
- * path representations invalid. Clearly it should only therefore
- * be called when it is really required! There are a few
- * circumstances when it should be called:
- *
- * (1) when a new filesystem is registered or unregistered.
- * Strictly speaking this is only necessary if the new filesystem
- * accepts file paths as is (normally the filesystem itself is
- * really a shell which hasn't yet had any mount points established
- * and so its 'pathInFilesystem' proc will always fail). However,
- * for safety, Tcl always calls this for you in these circumstances.
- *
- * (2) when additional mount points are established inside any
- * existing filesystem (except the native fs)
- *
- * (3) when any filesystem (except the native fs) changes the list
- * of available volumes.
- *
- * (4) when the mapping from a string representation of a file to
- * a full, normalized path changes. For example, if 'env(HOME)'
- * is modified, then any path containing '~' will map to a different
- * filesystem location. Therefore all such paths need to have
- * their internal representation invalidated.
- *
- * Tcl has no control over (2) and (3), so any registered filesystem
- * must make sure it calls this function when those situations
- * occur.
- *
- * (Note: the reason for the exception in 2,3 for the native
- * filesystem is that the native filesystem by default claims all
- * unknown files even if it really doesn't understand them or if
- * they don't exist).
+ * The global filesystem variable 'theFilesystemEpoch' is incremented.
+ * The effect of this is to make all cached path representations invalid.
+ * Clearly it should only therefore be called when it is really required!
+ * There are a few circumstances when it should be called:
+ *
+ * (1) when a new filesystem is registered or unregistered. Strictly
+ * speaking this is only necessary if the new filesystem accepts file
+ * paths as is (normally the filesystem itself is really a shell which
+ * hasn't yet had any mount points established and so its
+ * 'pathInFilesystem' proc will always fail). However, for safety, Tcl
+ * always calls this for you in these circumstances.
+ *
+ * (2) when additional mount points are established inside any existing
+ * filesystem (except the native fs)
+ *
+ * (3) when any filesystem (except the native fs) changes the list of
+ * available volumes.
+ *
+ * (4) when the mapping from a string representation of a file to a full,
+ * normalized path changes. For example, if 'env(HOME)' is modified, then
+ * any path containing '~' will map to a different filesystem location.
+ * Therefore all such paths need to have their internal representation
+ * invalidated.
+ *
+ * Tcl has no control over (2) and (3), so any registered filesystem must
+ * make sure it calls this function when those situations occur.
+ *
+ * (Note: the reason for the exception in 2,3 for the native filesystem
+ * is that the native filesystem by default claims all unknown files even
+ * if it really doesn't understand them or if they don't exist).
*
*----------------------------------------------------------------------
*/
@@ -1259,16 +1300,19 @@ void
Tcl_FSMountsChanged(fsPtr)
Tcl_Filesystem *fsPtr;
{
- /*
- * We currently don't do anything with this parameter. We
- * could in the future only invalidate files for this filesystem
- * or otherwise take more advanced action.
+ /*
+ * We currently don't do anything with this parameter. We could in the
+ * future only invalidate files for this filesystem or otherwise take more
+ * advanced action.
*/
+
(void)fsPtr;
- /*
- * Increment the filesystem epoch counter, since existing paths
- * might now belong to different filesystems.
+
+ /*
+ * Increment the filesystem epoch counter, since existing paths might now
+ * belong to different filesystems.
*/
+
Tcl_MutexLock(&filesystemMutex);
theFilesystemEpoch++;
Tcl_MutexUnlock(&filesystemMutex);
@@ -1279,16 +1323,16 @@ Tcl_FSMountsChanged(fsPtr)
*
* Tcl_FSData --
*
- * Retrieve the clientData field for the filesystem given,
- * or NULL if that filesystem is not registered.
+ * Retrieve the clientData field for the filesystem given, or NULL if
+ * that filesystem is not registered.
*
* Results:
- * A clientData value, or NULL. Note that if the filesystem
- * was registered with a NULL clientData field, this function
- * will return that NULL value.
+ * A clientData value, or NULL. Note that if the filesystem was
+ * registered with a NULL clientData field, this function will return
+ * that NULL value.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -1301,9 +1345,9 @@ Tcl_FSData(fsPtr)
FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
/*
- * Traverse the list of filesystems look for a particular one.
- * If found, return that filesystem's clientData (originally
- * provided when calling Tcl_FSRegister).
+ * Traverse the list of filesystems look for a particular one. If found,
+ * return that filesystem's clientData (originally provided when calling
+ * Tcl_FSRegister).
*/
while ((retVal == NULL) && (fsRecPtr != NULL)) {
@@ -1321,82 +1365,80 @@ Tcl_FSData(fsPtr)
*
* TclFSNormalizeToUniquePath --
*
- * Description:
- * Takes a path specification containing no ../, ./ sequences,
- * and converts it into a unique path for the given platform.
- * On Unix, this means the path must be free of
- * symbolic links/aliases, and on Windows it means we want the
- * long form, with that long form's case-dependence (which gives
- * us a unique, case-dependent path).
+ * Takes a path specification containing no ../, ./ sequences, and
+ * converts it into a unique path for the given platform. On Unix, this
+ * means the path must be free of symbolic links/aliases, and on Windows
+ * it means we want the long form, with that long form's case-dependence
+ * (which gives us a unique, case-dependent path).
*
* Results:
- * The pathPtr is modified in place. The return value is
- * the last byte offset which was recognised in the path
- * string.
+ * The pathPtr is modified in place. The return value is the last byte
+ * offset which was recognised in the path string.
*
* Side effects:
* None (beyond the memory allocation for the result).
*
* Special notes:
- * If the filesystem-specific normalizePathProcs can re-introduce
- * ../, ./ sequences into the path, then this function will
- * not return the correct result. This may be possible with
- * symbolic links on unix.
- *
- * Important assumption: if startAt is non-zero, it must point
- * to a directory separator that we know exists and is already
- * normalized (so it is important not to point to the char just
- * after the separator).
+ * If the filesystem-specific normalizePathProcs can re-introduce ../, ./
+ * sequences into the path, then this function will not return the
+ * correct result. This may be possible with symbolic links on unix.
+ *
+ * Important assumption: if startAt is non-zero, it must point to a
+ * directory separator that we know exists and is already normalized (so
+ * it is important not to point to the char just after the separator).
+ *
*---------------------------------------------------------------------------
*/
+
int
TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
- Tcl_Interp *interp; /* Used for error messages. */
- Tcl_Obj *pathPtr; /* The path to normalize in place */
- int startAt; /* Start at this char-offset */
- ClientData *clientDataPtr; /* If we generated a complete
- * normalized path for a given
- * filesystem, we can optionally return
- * an fs-specific clientdata here. */
+ Tcl_Interp *interp; /* Used for error messages. */
+ Tcl_Obj *pathPtr; /* The path to normalize in place */
+ int startAt; /* Start at this char-offset */
+ ClientData *clientDataPtr; /* If we generated a complete normalized path
+ * for a given filesystem, we can optionally
+ * return an fs-specific clientdata here. */
{
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
/* Ignore this variable */
- (void)clientDataPtr;
-
+ (void) clientDataPtr;
+
/*
- * Call each of the "normalise path" functions in succession. This is
- * a special case, in which if we have a native filesystem handler,
- * we call it first. This is because the root of Tcl's filesystem
- * is always a native filesystem (i.e. '/' on unix is native).
+ * Call each of the "normalise path" functions in succession. This is a
+ * special case, in which if we have a native filesystem handler, we call
+ * it first. This is because the root of Tcl's filesystem is always a
+ * native filesystem (i.e. '/' on unix is native).
*/
firstFsRecPtr = FsGetFirstFilesystem();
- fsRecPtr = firstFsRecPtr;
+ fsRecPtr = firstFsRecPtr;
while (fsRecPtr != NULL) {
- if (fsRecPtr == &nativeFilesystemRecord) {
+ if (fsRecPtr == &nativeFilesystemRecord) {
Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
if (proc != NULL) {
startAt = (*proc)(interp, pathPtr, startAt);
}
break;
- }
+ }
fsRecPtr = fsRecPtr->nextPtr;
}
-
+
fsRecPtr = firstFsRecPtr;
while (fsRecPtr != NULL) {
- /* Skip the native system next time through */
+ /*
+ * Skip the native system next time through.
+ */
+
if (fsRecPtr != &nativeFilesystemRecord) {
Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
if (proc != NULL) {
startAt = (*proc)(interp, pathPtr, startAt);
}
- /*
+
+ /*
* We could add an efficiency check like this:
- *
- * if (retVal == length-of(pathPtr)) {break;}
- *
+ * if (retVal == length-of(pathPtr)) {break;}
* but there's not much benefit.
*/
}
@@ -1411,16 +1453,15 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
*
* TclGetOpenMode --
*
- * Description:
- * This routine is an obsolete, limited version of
- * TclGetOpenModeEx() below. It exists only to satisfy any
- * extensions imprudently using it via Tcl's internal stubs table.
+ * This routine is an obsolete, limited version of TclGetOpenModeEx()
+ * below. It exists only to satisfy any extensions imprudently using it
+ * via Tcl's internal stubs table.
*
* Results:
- * Same as TclGetOpenModeEx().
+ * Same as TclGetOpenModeEx().
*
* Side effects:
- * Same as TclGetOpenModeEx().
+ * Same as TclGetOpenModeEx().
*
*---------------------------------------------------------------------------
*/
@@ -1429,11 +1470,11 @@ int
TclGetOpenMode(interp, modeString, seekFlagPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
- CONST char *modeString; /* Mode string, e.g. "r+" or
- * "RDONLY CREAT". */
- int *seekFlagPtr; /* Set this to 1 if the caller
- * should seek to EOF during the
- * opening of the file. */
+ CONST char *modeString; /* Mode string, e.g. "r+" or "RDONLY
+ * CREAT". */
+ int *seekFlagPtr; /* Set this to 1 if the caller should
+ * seek to EOF during the opening of
+ * the file. */
{
int binary = 0;
return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
@@ -1444,11 +1485,10 @@ TclGetOpenMode(interp, modeString, seekFlagPtr)
*
* TclGetOpenModeEx --
*
- * Description:
* Computes a POSIX mode mask for opening a file, from a given string,
- * and also sets flags to indicate whether the caller should seek to
- * EOF after opening the file, and whether the caller should
- * configure the channel for binary data.
+ * and also sets flags to indicate whether the caller should seek to EOF
+ * after opening the file, and whether the caller should configure the
+ * channel for binary data.
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
@@ -1456,38 +1496,39 @@ TclGetOpenMode(interp, modeString, seekFlagPtr)
* object to an error message.
*
* Side effects:
- * Sets the integer referenced by seekFlagPtr to 1 to tell the caller
- * to seek to EOF after opening the file, or to 0 otherwise. Sets the
- * integer referenced by binaryPtr to 1 to tell the caller to seek to
+ * Sets the integer referenced by seekFlagPtr to 1 to tell the caller to
+ * seek to EOF after opening the file, or to 0 otherwise. Sets the
+ * integer referenced by binaryPtr to 1 to tell the caller to seek to
* configure the channel for binary data, or to 0 otherwise.
*
* Special note:
- * This code is based on a prototype implementation contributed
- * by Mark Diekhans.
+ * This code is based on a prototype implementation contributed by Mark
+ * Diekhans.
*
*---------------------------------------------------------------------------
*/
+
int
TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
Tcl_Interp *interp; /* Interpreter to use for error
* reporting - may be NULL. */
- CONST char *modeString; /* Mode string, e.g. "r+" or
- * "RDONLY CREAT". */
- int *seekFlagPtr; /* Set this to 1 if the caller
- * should seek to EOF during the
- * opening of the file. */
- int *binaryPtr; /* Set this to 1 if the caller
- * should configure the opened
- * channel for binary operations */
+ CONST char *modeString; /* Mode string, e.g. "r+" or "RDONLY
+ * CREAT". */
+ int *seekFlagPtr; /* Set this to 1 if the caller should
+ * seek to EOF during the opening of
+ * the file. */
+ int *binaryPtr; /* Set this to 1 if the caller should
+ * configure the opened channel for
+ * binary operations */
{
int mode, modeArgc, c, i, gotRW;
CONST char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
/*
- * Check for the simpler fopen-like access modes (e.g. "r"). They
- * are distinguished from the POSIX access modes by the presence
- * of a lower-case first letter.
+ * Check for the simpler fopen-like access modes (e.g. "r"). They are
+ * distinguished from the POSIX access modes by the presence of a
+ * lower-case first letter.
*/
*seekFlagPtr = 0;
@@ -1502,26 +1543,25 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
if (!(modeString[0] & 0x80)
&& islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
switch (modeString[0]) {
- case 'r':
- mode = O_RDONLY;
- break;
- case 'w':
- mode = O_WRONLY|O_CREAT|O_TRUNC;
- break;
- case 'a':
- mode = O_WRONLY|O_CREAT;
- *seekFlagPtr = 1;
- break;
- default:
- error:
- *seekFlagPtr = 0;
- *binaryPtr = 0;
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "illegal access mode \"", modeString, "\"",
- (char *) NULL);
- }
- return -1;
+ case 'r':
+ mode = O_RDONLY;
+ break;
+ case 'w':
+ mode = O_WRONLY|O_CREAT|O_TRUNC;
+ break;
+ case 'a':
+ mode = O_WRONLY|O_CREAT;
+ *seekFlagPtr = 1;
+ break;
+ default:
+ error:
+ *seekFlagPtr = 0;
+ *binaryPtr = 0;
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "illegal access mode \"", modeString,
+ "\"", (char *) NULL);
+ }
+ return -1;
}
i=1;
while (i<3 && modeString[i]) {
@@ -1529,41 +1569,41 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
goto error;
}
switch (modeString[i++]) {
- case '+':
- mode &= ~(O_RDONLY|O_WRONLY);
- mode |= O_RDWR;
- break;
- case 'b':
- *binaryPtr = 1;
- break;
- default:
- goto error;
+ case '+':
+ mode &= ~(O_RDONLY|O_WRONLY);
+ mode |= O_RDWR;
+ break;
+ case 'b':
+ *binaryPtr = 1;
+ break;
+ default:
+ goto error;
}
}
if (modeString[i] != 0) {
goto error;
}
- return mode;
+ return mode;
}
/*
- * The access modes are specified using a list of POSIX modes
- * such as O_CREAT.
+ * The access modes are specified using a list of POSIX modes such as
+ * O_CREAT.
*
- * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
- * a NULL interpreter is passed in.
+ * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when a NULL
+ * interpreter is passed in.
*/
if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AddErrorInfo(interp,
- "\n while processing open access modes \"");
- Tcl_AddErrorInfo(interp, modeString);
- Tcl_AddErrorInfo(interp, "\"");
- }
- return -1;
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AddErrorInfo(interp,
+ "\n while processing open access modes \"");
+ Tcl_AddErrorInfo(interp, modeString);
+ Tcl_AddErrorInfo(interp, "\"");
+ }
+ return -1;
}
-
+
gotRW = 0;
for (i = 0; i < modeArgc; i++) {
flag = modeArgv[i];
@@ -1579,22 +1619,24 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
gotRW = 1;
} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
mode |= O_APPEND;
- *seekFlagPtr = 1;
+ *seekFlagPtr = 1;
} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
mode |= O_CREAT;
} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
mode |= O_EXCL;
+
} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
#ifdef O_NOCTTY
mode |= O_NOCTTY;
#else
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", (char *) NULL);
- }
- ckfree((char *) modeArgv);
+ Tcl_AppendResult(interp, "access mode \"", flag,
+ "\" not supported by this system", (char *) NULL);
+ }
+ ckfree((char *) modeArgv);
return -1;
#endif
+
} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
#if defined(O_NDELAY) || defined(O_NONBLOCK)
# ifdef O_NONBLOCK
@@ -1602,41 +1644,49 @@ TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
# else
mode |= O_NDELAY;
# endif
+
#else
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", (char *) NULL);
- }
- ckfree((char *) modeArgv);
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "access mode \"", flag,
+ "\" not supported by this system", (char *) NULL);
+ }
+ ckfree((char *) modeArgv);
return -1;
#endif
+
} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
mode |= O_TRUNC;
} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
*binaryPtr = 1;
} else {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "invalid access mode \"", flag,
+
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "invalid access mode \"", flag,
"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
"CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
(char *) NULL);
- }
+ }
ckfree((char *) modeArgv);
return -1;
}
}
+
ckfree((char *) modeArgv);
+
if (!gotRW) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "access mode must include either",
- " RDONLY, WRONLY, or RDWR", (char *) NULL);
- }
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_AppendResult(interp, "access mode must include either",
+ " RDONLY, WRONLY, or RDWR", (char *) NULL);
+ }
return -1;
}
return mode;
}
-/* Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument */
+/*
+ * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
+ */
+
int
Tcl_FSEvalFile(interp, pathPtr)
Tcl_Interp *interp; /* Interpreter in which to process file. */
@@ -1651,18 +1701,17 @@ Tcl_FSEvalFile(interp, pathPtr)
*
* Tcl_FSEvalFileEx --
*
- * Read in a file and process the entire file as one gigantic
- * Tcl command.
+ * Read in a file and process the entire file as one gigantic Tcl
+ * command.
*
* Results:
- * A standard Tcl result, which is either the result of executing
- * the file or an error indicating why the file couldn't be read.
+ * A standard Tcl result, which is either the result of executing the
+ * file or an error indicating why the file couldn't be read.
*
* Side effects:
- * Depends on the commands in the file. During the evaluation
- * of the contents of the file, iPtr->scriptFile is made to
- * point to pathPtr (the old value is cached and replaced when
- * this function returns).
+ * Depends on the commands in the file. During the evaluation of the
+ * contents of the file, iPtr->scriptFile is made to point to pathPtr
+ * (the old value is cached and replaced when this function returns).
*
*----------------------------------------------------------------------
*/
@@ -1672,8 +1721,8 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
Tcl_Interp *interp; /* Interpreter in which to process file. */
Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution
* will be performed on this name. */
- CONST char *encodingName; /* If non-NULL, then use this encoding
- * for the file. */
+ CONST char *encodingName; /* If non-NULL, then use this encoding for the
+ * file. */
{
int result, length;
Tcl_StatBuf statBuf;
@@ -1691,31 +1740,33 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
objPtr = Tcl_NewObj();
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
- Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"",
+ Tcl_SetErrno(errno);
+ Tcl_AppendResult(interp, "couldn't read file \"",
Tcl_GetString(pathPtr),
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == (Tcl_Channel) NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"",
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't read file \"",
Tcl_GetString(pathPtr),
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
+
/*
- * The eofchar is \32 (^Z). This is the usual on Windows, but we
- * effect this cross-platform to allow for scripted documents.
- * [Bug: 2040]
+ * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
+ * this cross-platform to allow for scripted documents. [Bug: 2040]
*/
+
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
+
/*
- * If the encoding is specified, set it for the channel.
- * Else don't touch it (and use the system encoding)
- * Report error on unknown encoding.
+ * If the encoding is specified, set it for the channel. Else don't touch
+ * it (and use the system encoding) Report error on unknown encoding.
*/
+
if (encodingName != NULL) {
if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
!= TCL_OK) {
@@ -1723,15 +1774,17 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
goto end;
}
}
+
if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
- Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
+ Tcl_Close(interp, chan);
+ Tcl_AppendResult(interp, "couldn't read file \"",
Tcl_GetString(pathPtr),
"\": ", Tcl_PosixError(interp), (char *) NULL);
goto end;
}
+
if (Tcl_Close(interp, chan) != TCL_OK) {
- goto end;
+ goto end;
}
iPtr = (Interp *) interp;
@@ -1740,11 +1793,13 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
Tcl_IncrRefCount(iPtr->scriptFile);
string = Tcl_GetStringFromObj(objPtr, &length);
result = Tcl_EvalEx(interp, string, length, 0);
- /*
+
+ /*
* Now we have to be careful; the script may have changed the
- * iPtr->scriptFile value, so we must reset it without
- * assuming it still points to 'pathPtr'.
+ * iPtr->scriptFile value, so we must reset it without assuming it still
+ * points to 'pathPtr'.
*/
+
if (iPtr->scriptFile != NULL) {
Tcl_DecrRefCount(iPtr->scriptFile);
}
@@ -1753,7 +1808,6 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
} else if (result == TCL_ERROR) {
-
/*
* Record information telling where the error occurred.
*/
@@ -1772,7 +1826,7 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
Tcl_DecrRefCount(msg);
}
- end:
+ end:
Tcl_DecrRefCount(objPtr);
return result;
}
@@ -1783,15 +1837,15 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
* Tcl_GetErrno --
*
* Gets the current value of the Tcl error code variable. This is
- * currently the global variable "errno" but could in the future
- * change to something else.
+ * currently the global variable "errno" but could in the future change
+ * to something else.
*
* Results:
* The value of the Tcl error code variable.
*
* Side effects:
- * None. Note that the value of the Tcl error code variable is
- * UNDEFINED if a call to Tcl_SetErrno did not precede this call.
+ * None. Note that the value of the Tcl error code variable is UNDEFINED
+ * if a call to Tcl_SetErrno did not precede this call.
*
*----------------------------------------------------------------------
*/
@@ -1830,14 +1884,13 @@ Tcl_SetErrno(err)
*
* Tcl_PosixError --
*
- * This procedure is typically called after UNIX kernel calls
- * return errors. It stores machine-readable information about
- * the error in errorCode field of interp and returns an
- * information string for the caller's use.
+ * This procedure is typically called after UNIX kernel calls return
+ * errors. It stores machine-readable information about the error in
+ * errorCode field of interp and returns an information string for the
+ * caller's use.
*
* Results:
- * The return value is a human-readable string describing the
- * error.
+ * The return value is a human-readable string describing the error.
*
* Side effects:
* The errorCode field of the interp is set.
@@ -1847,7 +1900,7 @@ Tcl_SetErrno(err)
CONST char *
Tcl_PosixError(interp)
- Tcl_Interp *interp; /* Interpreter whose errorCode field
+ Tcl_Interp *interp; /* Interpreter whose errorCode field
* is to be set. */
{
CONST char *id, *msg;
@@ -1864,15 +1917,15 @@ Tcl_PosixError(interp)
* Tcl_FSStat --
*
* This procedure replaces the library version of stat and lsat.
- *
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ *
+ * The appropriate function for the filesystem to which pathPtr belongs
+ * will be called.
*
* Results:
- * See stat documentation.
+ * See stat documentation.
*
* Side effects:
- * See stat documentation.
+ * See stat documentation.
*
*----------------------------------------------------------------------
*/
@@ -1888,12 +1941,12 @@ Tcl_FSStat(pathPtr, buf)
int retVal = -1;
/*
- * Call each of the "stat" function in succession. A non-return
- * value of -1 indicates the particular function has succeeded.
+ * Call each of the "stat" function in succession. A non-return value of
+ * -1 indicates the particular function has succeeded.
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
-
+
if (statProcList != NULL) {
StatProc *statProcPtr;
char *path;
@@ -1913,13 +1966,14 @@ Tcl_FSStat(pathPtr, buf)
Tcl_DecrRefCount(transPtr);
}
}
-
+
Tcl_MutexUnlock(&obsoleteFsHookMutex);
if (retVal != -1) {
/*
- * Note that EOVERFLOW is not a problem here, and these
- * assignments should all be widening (if not identity.)
+ * Note that EOVERFLOW is not a problem here, and these assignments
+ * should all be widening (if not identity.)
*/
+
buf->st_mode = oldStyleStatBuffer.st_mode;
buf->st_ino = oldStyleStatBuffer.st_ino;
buf->st_dev = oldStyleStatBuffer.st_dev;
@@ -1935,9 +1989,10 @@ Tcl_FSStat(pathPtr, buf)
buf->st_blksize = oldStyleStatBuffer.st_blksize;
buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
#endif
- return retVal;
+ return retVal;
}
#endif /* USE_OBSOLETE_FS_HOOKS */
+
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
Tcl_FSStatProc *proc = fsPtr->statProc;
@@ -1954,17 +2009,16 @@ Tcl_FSStat(pathPtr, buf)
*
* Tcl_FSLstat --
*
- * This procedure replaces the library version of lstat.
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called. If no 'lstat' function is listed,
- * but a 'stat' function is, then Tcl will fall back on the
- * stat function.
+ * This procedure replaces the library version of lstat. The appropriate
+ * function for the filesystem to which pathPtr belongs will be called.
+ * If no 'lstat' function is listed, but a 'stat' function is, then Tcl
+ * will fall back on the stat function.
*
* Results:
- * See lstat documentation.
+ * See lstat documentation.
*
* Side effects:
- * See lstat documentation.
+ * See lstat documentation.
*
*----------------------------------------------------------------------
*/
@@ -1995,15 +2049,15 @@ Tcl_FSLstat(pathPtr, buf)
*
* Tcl_FSAccess --
*
- * This procedure replaces the library version of access.
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ * This procedure replaces the library version of access. The
+ * appropriate function for the filesystem to which pathPtr belongs will
+ * be called.
*
* Results:
- * See access documentation.
+ * See access documentation.
*
* Side effects:
- * See access documentation.
+ * See access documentation.
*
*----------------------------------------------------------------------
*/
@@ -2011,15 +2065,15 @@ Tcl_FSLstat(pathPtr, buf)
int
Tcl_FSAccess(pathPtr, mode)
Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */
- int mode; /* Permission setting. */
+ int mode; /* Permission setting. */
{
Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
int retVal = -1;
/*
- * Call each of the "access" function in succession. A non-return
- * value of -1 indicates the particular function has succeeded.
+ * Call each of the "access" function in succession. A non-return value
+ * of -1 indicates the particular function has succeeded.
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -2043,12 +2097,13 @@ Tcl_FSAccess(pathPtr, mode)
Tcl_DecrRefCount(transPtr);
}
}
-
+
Tcl_MutexUnlock(&obsoleteFsHookMutex);
if (retVal != -1) {
return retVal;
}
#endif /* USE_OBSOLETE_FS_HOOKS */
+
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
Tcl_FSAccessProc *proc = fsPtr->accessProc;
@@ -2066,38 +2121,36 @@ Tcl_FSAccess(pathPtr, mode)
*
* Tcl_FSOpenFileChannel --
*
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ * The appropriate function for the filesystem to which pathPtr belongs
+ * will be called.
*
* Results:
* The new channel or NULL, if the named file could not be opened.
*
* Side effects:
- * May open the channel and may cause creation of a file on the
- * file system.
+ * May open the channel and may cause creation of a file on the file
+ * system.
*
*----------------------------------------------------------------------
*/
-
+
Tcl_Channel
Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
- Tcl_Interp *interp; /* Interpreter for error reporting;
- * can be NULL. */
- Tcl_Obj *pathPtr; /* Name of file to open. */
- CONST char *modeString; /* A list of POSIX open modes or
- * a string such as "rw". */
- int permissions; /* If the open involves creating a
- * file, with what modes to create
- * it? */
+ Tcl_Interp *interp; /* Interpreter for error reporting; can be
+ * NULL. */
+ Tcl_Obj *pathPtr; /* Name of file to open. */
+ CONST char *modeString; /* A list of POSIX open modes or a string such
+ * as "rw". */
+ int permissions; /* If the open involves creating a file, with
+ * what modes to create it? */
{
Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
Tcl_Channel retVal = NULL;
/*
- * Call each of the "Tcl_OpenFileChannel" functions in succession.
- * A non-NULL return value indicates the particular function has
- * succeeded.
+ * Call each of the "Tcl_OpenFileChannel" functions in succession. A
+ * non-NULL return value indicates the particular function has succeeded.
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -2105,7 +2158,7 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
OpenFileChannelProc *openFileChannelProcPtr;
char *path;
Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
-
+
if (transPtr == NULL) {
path = NULL;
} else {
@@ -2113,10 +2166,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
}
openFileChannelProcPtr = openFileChannelProcList;
-
+
while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
retVal = (*openFileChannelProcPtr->proc)(interp, path,
- modeString, permissions);
+ modeString, permissions);
openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
}
if (transPtr != NULL) {
@@ -2128,34 +2181,37 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
return retVal;
}
#endif /* USE_OBSOLETE_FS_HOOKS */
-
- /*
- * We need this just to ensure we return the correct error messages
- * under some circumstances.
+
+ /*
+ * We need this just to ensure we return the correct error messages under
+ * some circumstances.
*/
+
if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
- return NULL;
+ return NULL;
}
-
+
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
if (proc != NULL) {
int mode, seekFlag, binary;
+
mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
if (mode == -1) {
- return NULL;
+ return NULL;
}
+
retVal = (*proc)(interp, pathPtr, mode, permissions);
if (retVal != NULL) {
if (seekFlag) {
- if (Tcl_Seek(retVal, (Tcl_WideInt)0,
- SEEK_END) < (Tcl_WideInt)0) {
+ if (Tcl_Seek(retVal, (Tcl_WideInt)0,
+ SEEK_END) < (Tcl_WideInt)0) {
if (interp != (Tcl_Interp *) NULL) {
Tcl_AppendResult(interp,
"could not seek to end of file while opening \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
}
Tcl_Close(NULL, retVal);
return NULL;
@@ -2169,12 +2225,15 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
return retVal;
}
}
- /* File doesn't belong to any filesystem that can open it */
+
+ /*
+ * File doesn't belong to any filesystem that can open it.
+ */
+
Tcl_SetErrno(ENOENT);
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
@@ -2184,24 +2243,23 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
*
* Tcl_FSUtime --
*
- * This procedure replaces the library version of utime.
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ * This procedure replaces the library version of utime. The appropriate
+ * function for the filesystem to which pathPtr belongs will be called.
*
* Results:
- * See utime documentation.
+ * See utime documentation.
*
* Side effects:
- * See utime documentation.
+ * See utime documentation.
*
*----------------------------------------------------------------------
*/
-int
-Tcl_FSUtime (pathPtr, tval)
- Tcl_Obj *pathPtr; /* File to change access/modification times */
- struct utimbuf *tval; /* Structure containing access/modification
- * times to use. Should not be modified. */
+int
+Tcl_FSUtime(pathPtr, tval)
+ Tcl_Obj *pathPtr; /* File to change access/modification times */
+ struct utimbuf *tval; /* Structure containing access/modification
+ * times to use. Should not be modified. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -2218,17 +2276,17 @@ Tcl_FSUtime (pathPtr, tval)
*
* NativeFileAttrStrings --
*
- * This procedure implements the platform dependent 'file
- * attributes' subcommand, for the native filesystem, for listing
- * the set of possible attribute strings. This function is part
- * of Tcl's native filesystem support, and is placed here because
- * it is shared by Unix and Windows code.
+ * This procedure implements the platform dependent 'file attributes'
+ * subcommand, for the native filesystem, for listing the set of possible
+ * attribute strings. This function is part of Tcl's native filesystem
+ * support, and is placed here because it is shared by Unix and Windows
+ * code.
*
* Results:
- * An array of strings
+ * An array of strings
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -2246,21 +2304,19 @@ NativeFileAttrStrings(pathPtr, objPtrRef)
*
* NativeFileAttrsGet --
*
- * This procedure implements the platform dependent
- * 'file attributes' subcommand, for the native
- * filesystem, for 'get' operations. This function is part
- * of Tcl's native filesystem support, and is placed here
- * because it is shared by Unix and Windows code.
+ * This procedure implements the platform dependent 'file attributes'
+ * subcommand, for the native filesystem, for 'get' operations. This
+ * function is part of Tcl's native filesystem support, and is placed
+ * here because it is shared by Unix and Windows code.
*
* Results:
- * Standard Tcl return code. The object placed in objPtrRef
- * (if TCL_OK was returned) is likely to have a refCount of zero.
- * Either way we must either store it somewhere (e.g. the Tcl
- * result), or Incr/Decr its refCount to ensure it is properly
- * freed.
+ * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ * was returned) is likely to have a refCount of zero. Either way we
+ * must either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ * refCount to ensure it is properly freed.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -2272,8 +2328,8 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
Tcl_Obj *pathPtr; /* path of file we are operating on. */
Tcl_Obj **objPtrRef; /* for output. */
{
- return (*tclpFileAttrProcs[index].getProc)(interp, index,
- pathPtr, objPtrRef);
+ return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
+ objPtrRef);
}
/*
@@ -2281,17 +2337,16 @@ NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
*
* NativeFileAttrsSet --
*
- * This procedure implements the platform dependent
- * 'file attributes' subcommand, for the native
- * filesystem, for 'set' operations. This function is part
- * of Tcl's native filesystem support, and is placed here
- * because it is shared by Unix and Windows code.
+ * This procedure implements the platform dependent 'file attributes'
+ * subcommand, for the native filesystem, for 'set' operations. This
+ * function is part of Tcl's native filesystem support, and is placed
+ * here because it is shared by Unix and Windows code.
*
* Results:
- * Standard Tcl return code.
+ * Standard Tcl return code.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -2303,8 +2358,7 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
Tcl_Obj *pathPtr; /* path of file we are operating on. */
Tcl_Obj *objPtr; /* set to this value. */
{
- return (*tclpFileAttrProcs[index].setProc)(interp, index,
- pathPtr, objPtr);
+ return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
}
/*
@@ -2312,30 +2366,29 @@ NativeFileAttrsSet(interp, index, pathPtr, objPtr)
*
* Tcl_FSFileAttrStrings --
*
- * This procedure implements part of the hookable 'file
- * attributes' subcommand. The appropriate function for the
- * filesystem to which pathPtr belongs will be called.
+ * This procedure implements part of the hookable 'file attributes'
+ * subcommand. The appropriate function for the filesystem to which
+ * pathPtr belongs will be called.
*
* Results:
- * The called procedure may either return an array of strings,
- * or may instead return NULL and place a Tcl list into the
- * given objPtrRef. Tcl will take that list and first increment
- * its refCount before using it. On completion of that use, Tcl
- * will decrement its refCount. Hence if the list should be
- * disposed of by Tcl when done, it should have a refCount of zero,
- * and if the list should not be disposed of, the filesystem
- * should ensure it retains a refCount on the object.
+ * The called procedure may either return an array of strings, or may
+ * instead return NULL and place a Tcl list into the given objPtrRef.
+ * Tcl will take that list and first increment its refCount before using
+ * it. On completion of that use, Tcl will decrement its refCount. Hence
+ * if the list should be disposed of by Tcl when done, it should have a
+ * refCount of zero, and if the list should not be disposed of, the
+ * filesystem should ensure it retains a refCount on the object.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
CONST char **
Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
- Tcl_Obj* pathPtr;
- Tcl_Obj** objPtrRef;
+ Tcl_Obj *pathPtr;
+ Tcl_Obj **objPtrRef;
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -2353,8 +2406,8 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
*
* TclFSFileAttrIndex --
*
- * Helper function for converting an attribute name to an index
- * into the attribute table.
+ * Helper function for converting an attribute name to an index into the
+ * attribute table.
*
* Results:
* Tcl result code, index written to *indexPtr on result==TCL_OK
@@ -2404,7 +2457,7 @@ TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
* It's a non-constant attribute list, so do a literal search.
*/
- int i, objc;
+ int i, objc;
Tcl_Obj **objv;
if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
@@ -2431,19 +2484,17 @@ TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
* Tcl_FSFileAttrsGet --
*
* This procedure implements read access for the hookable 'file
- * attributes' subcommand. The appropriate function for the
- * filesystem to which pathPtr belongs will be called.
+ * attributes' subcommand. The appropriate function for the filesystem
+ * to which pathPtr belongs will be called.
*
* Results:
- * Standard Tcl return code. The object placed in objPtrRef
- * (if TCL_OK was returned) is likely to have a refCount of zero.
- * Either way we must either store it somewhere (e.g. the Tcl
- * result), or Incr/Decr its refCount to ensure it is properly
- * freed.
-
+ * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ * was returned) is likely to have a refCount of zero. Either way we
+ * must either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ * refCount to ensure it is properly freed.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -2472,14 +2523,14 @@ Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
* Tcl_FSFileAttrsSet --
*
* This procedure implements write access for the hookable 'file
- * attributes' subcommand. The appropriate function for the
- * filesystem to which pathPtr belongs will be called.
+ * attributes' subcommand. The appropriate function for the filesystem
+ * to which pathPtr belongs will be called.
*
* Results:
- * Standard Tcl return code.
+ * Standard Tcl return code.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -2508,34 +2559,32 @@ Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
* Tcl_FSGetCwd --
*
* This function replaces the library version of getcwd().
- *
- * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains
- * its own record (in a Tcl_Obj) of the cwd, and an attempt
- * is made to synchronise this with the cwd's containing filesystem,
- * if that filesystem provides a cwdProc (e.g. the native filesystem).
- *
- * Note that if Tcl's cwd is not in the native filesystem, then of
- * course Tcl's cwd and the native cwd are different: extensions
- * should therefore ensure they only access the cwd through this
- * function to avoid confusion.
- *
+ *
+ * Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its
+ * own record (in a Tcl_Obj) of the cwd, and an attempt is made to
+ * synchronise this with the cwd's containing filesystem, if that
+ * filesystem provides a cwdProc (e.g. the native filesystem).
+ *
+ * Note that if Tcl's cwd is not in the native filesystem, then of course
+ * Tcl's cwd and the native cwd are different: extensions should
+ * therefore ensure they only access the cwd through this function to
+ * avoid confusion.
+ *
* If a global cwdPathPtr already exists, it is cached in the thread's
* private data structures and reference to the cached copy is returned,
* subject to a synchronisation attempt in that cwdPathPtr's fs.
- *
- * Otherwise, the chain of functions that have been "inserted"
- * into the filesystem will be called in succession until either a
- * value other than NULL is returned, or the entire list is
- * visited.
+ *
+ * Otherwise, the chain of functions that have been "inserted" into the
+ * filesystem will be called in succession until either a value other
+ * than NULL is returned, or the entire list is visited.
*
* Results:
- * The result is a pointer to a Tcl_Obj specifying the current
- * directory, or NULL if the current directory could not be
- * determined. If NULL is returned, an error message is left in the
- * interp's result.
- *
- * The result already has its refCount incremented for the caller.
- * When it is no longer needed, that refCount should be decremented.
+ * The result is a pointer to a Tcl_Obj specifying the current directory,
+ * or NULL if the current directory could not be determined. If NULL is
+ * returned, an error message is left in the interp's result.
+ *
+ * The result already has its refCount incremented for the caller. When
+ * it is no longer needed, that refCount should be decremented.
*
* Side effects:
* Various objects may be freed and allocated.
@@ -2548,16 +2597,15 @@ Tcl_FSGetCwd(interp)
Tcl_Interp *interp;
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
+
if (TclFSCwdPointerEquals(NULL)) {
FilesystemRecord *fsRecPtr;
Tcl_Obj *retVal = NULL;
- /*
- * We've never been called before, try to find a cwd. Call
- * each of the "Tcl_GetCwd" function in succession. A non-NULL
- * return value indicates the particular function has
- * succeeded.
+ /*
+ * We've never been called before, try to find a cwd. Call each of
+ * the "Tcl_GetCwd" function in succession. A non-NULL return value
+ * indicates the particular function has succeeded.
*/
fsRecPtr = FsGetFirstFilesystem();
@@ -2567,27 +2615,30 @@ Tcl_FSGetCwd(interp)
if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
ClientData retCd;
TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
+
retCd = (*proc2)(NULL);
if (retCd != NULL) {
Tcl_Obj *norm;
/* Looks like a new current directory */
- retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(retCd);
+ retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
+ retCd);
Tcl_IncrRefCount(retVal);
- norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+ norm = TclFSNormalizeAbsolutePath(interp,retVal,NULL);
if (norm != NULL) {
- /*
- * We found a cwd, which is now in our global storage.
- * We must make a copy. Norm already has a refCount of 1.
- *
- * Threading issue: note that multiple threads at system
- * startup could in principle call this procedure
- * simultaneously. They will therefore each set the
- * cwdPathPtr independently. That behaviour is a bit
- * peculiar, but should be fine. Once we have a cwd,
- * we'll always be in the 'else' branch below which
- * is simpler.
+ /*
+ * We found a cwd, which is now in our global
+ * storage. We must make a copy. Norm already has
+ * a refCount of 1.
+ *
+ * Threading issue: note that multiple threads at
+ * system startup could in principle call this
+ * procedure simultaneously. They will therefore
+ * each set the cwdPathPtr independently. That
+ * behaviour is a bit peculiar, but should be
+ * fine. Once we have a cwd, we'll always be in
+ * the 'else' branch below which is simpler.
*/
+
FsUpdateCwd(norm, retCd);
Tcl_DecrRefCount(norm);
} else {
@@ -2609,29 +2660,31 @@ Tcl_FSGetCwd(interp)
}
fsRecPtr = fsRecPtr->nextPtr;
}
- /*
- * Now the 'cwd' may NOT be normalized, at least on some
- * platforms. For the sake of efficiency, we want a completely
- * normalized cwd at all times.
- *
- * Finally, if retVal is NULL, we do not have a cwd, which
- * could be problematic.
+
+ /*
+ * Now the 'cwd' may NOT be normalized, at least on some platforms.
+ * For the sake of efficiency, we want a completely normalized cwd at
+ * all times.
+ *
+ * Finally, if retVal is NULL, we do not have a cwd, which could be
+ * problematic.
*/
+
if (retVal != NULL) {
Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
if (norm != NULL) {
- /*
- * We found a cwd, which is now in our global storage.
- * We must make a copy. Norm already has a refCount of 1.
- *
+ /*
+ * We found a cwd, which is now in our global storage. We
+ * must make a copy. Norm already has a refCount of 1.
+ *
* Threading issue: note that multiple threads at system
- * startup could in principle call this procedure
+ * startup could in principle call this procedure
* simultaneously. They will therefore each set the
* cwdPathPtr independently. That behaviour is a bit
- * peculiar, but should be fine. Once we have a cwd,
- * we'll always be in the 'else' branch below which
- * is simpler.
+ * peculiar, but should be fine. Once we have a cwd, we'll
+ * always be in the 'else' branch below which is simpler.
*/
+
ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
Tcl_DecrRefCount(norm);
@@ -2639,23 +2692,24 @@ Tcl_FSGetCwd(interp)
Tcl_DecrRefCount(retVal);
}
} else {
- /*
- * We already have a cwd cached, but we want to give the
- * filesystem it is in a chance to check whether that cwd
- * has changed, or is perhaps no longer accessible. This
- * allows an error to be thrown if, say, the permissions on
- * that directory have changed.
+ /*
+ * We already have a cwd cached, but we want to give the filesystem it
+ * is in a chance to check whether that cwd has changed, or is perhaps
+ * no longer accessible. This allows an error to be thrown if, say,
+ * the permissions on that directory have changed.
*/
+
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
- /*
- * If the filesystem couldn't be found, or if no cwd function
- * exists for this filesystem, then we simply assume the cached
- * cwd is ok. If we do call a cwd, we must watch for errors
- * (if the cwd returns NULL). This ensures that, say, on Unix
- * if the permissions of the cwd change, 'pwd' does actually
- * throw the correct error in Tcl. (This is tested for in the
- * test suite on unix).
+
+ /*
+ * If the filesystem couldn't be found, or if no cwd function exists
+ * for this filesystem, then we simply assume the cached cwd is ok.
+ * If we do call a cwd, we must watch for errors (if the cwd returns
+ * NULL). This ensures that, say, on Unix if the permissions of the
+ * cwd change, 'pwd' does actually throw the correct error in Tcl.
+ * (This is tested for in the test suite on unix).
*/
+
if (fsPtr != NULL) {
Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
ClientData retCd = NULL;
@@ -2663,32 +2717,37 @@ Tcl_FSGetCwd(interp)
Tcl_Obj *retVal;
if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;
-
+
retCd = (*proc2)(tsdPtr->cwdClientData);
if (retCd == NULL && interp != NULL) {
Tcl_AppendResult(interp,
"error getting working directory name: ",
Tcl_PosixError(interp), (char *) NULL);
}
-
+
if (retCd == tsdPtr->cwdClientData) {
goto cdDidNotChange;
}
-
- /* Looks like a new current directory */
+
+ /*
+ * Looks like a new current directory.
+ */
+
retVal = (*fsPtr->internalToNormalizedProc)(retCd);
Tcl_IncrRefCount(retVal);
} else {
retVal = (*proc)(interp);
}
if (retVal != NULL) {
- Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal,
- NULL);
- /*
- * Check whether cwd has changed from the value
- * previously stored in cwdPathPtr. Really 'norm'
- * shouldn't be null, but we are careful.
+ Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp,
+ retVal, NULL);
+
+ /*
+ * Check whether cwd has changed from the value previously
+ * stored in cwdPathPtr. Really 'norm' shouldn't be null,
+ * but we are careful.
*/
+
if (norm == NULL) {
/* Do nothing */
if (retCd != NULL) {
@@ -2697,27 +2756,29 @@ Tcl_FSGetCwd(interp)
} else if (norm == tsdPtr->cwdPathPtr) {
goto cdEqual;
} else {
- /*
- * Note that both 'norm' and
- * 'tsdPtr->cwdPathPtr' are normalized paths.
- * Therefore we can be more efficient than
- * calling 'Tcl_FSEqualPaths', and in addition
- * avoid a nasty infinite loop bug when trying
- * to normalize tsdPtr->cwdPathPtr.
+ /*
+ * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
+ * normalized paths. Therefore we can be more
+ * efficient than calling 'Tcl_FSEqualPaths', and in
+ * addition avoid a nasty infinite loop bug when
+ * trying to normalize tsdPtr->cwdPathPtr.
*/
+
int len1, len2;
char *str1, *str2;
+
str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
str2 = Tcl_GetStringFromObj(norm, &len2);
if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
- /*
+ /*
* If the paths were equal, we can be more
- * efficient and retain the old path object
- * which will probably already be shared. In
- * this case we can simply free the normalized
- * path we just calculated.
+ * efficient and retain the old path object which
+ * will probably already be shared. In this case
+ * we can simply free the normalized path we just
+ * calculated.
*/
- cdEqual:
+
+ cdEqual:
Tcl_DecrRefCount(norm);
if (retCd != NULL) {
(*fsPtr->freeInternalRepProc)(retCd);
@@ -2735,13 +2796,13 @@ Tcl_FSGetCwd(interp)
}
}
}
-
+
cdDidNotChange:
if (tsdPtr->cwdPathPtr != NULL) {
Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
}
-
- return tsdPtr->cwdPathPtr;
+
+ return tsdPtr->cwdPathPtr;
}
/*
@@ -2750,132 +2811,136 @@ Tcl_FSGetCwd(interp)
* Tcl_FSChdir --
*
* This function replaces the library version of chdir().
- *
- * The path is normalized and then passed to the filesystem
- * which claims it.
+ *
+ * The path is normalized and then passed to the filesystem which claims
+ * it.
*
* Results:
- * See chdir() documentation. If successful, we keep a
- * record of the successful path in cwdPathPtr for subsequent
- * calls to getcwd.
+ * See chdir() documentation. If successful, we keep a record of the
+ * successful path in cwdPathPtr for subsequent calls to getcwd.
*
* Side effects:
- * See chdir() documentation. The global cwdPathPtr may
- * change value.
+ * See chdir() documentation. The global cwdPathPtr may change value.
*
*----------------------------------------------------------------------
*/
+
int
Tcl_FSChdir(pathPtr)
Tcl_Obj *pathPtr;
{
Tcl_Filesystem *fsPtr;
int retVal = -1;
-
+
if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
Tcl_SetErrno(ENOENT);
- return (retVal);
+ return retVal;
}
-
+
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
Tcl_FSChdirProc *proc = fsPtr->chdirProc;
if (proc != NULL) {
- /*
- * If this fails, an appropriate errno will have
- * been stored using 'Tcl_SetErrno()'.
+ /*
+ * If this fails, an appropriate errno will have been stored using
+ * 'Tcl_SetErrno()'.
*/
+
retVal = (*proc)(pathPtr);
} else {
- /* Fallback on stat-based implementation */
+ /*
+ * Fallback on stat-based implementation.
+ */
+
Tcl_StatBuf buf;
- /*
- * If the file can be stat'ed and is a directory and is
- * readable, then we can chdir. If any of these actions
- * fail, then 'Tcl_SetErrno()' should automatically have
- * been called to set an appropriate error code
+
+ /*
+ * If the file can be stat'ed and is a directory and is readable,
+ * then we can chdir. If any of these actions fail, then
+ * 'Tcl_SetErrno()' should automatically have been called to set
+ * an appropriate error code
*/
- if ((Tcl_FSStat(pathPtr, &buf) == 0)
- && (S_ISDIR(buf.st_mode))
- && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
- /* We allow the chdir */
+
+ if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode))
+ && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
+ /*
+ * We allow the chdir.
+ */
+
retVal = 0;
}
}
} else {
Tcl_SetErrno(ENOENT);
}
-
- /*
- * The cwd changed, or an error was thrown. If an error was
- * thrown, we can just continue (and that will report the error
- * to the user). If there was no error we must assume that the
- * cwd was actually changed to the normalized value we
- * calculated above, and we must therefore cache that
- * information.
+
+ /*
+ * The cwd changed, or an error was thrown. If an error was thrown, we
+ * can just continue (and that will report the error to the user). If
+ * there was no error we must assume that the cwd was actually changed to
+ * the normalized value we calculated above, and we must therefore cache
+ * that information.
*/
/*
- * If the filesystem in question has a getCwdProc, then the
- * correct logic which performs the part below is already part
- * of the Tcl_FSGetCwd() call, so no need to replicate it again.
- * This will have a side effect though. The private
- * authoritative representation of the current working directory
- * stored in cwdPathPtr in static memory will be out-of-sync
- * with the real OS-maintained value. The first call to
- * Tcl_FSGetCwd will however recalculate the private copy to
- * match the OS-value so everything will work right.
- *
- * However, if there is no getCwdProc, then we _must_ update
- * our private storage of the cwd, since this is the only
- * opportunity to do that!
- *
- * Note: We currently call this block of code irrespective of
- * whether there was a getCwdProc or not, but the code should
- * all in principle work if we only call this block if
- * fsPtr->getCwdProc == NULL.
+ * If the filesystem in question has a getCwdProc, then the correct logic
+ * which performs the part below is already part of the Tcl_FSGetCwd()
+ * call, so no need to replicate it again. This will have a side effect
+ * though. The private authoritative representation of the current
+ * working directory stored in cwdPathPtr in static memory will be
+ * out-of-sync with the real OS-maintained value. The first call to
+ * Tcl_FSGetCwd will however recalculate the private copy to match the
+ * OS-value so everything will work right.
+ *
+ * However, if there is no getCwdProc, then we _must_ update our private
+ * storage of the cwd, since this is the only opportunity to do that!
+ *
+ * Note: We currently call this block of code irrespective of whether
+ * there was a getCwdProc or not, but the code should all in principle
+ * work if we only call this block if fsPtr->getCwdProc == NULL.
*/
if (retVal == 0) {
- /*
- * Note that this normalized path may be different to what
- * we found above (or at least a different object), if the
- * filesystem epoch changed recently. This can actually
- * happen with scripted documents very easily. Therefore
- * we ask for the normalized path again (the correct value
- * will have been cached as a result of the
+ /*
+ * Note that this normalized path may be different to what we found
+ * above (or at least a different object), if the filesystem epoch
+ * changed recently. This can actually happen with scripted documents
+ * very easily. Therefore we ask for the normalized path again (the
+ * correct value will have been cached as a result of the
* Tcl_FSGetFileSystemForPath call above anyway).
*/
+
Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+
if (normDirName == NULL) {
/* Not really true, but what else to do? */
- Tcl_SetErrno(ENOENT);
+ Tcl_SetErrno(ENOENT);
return -1;
}
+
if (fsPtr == &tclNativeFilesystem) {
- /*
- * For the native filesystem, we keep a cache of the
- * native representation of the cwd. But, we want to do
- * that for the exact format that is returned by
- * 'getcwd' (so that we can later compare the two
- * representations for equality), which might not be
- * exactly the same char-string as the native
- * representation of the fully normalized path (e.g. on
- * Windows there's a forward-slash vs backslash
- * difference). Hence we ask for this again here. On
- * Unix it might actually be true that we always have
- * the correct form in the native rep in which case we
- * could simply use:
- *
- * cd = Tcl_FSGetNativePath(pathPtr);
- *
- * instead. This should be examined by someone on
- * Unix.
+ /*
+ * For the native filesystem, we keep a cache of the native
+ * representation of the cwd. But, we want to do that for the
+ * exact format that is returned by 'getcwd' (so that we can later
+ * compare the two representations for equality), which might not
+ * be exactly the same char-string as the native representation of
+ * the fully normalized path (e.g. on Windows there's a
+ * forward-slash vs backslash difference). Hence we ask for this
+ * again here. On Unix it might actually be true that we always
+ * have the correct form in the native rep in which case we could
+ * simply use:
+ * cd = Tcl_FSGetNativePath(pathPtr);
+ * instead. This should be examined by someone on Unix.
*/
+
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
ClientData cd;
- /* Assumption we are using a filesystem version 2 */
+ /*
+ * Assumption we are using a filesystem version 2.
+ */
+
TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
cd = (*proc2)(tsdPtr->cwdClientData);
FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd));
@@ -2883,8 +2948,8 @@ Tcl_FSChdir(pathPtr)
FsUpdateCwd(normDirName, NULL);
}
}
-
- return (retVal);
+
+ return retVal;
}
/*
@@ -2892,75 +2957,74 @@ Tcl_FSChdir(pathPtr)
*
* Tcl_FSLoadFile --
*
- * Dynamically loads a binary code file into memory and returns
- * the addresses of two procedures within that file, if they are
- * defined. The appropriate function for the filesystem to which
- * pathPtr belongs will be called.
- *
- * Note that the native filesystem doesn't actually assume 'pathPtr'
- * is a path. Rather it assumes pathPtr is either a path or just
- * the name (tail) of a file which can be found somewhere in the
- * environment's loadable path. This behaviour is not very
- * compatible with virtual filesystems (and has other problems
- * documented in the load man-page), so it is advised that full
- * paths are always used.
+ * Dynamically loads a binary code file into memory and returns the
+ * addresses of two procedures within that file, if they are defined.
+ * The appropriate function for the filesystem to which pathPtr belongs
+ * will be called.
+ *
+ * Note that the native filesystem doesn't actually assume 'pathPtr' is a
+ * path. Rather it assumes pathPtr is either a path or just the name
+ * (tail) of a file which can be found somewhere in the environment's
+ * loadable path. This behaviour is not very compatible with virtual
+ * filesystems (and has other problems documented in the load man-page),
+ * so it is advised that full paths are always used.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result.
+ * A standard Tcl completion code. If an error occurs, an error message
+ * is left in the interp's result.
*
* Side effects:
- * New code suddenly appears in memory. This may later be
- * unloaded by passing the clientData to the unloadProc.
+ * New code suddenly appears in memory. This may later be unloaded by
+ * passing the clientData to the unloadProc.
*
*----------------------------------------------------------------------
*/
int
-Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- handlePtr, unloadProcPtr)
+Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ handlePtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
- CONST char *sym1, *sym2; /* Names of two procedures to look up in
- * the file's symbol table. */
+ CONST char *sym1, *sym2; /* Names of two procedures to look up in the
+ * file's symbol table. */
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
Tcl_LoadHandle *handlePtr; /* Filled with token for dynamically loaded
- * file which will be passed back to
+ * file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
+ Tcl_FSUnloadFileProc **unloadProcPtr;
/* Filled with address of Tcl_FSUnloadFileProc
- * function which should be used for
- * this file. */
+ * function which should be used for this
+ * file. */
{
CONST char *symbols[2];
Tcl_PackageInitProc **procPtrs[2];
ClientData clientData;
int res;
-
+
/* Initialize the arrays */
symbols[0] = sym1;
symbols[1] = sym2;
procPtrs[0] = proc1Ptr;
procPtrs[1] = proc2Ptr;
-
+
/* Perform the load */
- res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs,
- handlePtr, &clientData, unloadProcPtr);
-
- /*
- * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a
- * shared library, we don't keep the loadHandle (for TclpFindSymbol)
- * and the clientData (for the unloadProc) separately. In fact we
- * effectively throw away the loadHandle and only use the clientData.
- * It just so happens, for the native filesystem only, that these two
- * are identical.
- *
+ res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs,
+ handlePtr, &clientData, unloadProcPtr);
+
+ /*
+ * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
+ * library, we don't keep the loadHandle (for TclpFindSymbol) and the
+ * clientData (for the unloadProc) separately. In fact we effectively
+ * throw away the loadHandle and only use the clientData. It just so
+ * happens, for the native filesystem only, that these two are identical.
+ *
* This also means that the signatures Tcl_FSUnloadFileProc and
* Tcl_FSLoadFileProc are both misleading.
*/
+
*handlePtr = (Tcl_LoadHandle) clientData;
return res;
}
@@ -2971,65 +3035,64 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
* TclLoadFile --
*
* Dynamically loads a binary code file into memory and returns the
- * addresses of a number of given procedures within that file, if
- * they are defined. The appropriate function for the filesystem to
- * which pathPtr belongs will be called.
- *
- * Note that the native filesystem doesn't actually assume 'pathPtr'
- * is a path. Rather it assumes pathPtr is either a path or just
- * the name (tail) of a file which can be found somewhere in the
- * environment's loadable path. This behaviour is not very
- * compatible with virtual filesystems (and has other problems
- * documented in the load man-page), so it is advised that full
- * paths are always used.
- *
- * This function is currently private to Tcl. It may be exported in
- * the future and its interface fixed (but we should clean up the
- * loadHandle/clientData confusion at that time -- see the above
- * comments in Tcl_FSLoadFile for details). For a public function,
- * see Tcl_FSLoadFile.
+ * addresses of a number of given procedures within that file, if they
+ * are defined. The appropriate function for the filesystem to which
+ * pathPtr belongs will be called.
+ *
+ * Note that the native filesystem doesn't actually assume 'pathPtr' is a
+ * path. Rather it assumes pathPtr is either a path or just the name
+ * (tail) of a file which can be found somewhere in the environment's
+ * loadable path. This behaviour is not very compatible with virtual
+ * filesystems (and has other problems documented in the load man-page),
+ * so it is advised that full paths are always used.
+ *
+ * This function is currently private to Tcl. It may be exported in the
+ * future and its interface fixed (but we should clean up the
+ * loadHandle/clientData confusion at that time -- see the above comments
+ * in Tcl_FSLoadFile for details). For a public function, see
+ * Tcl_FSLoadFile.
*
* Results:
- * A standard Tcl completion code. If an error occurs, an error
- * message is left in the interp's result.
+ * A standard Tcl completion code. If an error occurs, an error message
+ * is left in the interp's result.
*
* Side effects:
- * New code suddenly appears in memory. This may later be
- * unloaded by passing the clientData to the unloadProc.
+ * New code suddenly appears in memory. This may later be unloaded by
+ * passing the clientData to the unloadProc.
*
*----------------------------------------------------------------------
*/
int
-TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
+TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
handlePtr, clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code. */
- int symc; /* Number of symbols/procPtrs in the
- * next two arrays. */
- CONST char *symbols[]; /* Names of procedures to look up in
- * the file's symbol table. */
+ int symc; /* Number of symbols/procPtrs in the next two
+ * arrays. */
+ CONST char *symbols[]; /* Names of procedures to look up in the
+ * file's symbol table. */
Tcl_PackageInitProc **procPtrs[];
- /* Where to return the addresses
- * corresponding to symbols[]. */
- Tcl_LoadHandle *handlePtr; /* Filled with token for shared
- * library information which can be
- * used in TclpFindSymbol. */
+ /* Where to return the addresses corresponding
+ * to symbols[]. */
+ Tcl_LoadHandle *handlePtr; /* Filled with token for shared library
+ * information which can be used in
+ * TclpFindSymbol. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
- * file which will be passed back to
+ * file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
- /* Filled with address of Tcl_FSUnloadFileProc
- * function which should be used for
- * this file. */
+ Tcl_FSUnloadFileProc **unloadProcPtr;
+ /* Filled with address of Tcl_FSUnloadFileProc
+ * function which should be used for this
+ * file. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
Tcl_Filesystem *copyFsPtr;
Tcl_Obj *copyToPtr;
-
+
if (proc != NULL) {
int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
if (retVal == TCL_OK) {
@@ -3037,113 +3100,126 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
if (*handlePtr == NULL) {
return TCL_ERROR;
}
- for (i = 0;i < symc;i++) {
+ for (i=0 ; i<symc ; i++) {
if (symbols[i] != NULL) {
- *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
- symbols[i]);
+ *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
+ symbols[i]);
}
}
- /* Copy this across, since both are equal for the native fs */
+
+ /*
+ * Copy this across, since both are equal for the native fs.
+ */
+
*clientDataPtr = (ClientData)*handlePtr;
- Tcl_ResetResult(interp);
+ Tcl_ResetResult(interp);
return TCL_OK;
}
if (Tcl_GetErrno() != EXDEV) {
- return retVal;
+ return retVal;
}
}
- /*
- * The filesystem doesn't support 'load', so we fall back on
- * the following technique:
+
+ /*
+ * The filesystem doesn't support 'load', so we fall back on the
+ * following technique:
+ *
+ * First check if it is readable -- and exists!
*/
-
- /* First check if it is readable -- and exists! */
+
if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_GetString(pathPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
-
+
#ifdef TCL_LOAD_FROM_MEMORY
- /*
- * The platform supports loading code from memory, so ask for a
- * buffer of the appropriate size, read the file into it and
- * load the code from the buffer:
+ /*
+ * The platform supports loading code from memory, so ask for a buffer
+ * of the appropriate size, read the file into it and load the code
+ * from the buffer:
*/
+
do {
- int ret, size;
- void *buffer;
- Tcl_StatBuf statBuf;
- Tcl_Channel data;
-
- ret = Tcl_FSStat(pathPtr, &statBuf);
- if (ret < 0) {
- break;
- }
- size = (int) statBuf.st_size;
- /* Tcl_Read takes an int: check that file size isn't wide */
- if (size != (Tcl_WideInt)statBuf.st_size) {
- break;
- }
+ int ret, size;
+ void *buffer;
+ Tcl_StatBuf statBuf;
+ Tcl_Channel data;
+
+ ret = Tcl_FSStat(pathPtr, &statBuf);
+ if (ret < 0) {
+ break;
+ }
+ size = (int) statBuf.st_size;
+
+ /*
+ * Tcl_Read takes an int: check that file size isn't wide.
+ */
+
+ if (size != (Tcl_WideInt) statBuf.st_size) {
+ break;
+ }
data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
- if (!data) {
- break;
- }
- buffer = TclpLoadMemoryGetBuffer(interp, size);
- if (!buffer) {
- Tcl_Close(interp, data);
- break;
- }
- Tcl_SetChannelOption(interp, data, "-translation", "binary");
- ret = Tcl_Read(data, buffer, size);
- Tcl_Close(interp, data);
- ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, unloadProcPtr);
- if (ret == TCL_OK) {
+ if (!data) {
+ break;
+ }
+ buffer = TclpLoadMemoryGetBuffer(interp, size);
+ if (!buffer) {
+ Tcl_Close(interp, data);
+ break;
+ }
+ Tcl_SetChannelOption(interp, data, "-translation", "binary");
+ ret = Tcl_Read(data, buffer, size);
+ Tcl_Close(interp, data);
+ ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
+ unloadProcPtr);
+ if (ret == TCL_OK) {
int i;
if (*handlePtr == NULL) {
break;
}
for (i = 0;i < symc;i++) {
if (symbols[i] != NULL) {
- *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
- symbols[i]);
+ *procPtrs[i] = TclpFindSymbol(interp, *handlePtr,
+ symbols[i]);
}
}
- *clientDataPtr = (ClientData)*handlePtr;
+ *clientDataPtr = (ClientData) *handlePtr;
return TCL_OK;
}
- } while (0);
+ } while (0);
Tcl_ResetResult(interp);
#endif
- /*
- * 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.
*/
+
copyToPtr = TclpTempFileName();
if (copyToPtr == NULL) {
Tcl_AppendResult(interp, "couldn't create temporary file: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
Tcl_IncrRefCount(copyToPtr);
-
+
copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
- /*
- * We already know we can't use Tcl_FSLoadFile from
- * this filesystem, and we must avoid a possible
- * infinite loop. Try to delete the file we
- * probably created, and then exit.
+ /*
+ * We already know we can't use Tcl_FSLoadFile from this
+ * filesystem, and we must avoid a possible infinite loop. Try to
+ * delete the file we probably created, and then exit.
*/
+
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
Tcl_AppendResult(interp, "couldn't load from current filesystem",
- (char *) NULL);
+ (char *) NULL);
return TCL_ERROR;
}
-
+
if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) {
Tcl_LoadHandle newLoadHandle = NULL;
ClientData newClientData = NULL;
@@ -3152,15 +3228,13 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
int retVal;
#if !defined(__WIN32__)
- /*
- * Do we need to set appropriate permissions
- * on the file? This may be required on some
- * systems. On Unix we could loop over
- * the file attributes, and set any that are
- * called "-permissions" to 0700. However,
- * we just do this directly, like this:
+ /*
+ * Do we need to set appropriate permissions on the file? This
+ * may be required on some systems. On Unix we could loop over
+ * the file attributes, and set any that are called "-permissions"
+ * to 0700. However, we just do this directly, like this:
*/
-
+
int index;
Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
Tcl_IncrRefCount(perm);
@@ -3170,57 +3244,59 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
}
Tcl_DecrRefCount(perm);
#endif
-
- /*
- * We need to reset the result now, because the cross-
- * filesystem copy may have stored the number of bytes
- * in the result
+
+ /*
+ * We need to reset the result now, because the cross- filesystem
+ * copy may have stored the number of bytes in the result.
*/
+
Tcl_ResetResult(interp);
-
- retVal = TclLoadFile(interp, copyToPtr, symc, symbols,
- procPtrs, &newLoadHandle,
- &newClientData,
- &newUnloadProcPtr);
+
+ retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
+ &newLoadHandle, &newClientData, &newUnloadProcPtr);
if (retVal != TCL_OK) {
/* The file didn't load successfully */
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
return retVal;
}
- /*
- * Try to delete the file immediately -- this is
- * possible in some OSes, and avoids any worries
- * about leaving the copy laying around on exit.
+
+ /*
+ * Try to delete the file immediately - this is possible in some
+ * OSes, and avoids any worries about leaving the copy laying
+ * around on exit.
*/
+
if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
Tcl_DecrRefCount(copyToPtr);
- /*
- * We tell our caller about the real shared
- * library which was loaded. Note that this
- * does mean that the package list maintained
- * by 'load' will store the original (vfs)
- * path alongside the temporary load handle
- * and unload proc ptr.
+
+ /*
+ * We tell our caller about the real shared library which was
+ * loaded. Note that this does mean that the package list
+ * maintained by 'load' will store the original (vfs) path
+ * alongside the temporary load handle and unload proc ptr.
*/
+
(*handlePtr) = newLoadHandle;
(*clientDataPtr) = newClientData;
(*unloadProcPtr) = newUnloadProcPtr;
Tcl_ResetResult(interp);
return TCL_OK;
}
- /*
- * When we unload this file, we need to divert the
- * unloading so we can unload and cleanup the
- * temporary file correctly.
+
+ /*
+ * When we unload this file, we need to divert the unloading so we
+ * can unload and cleanup the temporary file correctly.
*/
- tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));
- /*
- * Remember three pieces of information. This allows
- * us to cleanup the diverted load completely, on
- * platforms which allow proper unloading of code.
+ tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));
+
+ /*
+ * Remember three pieces of information. This allows us to
+ * cleanup the diverted load completely, on platforms which allow
+ * proper unloading of code.
*/
+
tvdlPtr->loadHandle = newLoadHandle;
tvdlPtr->unloadProcPtr = newUnloadProcPtr;
@@ -3228,24 +3304,25 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
/* copyToPtr is already incremented for this reference */
tvdlPtr->divertedFile = copyToPtr;
- /*
- * This is the filesystem we loaded it into. Since
- * we have a reference to 'copyToPtr', we already
- * have a refCount on this filesystem, so we don't
- * need to worry about it disappearing on us.
+ /*
+ * This is the filesystem we loaded it into. Since we have a
+ * reference to 'copyToPtr', we already have a refCount on
+ * this filesystem, so we don't need to worry about it
+ * disappearing on us.
*/
+
tvdlPtr->divertedFilesystem = copyFsPtr;
tvdlPtr->divertedFileNativeRep = NULL;
} else {
/* We need the native rep */
- tvdlPtr->divertedFileNativeRep =
- TclNativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr,
- copyFsPtr));
- /*
- * We don't need or want references to the copied
- * Tcl_Obj or the filesystem if it is the native
- * one.
+ tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
+ Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));
+
+ /*
+ * We don't need or want references to the copied Tcl_Obj or
+ * the filesystem if it is the native one.
*/
+
tvdlPtr->divertedFile = NULL;
tvdlPtr->divertedFilesystem = NULL;
Tcl_DecrRefCount(copyToPtr);
@@ -3253,12 +3330,16 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
copyToPtr = NULL;
(*handlePtr) = newLoadHandle;
- (*clientDataPtr) = (ClientData)tvdlPtr;
+ (*clientDataPtr) = (ClientData) tvdlPtr;
(*unloadProcPtr) = &FSUnloadTempFile;
Tcl_ResetResult(interp);
return retVal;
+
} else {
- /* Cross-platform copy failed */
+ /*
+ * Cross-platform copy failed.
+ */
+
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
return TCL_ERROR;
@@ -3267,44 +3348,45 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
Tcl_SetErrno(ENOENT);
return TCL_ERROR;
}
-/*
- * This function used to be in the platform specific directories, but it
- * has now been made to work cross-platform
+/*
+ * This function used to be in the platform specific directories, but it has
+ * now been made to work cross-platform
*/
+
int
-TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
- clientDataPtr, unloadProcPtr)
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
+ clientDataPtr, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code (UTF-8). */
- CONST char *sym1, *sym2; /* Names of two procedures to look up in
- * the file's symbol table. */
+ CONST char *sym1, *sym2; /* Names of two procedures to look up in the
+ * file's symbol table. */
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
ClientData *clientDataPtr; /* Filled with token for dynamically loaded
- * file which will be passed back to
+ * file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
- Tcl_FSUnloadFileProc **unloadProcPtr;
+ Tcl_FSUnloadFileProc **unloadProcPtr;
/* Filled with address of Tcl_FSUnloadFileProc
- * function which should be used for
- * this file. */
+ * function which should be used for this
+ * file. */
{
Tcl_LoadHandle handle = NULL;
int res;
-
+
res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
-
+
if (res != TCL_OK) {
- return res;
+ return res;
}
if (handle == NULL) {
return TCL_ERROR;
}
-
+
*clientDataPtr = (ClientData)handle;
-
+
*proc1Ptr = TclpFindSymbol(interp, handle, sym1);
*proc2Ptr = TclpFindSymbol(interp, handle, sym2);
return TCL_OK;
@@ -3315,83 +3397,86 @@ TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
*
* FSUnloadTempFile --
*
- * This function is called when we loaded a library of code via
- * an intermediate temporary file. This function ensures
- * the library is correctly unloaded and the temporary file
- * is correctly deleted.
+ * This function is called when we loaded a library of code via an
+ * intermediate temporary file. This function ensures the library is
+ * correctly unloaded and the temporary file is correctly deleted.
*
* Results:
* None.
*
* Side effects:
- * The effects of the 'unload' function called, and of course
- * the temporary file will be deleted.
+ * The effects of the 'unload' function called, and of course the
+ * temporary file will be deleted.
*
*---------------------------------------------------------------------------
*/
-static void
+static void
FSUnloadTempFile(loadHandle)
- Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
- * to Tcl_FSLoadFile(). The loadHandle is
- * a token that represents the loaded
- * file. */
+ Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call to
+ * Tcl_FSLoadFile(). The loadHandle is a token
+ * that represents the loaded file. */
{
FsDivertLoad *tvdlPtr = (FsDivertLoad*)loadHandle;
- /*
- * This test should never trigger, since we give
- * the client data in the function above.
+
+ /*
+ * This test should never trigger, since we give the client data in the
+ * function above.
*/
+
if (tvdlPtr == NULL) { return; }
-
- /*
- * Call the real 'unloadfile' proc we actually used. It is very
- * important that we call this first, so that the shared library
- * is actually unloaded by the OS. Otherwise, the following
- * 'delete' may well fail because the shared library is still in
- * use.
+
+ /*
+ * Call the real 'unloadfile' proc we actually used. It is very important
+ * that we call this first, so that the shared library is actually
+ * unloaded by the OS. Otherwise, the following 'delete' may well fail
+ * because the shared library is still in use.
*/
+
if (tvdlPtr->unloadProcPtr != NULL) {
(*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
}
-
+
if (tvdlPtr->divertedFilesystem == NULL) {
- /*
- * It was the native filesystem, and we have a special
- * function available just for this purpose, which we
- * know works even at this late stage.
+ /*
+ * It was the native filesystem, and we have a special function
+ * available just for this purpose, which we know works even at this
+ * late stage.
*/
+
TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
+
} else {
- /*
- * Remove the temporary file we created. Note, we may crash
- * here because encodings have been taken down already.
+ /*
+ * Remove the temporary file we created. Note, we may crash here
+ * because encodings have been taken down already.
*/
+
if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
- != TCL_OK) {
- /*
+ != TCL_OK) {
+ /*
* The above may have failed because the filesystem, or something
* it depends upon (e.g. encodings) have been taken down because
* Tcl is exiting.
- *
- * We may need to work out how to delete this file more
- * robustly (or give the filesystem the information it needs
- * to delete the file more robustly).
- *
- * In particular, one problem might be that the filesystem
- * cannot extract the information it needs from the above
- * path object because Tcl's entire filesystem apparatus
- * (the code in this file) has been finalized, and it
- * refuses to pass the internal representation to the
- * filesystem.
+ *
+ * We may need to work out how to delete this file more robustly
+ * (or give the filesystem the information it needs to delete the
+ * file more robustly).
+ *
+ * In particular, one problem might be that the filesystem cannot
+ * extract the information it needs from the above path object
+ * because Tcl's entire filesystem apparatus (the code in this
+ * file) has been finalized, and it refuses to pass the internal
+ * representation to the filesystem.
*/
}
-
- /*
- * And free up the allocations. This will also of course remove
- * a refCount from the Tcl_Filesystem to which this file belongs,
- * which could then free up the filesystem if we are exiting.
+
+ /*
+ * And free up the allocations. This will also of course remove a
+ * refCount from the Tcl_Filesystem to which this file belongs, which
+ * could then free up the filesystem if we are exiting.
*/
+
Tcl_DecrRefCount(tvdlPtr->divertedFile);
}
@@ -3403,33 +3488,30 @@ FSUnloadTempFile(loadHandle)
*
* Tcl_FSLink --
*
- * This function replaces the library version of readlink() and
- * can also be used to make links. The appropriate function for
- * the filesystem to which pathPtr belongs will be called.
+ * This function replaces the library version of readlink() and can also
+ * be used to make links. The appropriate function for the filesystem to
+ * which pathPtr belongs will be called.
*
* Results:
- * If toPtr is NULL, then the result is a Tcl_Obj specifying the
- * contents of the symbolic link given by 'pathPtr', or NULL if
- * the symbolic link could not be read. The result is owned by
- * the caller, which should call Tcl_DecrRefCount when the result
- * is no longer needed.
- *
- * If toPtr is non-NULL, then the result is toPtr if the link action
- * was successful, or NULL if not. In this case the result has no
- * additional reference count, and need not be freed. The actual
- * action to perform is given by the 'linkAction' flags, which is
- * an or'd combination of:
- *
- * TCL_CREATE_SYMBOLIC_LINK
- * TCL_CREATE_HARD_LINK
- *
- * Note that most filesystems will not support linking across
- * to different filesystems, so this function will usually
- * fail unless toPtr is in the same FS as pathPtr.
- *
+ * If toPtr is NULL, then the result is a Tcl_Obj specifying the contents
+ * of the symbolic link given by 'pathPtr', or NULL if the symbolic link
+ * could not be read. The result is owned by the caller, which should
+ * call Tcl_DecrRefCount when the result is no longer needed.
+ *
+ * If toPtr is non-NULL, then the result is toPtr if the link action was
+ * successful, or NULL if not. In this case the result has no additional
+ * reference count, and need not be freed. The actual action to perform
+ * is given by the 'linkAction' flags, which is an or'd combination of:
+ *
+ * TCL_CREATE_SYMBOLIC_LINK
+ * TCL_CREATE_HARD_LINK
+ *
+ * Note that most filesystems will not support linking across to
+ * different filesystems, so this function will usually fail unless toPtr
+ * is in the same FS as pathPtr.
+ *
* Side effects:
- * See readlink() documentation. A new filesystem link
- * object may appear
+ * See readlink() documentation. A new filesystem link object may appear
*
*---------------------------------------------------------------------------
*/
@@ -3438,7 +3520,7 @@ Tcl_Obj *
Tcl_FSLink(pathPtr, toPtr, linkAction)
Tcl_Obj *pathPtr; /* Path of file to readlink or link */
Tcl_Obj *toPtr; /* NULL or path to be linked to */
- int linkAction; /* Action to perform */
+ int linkAction; /* Action to perform */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
if (fsPtr != NULL) {
@@ -3447,13 +3529,15 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
return (*proc)(pathPtr, toPtr, linkAction);
}
}
+
/*
- * If S_IFLNK isn't defined it means that the machine doesn't
- * support symbolic links, so the file can't possibly be a
- * symbolic link. Generate an EINVAL error, which is what
- * happens on machines that do support symbolic links when
- * you invoke readlink on a file that isn't a symbolic link.
+ * If S_IFLNK isn't defined it means that the machine doesn't support
+ * symbolic links, so the file can't possibly be a symbolic link.
+ * Generate an EINVAL error, which is what happens on machines that do
+ * support symbolic links when you invoke readlink on a file that isn't a
+ * symbolic link.
*/
+
#ifndef S_IFLNK
errno = EINVAL;
#else
@@ -3467,17 +3551,16 @@ Tcl_FSLink(pathPtr, toPtr, linkAction)
*
* Tcl_FSListVolumes --
*
- * Lists the currently mounted volumes. The chain of functions
- * that have been "inserted" into the filesystem will be called in
- * succession; each may return a list of volumes, all of which are
- * added to the result until all mounted file systems are listed.
- *
- * Notice that we assume the lists returned by each filesystem
- * (if non NULL) have been given a refCount for us already.
- * However, we are NOT allowed to hang on to the list itself
- * (it belongs to the filesystem we called). Therefore we
- * quite naturally add its contents to the result we are
- * building, and then decrement the refCount.
+ * Lists the currently mounted volumes. The chain of functions that have
+ * been "inserted" into the filesystem will be called in succession; each
+ * may return a list of volumes, all of which are added to the result
+ * until all mounted file systems are listed.
+ *
+ * Notice that we assume the lists returned by each filesystem (if non
+ * NULL) have been given a refCount for us already. However, we are NOT
+ * allowed to hang on to the list itself (it belongs to the filesystem we
+ * called). Therefore we quite naturally add its contents to the result
+ * we are building, and then decrement the refCount.
*
* Results:
* The list of volumes, in an object which has refCount 0.
@@ -3493,12 +3576,12 @@ Tcl_FSListVolumes(void)
{
FilesystemRecord *fsRecPtr;
Tcl_Obj *resultPtr = Tcl_NewObj();
-
+
/*
- * Call each of the "listVolumes" function in succession.
- * A non-NULL return value indicates the particular function has
- * succeeded. We call all the functions registered, since we want
- * a list of all drives from all filesystems.
+ * Call each of the "listVolumes" function in succession. A non-NULL
+ * return value indicates the particular function has succeeded. We call
+ * all the functions registered, since we want a list of all drives from
+ * all filesystems.
*/
fsRecPtr = FsGetFirstFilesystem();
@@ -3513,7 +3596,7 @@ Tcl_FSListVolumes(void)
}
fsRecPtr = fsRecPtr->nextPtr;
}
-
+
return resultPtr;
}
@@ -3522,13 +3605,12 @@ Tcl_FSListVolumes(void)
*
* FsListMounts --
*
- * List all mounts within the given directory, which match the
- * given pattern.
+ * List all mounts within the given directory, which match the given
+ * pattern.
*
* Results:
- * The list of mounts, in a list object which has refCount 0, or
- * NULL if we didn't even find any filesystems to try to list
- * mounts.
+ * The list of mounts, in a list object which has refCount 0, or NULL if
+ * we didn't even find any filesystems to try to list mounts.
*
* Side effects:
* None
@@ -3538,26 +3620,25 @@ Tcl_FSListVolumes(void)
static Tcl_Obj*
FsListMounts(pathPtr, pattern)
- Tcl_Obj *pathPtr; /* Contains path to directory to search. */
+ Tcl_Obj *pathPtr; /* Contains path to directory to search. */
CONST char *pattern; /* Pattern to match against. */
{
FilesystemRecord *fsRecPtr;
Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
Tcl_Obj *resultPtr = NULL;
-
+
/*
- * Call each of the "matchInDirectory" functions in succession, with
- * the specific type information 'mountsOnly'. A non-NULL return
- * value indicates the particular function has succeeded. We call
- * all the functions registered, since we want a list from each
- * filesystems.
+ * Call each of the "matchInDirectory" functions in succession, with the
+ * specific type information 'mountsOnly'. A non-NULL return value
+ * indicates the particular function has succeeded. We call all the
+ * functions registered, since we want a list from each filesystems.
*/
fsRecPtr = FsGetFirstFilesystem();
while (fsRecPtr != NULL) {
if (fsRecPtr != &nativeFilesystemRecord) {
- Tcl_FSMatchInDirectoryProc *proc =
- fsRecPtr->fsPtr->matchInDirectoryProc;
+ Tcl_FSMatchInDirectoryProc *proc =
+ fsRecPtr->fsPtr->matchInDirectoryProc;
if (proc != NULL) {
if (resultPtr == NULL) {
resultPtr = Tcl_NewObj();
@@ -3567,7 +3648,7 @@ FsListMounts(pathPtr, pattern)
}
fsRecPtr = fsRecPtr->nextPtr;
}
-
+
return resultPtr;
}
@@ -3576,14 +3657,14 @@ FsListMounts(pathPtr, pattern)
*
* 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.
+ * 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.
*
* 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
- * in the returned list.
+ * Returns list object with refCount of zero. If the passed in lenPtr is
+ * non-NULL, we use it to return the number of elements in the returned
+ * list.
*
* Side effects:
* None.
@@ -3591,23 +3672,23 @@ FsListMounts(pathPtr, pattern)
*---------------------------------------------------------------------------
*/
-Tcl_Obj*
+Tcl_Obj*
Tcl_FSSplitPath(pathPtr, lenPtr)
Tcl_Obj *pathPtr; /* Path to split. */
int *lenPtr; /* int to store number of path elements. */
{
- Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */
+ Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */
Tcl_Filesystem *fsPtr;
char separator = '/';
int driveNameLength;
char *p;
-
+
/*
- * Perform platform specific splitting.
+ * Perform platform specific splitting.
*/
- if (TclFSGetPathType(pathPtr, &fsPtr, &driveNameLength)
- == TCL_PATH_ABSOLUTE) {
+ if (TclFSGetPathType(pathPtr, &fsPtr,
+ &driveNameLength) == TCL_PATH_ABSOLUTE) {
if (fsPtr == &tclNativeFilesystem) {
return TclpNativeSplitPath(pathPtr, lenPtr);
}
@@ -3615,7 +3696,10 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
return TclpNativeSplitPath(pathPtr, lenPtr);
}
- /* We assume separators are single characters */
+ /*
+ * We assume separators are single characters.
+ */
+
if (fsPtr->filesystemSeparatorProc != NULL) {
Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);
if (sep != NULL) {
@@ -3624,20 +3708,23 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
Tcl_DecrRefCount(sep);
}
}
-
- /*
- * Place the drive name as first element of the
- * result list. The drive name may contain strange
- * characters, like colons and multiple forward slashes
- * (for example 'ftp://' is a valid vfs drive name)
+
+ /*
+ * Place the drive name as first element of the result list. The drive
+ * name may contain strange characters, like colons and multiple forward
+ * slashes (for example 'ftp://' is a valid vfs drive name)
*/
+
result = Tcl_NewObj();
p = Tcl_GetString(pathPtr);
- Tcl_ListObjAppendElement(NULL, result,
- Tcl_NewStringObj(p, driveNameLength));
- p+= driveNameLength;
-
- /* Add the remaining path elements to the list */
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(p, driveNameLength));
+ p += driveNameLength;
+
+ /*
+ * Add the remaining path elements to the list.
+ */
+
for (;;) {
char *elementStart = p;
int length;
@@ -3659,7 +3746,7 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
break;
}
}
-
+
/*
* Compute the number of elements in the result.
*/
@@ -3671,7 +3758,7 @@ Tcl_FSSplitPath(pathPtr, lenPtr)
}
/* Simple helper function */
-Tcl_Obj*
+Tcl_Obj*
TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
Tcl_Filesystem *fromFilesystem;
ClientData clientData;
@@ -3686,9 +3773,9 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
}
fsRecPtr = fsRecPtr->nextPtr;
}
-
- if ((fsRecPtr != NULL)
- && (fromFilesystem->internalToNormalizedProc != NULL)) {
+
+ if ((fsRecPtr != NULL)
+ && (fromFilesystem->internalToNormalizedProc != NULL)) {
return (*fromFilesystem->internalToNormalizedProc)(clientData);
} else {
return NULL;
@@ -3704,9 +3791,9 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
*
* Results:
* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
- * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will
- * be set if and only if it is non-NULL and the function's
- * return value is TCL_PATH_ABSOLUTE.
+ * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
+ * only if it is non-NULL and the function's return value is
+ * TCL_PATH_ABSOLUTE.
*
* Side effects:
* None.
@@ -3716,33 +3803,31 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
Tcl_PathType
TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
- Tcl_Obj *pathPtr; /* Path to determine type for */
- Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is
- * non-NULL, then set to the
- * filesystem which claims this
- * path */
- int *driveNameLengthPtr; /* If the path is absolute, and
- * this is non-NULL, then set to
- * the length of the driveName */
- Tcl_Obj **driveNameRef; /* If the path is absolute, and
- * this is non-NULL, then set to
- * the name of the drive,
- * network-volume which contains
- * the path, already with a
- * refCount for the caller. */
+ Tcl_Obj *pathPtr; /* Path to determine type for */
+ Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is not
+ * NULL, then set to the filesystem
+ * which claims this path. */
+ int *driveNameLengthPtr; /* If the path is absolute, and this
+ * is non-NULL, then set to the length
+ * of the driveName. */
+ Tcl_Obj **driveNameRef; /* If the path is absolute, and this
+ * is non-NULL, then set to the name
+ * of the drive, network-volume which
+ * contains the path, already with a
+ * refCount for the caller. */
{
int pathLen;
char *path;
Tcl_PathType type;
-
+
path = Tcl_GetStringFromObj(pathPtr, &pathLen);
- type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
- driveNameLengthPtr, driveNameRef);
-
+ type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
+ driveNameLengthPtr, driveNameRef);
+
if (type != TCL_PATH_ABSOLUTE) {
- type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
- driveNameRef);
+ type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
+ driveNameRef);
if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
*filesystemPtrPtr = &tclNativeFilesystem;
}
@@ -3755,17 +3840,16 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
*
* TclFSNonnativePathType --
*
- * Helper function used by TclGetPathType. Its purpose is to
- * check whether the given path starts with a string which
- * corresponds to a file volume in any registered filesystem
- * except the native one. For speed and historical reasons the
- * native filesystem has special hard-coded checks dotted here
- * and there in the filesystem code.
+ * Helper function used by TclGetPathType. Its purpose is to check
+ * whether the given path starts with a string which corresponds to a
+ * file volume in any registered filesystem except the native one. For
+ * speed and historical reasons the native filesystem has special
+ * hard-coded checks dotted here and there in the filesystem code.
*
* Results:
- * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE.
- * The filesystem reference will be set if and only if it is
- * non-NULL and the function's return value is TCL_PATH_ABSOLUTE.
+ * Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
+ * reference will be set if and only if it is non-NULL and the function's
+ * return value is TCL_PATH_ABSOLUTE.
*
* Side effects:
* None.
@@ -3774,71 +3858,70 @@ TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
*/
Tcl_PathType
-TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
- driveNameLengthPtr, driveNameRef)
- CONST char *path; /* Path to determine type for */
- int pathLen; /* Length of the path */
- Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is
- * non-NULL, then set to the
- * filesystem which claims this
- * path */
- int *driveNameLengthPtr; /* If the path is absolute, and
- * this is non-NULL, then set to
- * the length of the driveName */
- Tcl_Obj **driveNameRef; /* If the path is absolute, and
- * this is non-NULL, then set to
- * the name of the drive,
- * network-volume which contains
- * the path, already with a
+TclFSNonnativePathType(path, pathLen, filesystemPtrPtr, driveNameLengthPtr,
+ driveNameRef)
+ CONST char *path; /* Path to determine type for */
+ int pathLen; /* Length of the path */
+ Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is not
+ * NULL, then set to the filesystem
+ * which claims this path. */
+ int *driveNameLengthPtr; /* If the path is absolute, and this
+ * is non-NULL, then set to the length
+ * of the driveName. */
+ Tcl_Obj **driveNameRef; /* If the path is absolute, and this
+ * is non-NULL, then set to the name
+ * of the drive, network-volume which
+ * contains the path, already with a
* refCount for the caller. */
{
FilesystemRecord *fsRecPtr;
Tcl_PathType type = TCL_PATH_RELATIVE;
/*
- * Call each of the "listVolumes" function in succession, checking
- * whether the given path is an absolute path on any of the volumes
- * returned (this is done by checking whether the path's prefix
- * matches).
+ * Call each of the "listVolumes" function in succession, checking whether
+ * the given path is an absolute path on any of the volumes returned (this
+ * is done by checking whether the path's prefix matches).
*/
fsRecPtr = FsGetFirstFilesystem();
while (fsRecPtr != NULL) {
Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
- /*
+
+ /*
* We want to skip the native filesystem in this loop because
- * otherwise we won't necessarily pass all the Tcl testsuite --
- * this is because some of the tests artificially change the
- * current platform (between win, unix) but the list
- * of volumes we get by calling (*proc) will reflect the current
- * (real) platform only and this may cause some tests to fail.
- * In particular, on unix '/' will match the beginning of
- * certain absolute Windows paths starting '//' and those tests
- * will go wrong.
- *
- * Besides these test-suite issues, there is one other reason
- * to skip the native filesystem --- since the tclFilename.c
- * code has nice fast 'absolute path' checkers, we don't want
- * to waste time repeating that effort here, and this
- * function is actually called quite often, so if we can
- * save the overhead of the native filesystem returning us
- * a list of volumes all the time, it is better.
+ * otherwise we won't necessarily pass all the Tcl testsuite -- this
+ * is because some of the tests artificially change the current
+ * platform (between win, unix) but the list of volumes we get by
+ * calling (*proc) will reflect the current (real) platform only and
+ * this may cause some tests to fail. In particular, on unix '/' will
+ * match the beginning of certain absolute Windows paths starting '//'
+ * and those tests will go wrong.
+ *
+ * Besides these test-suite issues, there is one other reason to skip
+ * the native filesystem --- since the tclFilename.c code has nice
+ * fast 'absolute path' checkers, we don't want to waste time
+ * repeating that effort here, and this function is actually called
+ * quite often, so if we can save the overhead of the native
+ * filesystem returning us a list of volumes all the time, it is
+ * better.
*/
+
if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
int numVolumes;
Tcl_Obj *thisFsVolumes = (*proc)();
if (thisFsVolumes != NULL) {
- if (Tcl_ListObjLength(NULL, thisFsVolumes,
- &numVolumes) != TCL_OK) {
- /*
- * This is VERY bad; the Tcl_FSListVolumesProc
- * didn't return a valid list. Set numVolumes to
- * -1 so that we skip the while loop below and just
- * return with the current value of 'type'.
- *
- * It would be better if we could signal an error
- * here (but Tcl_Panic seems a bit excessive).
+ if (Tcl_ListObjLength(NULL, thisFsVolumes,
+ &numVolumes) != TCL_OK) {
+ /*
+ * This is VERY bad; the Tcl_FSListVolumesProc didn't
+ * return a valid list. Set numVolumes to -1 so that we
+ * skip the while loop below and just return with the
+ * current value of 'type'.
+ *
+ * It would be better if we could signal an error here
+ * (but Tcl_Panic seems a bit excessive).
*/
+
numVolumes = -1;
}
while (numVolumes > 0) {
@@ -3884,12 +3967,12 @@ TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
*
* Tcl_FSRenameFile --
*
- * If the two paths given belong to the same filesystem, we call
- * that filesystems rename function. Otherwise we simply
- * return the posix error 'EXDEV', and -1.
+ * If the two paths given belong to the same filesystem, we call that
+ * filesystems rename function. Otherwise we simply return the posix
+ * error 'EXDEV', and -1.
*
* Results:
- * Standard Tcl error code if a function was called.
+ * Standard Tcl error code if a function was called.
*
* Side effects:
* A file may be renamed.
@@ -3926,16 +4009,16 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
*
* Tcl_FSCopyFile --
*
- * If the two paths given belong to the same filesystem, we call
- * that filesystem's copy function. Otherwise we simply
- * return the posix error 'EXDEV', and -1.
- *
- * Note that in the native filesystems, 'copyFileProc' is defined
- * to copy soft links (i.e. it copies the links themselves, not
- * the things they point to).
+ * If the two paths given belong to the same filesystem, we call that
+ * filesystem's copy function. Otherwise we simply return the posix
+ * error 'EXDEV', and -1.
+ *
+ * Note that in the native filesystems, 'copyFileProc' is defined to copy
+ * soft links (i.e. it copies the links themselves, not the things they
+ * point to).
*
* Results:
- * Standard Tcl error code if a function was called.
+ * Standard Tcl error code if a function was called.
*
* Side effects:
* A file may be copied.
@@ -3943,7 +4026,7 @@ Tcl_FSRenameFile(srcPathPtr, destPathPtr)
*---------------------------------------------------------------------------
*/
-int
+int
Tcl_FSCopyFile(srcPathPtr, destPathPtr)
Tcl_Obj* srcPathPtr; /* Pathname of file to be copied (UTF-8). */
Tcl_Obj *destPathPtr; /* Pathname of file to copy to (UTF-8). */
@@ -3970,57 +4053,70 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
*
* TclCrossFilesystemCopy --
*
- * 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.
+ * 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.
+ * Standard Tcl error code.
*
* Side effects:
* A file may be created.
*
*---------------------------------------------------------------------------
*/
-int
-TclCrossFilesystemCopy(interp, source, target)
+int
+TclCrossFilesystemCopy(interp, source, target)
Tcl_Interp *interp; /* For error messages */
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(interp, target, "w", prot);
if (out != NULL) {
- /* It looks like we can copy it over */
- Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source,
- "r", prot);
+ /*
+ * It looks like we can copy it over.
+ */
+
+ Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source, "r", prot);
+
if (in == NULL) {
- /* This is very strange, we checked this above */
+ /*
+ * This is very strange, we checked this above
+ */
+
Tcl_Close(interp, out);
+
} else {
Tcl_StatBuf 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).
+
+ /*
+ * Copy it synchronously. We might wish to add an asynchronous
+ * option to support vfs's which are slow (e.g. network sockets).
*/
+
Tcl_SetChannelOption(interp, in, "-translation", "binary");
Tcl_SetChannelOption(interp, out, "-translation", "binary");
-
+
if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
result = TCL_OK;
}
- /*
- * If the copy failed, assume that copy channel left
- * a good error message.
+
+ /*
+ * If the copy failed, assume that copy channel left a good error
+ * message.
*/
+
Tcl_Close(interp, in);
Tcl_Close(interp, out);
-
- /* Set modification date of copied file */
+
+ /*
+ * Set modification date of copied file.
+ */
+
if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
tval.actime = sourceStatBuf.st_atime;
tval.modtime = sourceStatBuf.st_mtime;
@@ -4036,11 +4132,11 @@ TclCrossFilesystemCopy(interp, source, target)
*
* Tcl_FSDeleteFile --
*
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ * The appropriate function for the filesystem to which pathPtr belongs
+ * will be called.
*
* Results:
- * Standard Tcl error code.
+ * Standard Tcl error code.
*
* Side effects:
* A file may be deleted.
@@ -4068,11 +4164,11 @@ Tcl_FSDeleteFile(pathPtr)
*
* Tcl_FSCreateDirectory --
*
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ * The appropriate function for the filesystem to which pathPtr belongs
+ * will be called.
*
* Results:
- * Standard Tcl error code.
+ * Standard Tcl error code.
*
* Side effects:
* A directory may be created.
@@ -4100,12 +4196,12 @@ Tcl_FSCreateDirectory(pathPtr)
*
* Tcl_FSCopyDirectory --
*
- * If the two paths given belong to the same filesystem, we call
- * that filesystems copy-directory function. Otherwise we simply
- * return the posix error 'EXDEV', and -1.
+ * If the two paths given belong to the same filesystem, we call that
+ * filesystems copy-directory function. Otherwise we simply return the
+ * posix error 'EXDEV', and -1.
*
* Results:
- * Standard Tcl error code if a function was called.
+ * Standard Tcl error code if a function was called.
*
* Side effects:
* A directory may be copied.
@@ -4118,9 +4214,9 @@ Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
Tcl_Obj* srcPathPtr; /* Pathname of directory to be copied
* (UTF-8). */
Tcl_Obj *destPathPtr; /* Pathname of target directory (UTF-8). */
- Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a
- * new object containing name of file
- * causing error, with refCount 1. */
+ Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a new
+ * object containing name of file causing
+ * error, with refCount 1. */
{
int retVal = -1;
Tcl_Filesystem *fsPtr, *fsPtr2;
@@ -4144,11 +4240,11 @@ Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
*
* Tcl_FSRemoveDirectory --
*
- * The appropriate function for the filesystem to which pathPtr
- * belongs will be called.
+ * The appropriate function for the filesystem to which pathPtr belongs
+ * will be called.
*
* Results:
- * Standard Tcl error code.
+ * Standard Tcl error code.
*
* Side effects:
* A directory may be deleted.
@@ -4160,47 +4256,50 @@ int
Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
Tcl_Obj *pathPtr; /* Pathname of directory to be removed
* (UTF-8). */
- int recursive; /* If non-zero, removes directories that
- * are nonempty. Otherwise, will only remove
+ int recursive; /* If non-zero, removes directories that are
+ * nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a
- * new object containing name of file
- * causing error, with refCount 1. */
+ Tcl_Obj **errorPtr; /* If non-NULL, then will be set to a new
+ * object containing name of file causing
+ * error, with refCount 1. */
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
- if (fsPtr != NULL) {
+ if (fsPtr != NULL && fsPtr->removeDirectoryProc != 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 = TclPathPart(NULL, pathPtr,
- TCL_PATH_DIRNAME);
- Tcl_FSChdir(dirPtr);
- Tcl_DecrRefCount(dirPtr);
- }
+ 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 = TclPathPart(NULL, pathPtr,
+ TCL_PATH_DIRNAME);
+
+ Tcl_FSChdir(dirPtr);
+ Tcl_DecrRefCount(dirPtr);
}
- Tcl_DecrRefCount(cwdPtr);
}
+ Tcl_DecrRefCount(cwdPtr);
}
- return (*proc)(pathPtr, recursive, errorPtr);
}
+ return (*proc)(pathPtr, recursive, errorPtr);
}
Tcl_SetErrno(ENOENT);
return -1;
@@ -4211,13 +4310,13 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
*
* Tcl_FSGetFileSystemForPath --
*
- * This function determines which filesystem to use for a
- * particular path object, and returns the filesystem which
- * accepts this file. If no filesystem will accept this object
- * as a valid file path, then NULL is returned.
+ * This function determines which filesystem to use for a particular path
+ * object, and returns the filesystem which accepts this file. If no
+ * filesystem will accept this object 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.
@@ -4231,30 +4330,28 @@ Tcl_FSGetFileSystemForPath(pathPtr)
{
FilesystemRecord *fsRecPtr;
Tcl_Filesystem* retVal = NULL;
-
+
if (pathPtr == NULL) {
Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
return NULL;
}
-
- /*
- * If the object has a refCount of zero, we reject it. This
- * is to avoid possible segfaults or nondeterministic memory
- * leaks (i.e. the user doesn't know if they should decrement
- * the ref count on return or not).
+
+ /*
+ * If the object has a refCount of zero, we reject it. This is to avoid
+ * possible segfaults or nondeterministic memory leaks (i.e. the user
+ * doesn't know if they should decrement the ref count on return or not).
*/
-
+
if (pathPtr->refCount == 0) {
Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
return NULL;
}
-
- /*
- * Check if the filesystem has changed in some way since
- * this object's internal representation was calculated.
- * Before doing that, assure we have the most up-to-date
- * copy of the master filesystem. This is accomplished
- * by the FsGetFirstFilesystem() call.
+
+ /*
+ * Check if the filesystem has changed in some way since this object's
+ * internal representation was calculated. Before doing that, assure we
+ * have the most up-to-date copy of the master filesystem. This is
+ * accomplished by the FsGetFirstFilesystem() call.
*/
fsRecPtr = FsGetFirstFilesystem();
@@ -4265,20 +4362,22 @@ Tcl_FSGetFileSystemForPath(pathPtr)
/*
* Call each of the "pathInFilesystem" functions in succession. A
- * non-return value of -1 indicates the particular function has
- * succeeded.
+ * non-return value of -1 indicates the particular function has succeeded.
*/
while ((retVal == NULL) && (fsRecPtr != NULL)) {
- Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
+ Tcl_FSPathInFilesystemProc *proc =
+ fsRecPtr->fsPtr->pathInFilesystemProc;
+
if (proc != NULL) {
ClientData clientData = NULL;
int ret = (*proc)(pathPtr, &clientData);
if (ret != -1) {
- /*
- * We assume the type of pathPtr hasn't been changed
- * by the above call to the pathInFilesystemProc.
+ /*
+ * We assume the type of pathPtr hasn't been changed by the
+ * above call to the pathInFilesystemProc.
*/
+
TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
retVal = fsRecPtr->fsPtr;
}
@@ -4294,25 +4393,23 @@ Tcl_FSGetFileSystemForPath(pathPtr)
*
* Tcl_FSGetNativePath --
*
- * This function is for use by the Win/Unix native filesystems,
- * so that they can easily retrieve the native (char* or TCHAR*)
- * representation of a path. Other filesystems will probably
- * want to implement similar functions. They basically act as a
- * safety net around Tcl_FSGetInternalRep. Normally your file-
- * system procedures will always be called with path objects
- * already converted to the correct filesystem, but if for
- * some reason they are called directly (i.e. by procedures
- * not in this file), then one cannot necessarily guarantee that
- * the path object pointer is from the correct filesystem.
- *
- * Note: in the future it might be desireable to have separate
- * versions of this function with different signatures, for
- * example Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc.
- * Right now, since native paths are all string based, we use just
- * one function.
+ * This function is for use by the Win/Unix native filesystems, so that
+ * they can easily retrieve the native (char* or TCHAR*) representation
+ * of a path. Other filesystems will probably want to implement similar
+ * functions. They basically act as a safety net around
+ * Tcl_FSGetInternalRep. Normally your file- system procedures will
+ * always be called with path objects already converted to the correct
+ * filesystem, but if for some reason they are called directly (i.e. by
+ * procedures not in this file), then one cannot necessarily guarantee
+ * that the path object pointer is from the correct filesystem.
+ *
+ * Note: in the future it might be desireable to have separate versions
+ * of this function with different signatures, for example
+ * Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
+ * native paths are all string based, we use just one function.
*
* Results:
- * NULL or a valid native path.
+ * NULL or a valid native path.
*
* Side effects:
* See Tcl_FSGetInternalRep.
@@ -4324,7 +4421,7 @@ CONST char *
Tcl_FSGetNativePath(pathPtr)
Tcl_Obj *pathPtr;
{
- return (CONST char *)Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
+ return (CONST char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}
/*
@@ -4332,21 +4429,22 @@ Tcl_FSGetNativePath(pathPtr)
*
* NativeFreeInternalRep --
*
- * Free a native internal representation, which will be non-NULL.
+ * Free a native internal representation, which will be non-NULL.
*
* Results:
- * None.
+ * None.
*
* Side effects:
* Memory is released.
*
*---------------------------------------------------------------------------
*/
-static void
+
+static void
NativeFreeInternalRep(clientData)
ClientData clientData;
{
- ckfree((char*)clientData);
+ ckfree((char *) clientData);
}
/*
@@ -4354,19 +4452,19 @@ NativeFreeInternalRep(clientData)
*
* Tcl_FSFileSystemInfo --
*
- * This function returns a list of two elements. The first
- * element is the name of the filesystem (e.g. "native" or "vfs"),
- * and the second is the particular type of the given path within
- * that filesystem.
+ * This function returns a list of two elements. The first element is
+ * the name of the filesystem (e.g. "native" or "vfs"), and the second is
+ * the particular type of the given path within that filesystem.
*
* Results:
- * A list of two elements.
+ * A list of two elements.
*
* Side effects:
* The object may be converted to a path type.
*
*---------------------------------------------------------------------------
*/
+
Tcl_Obj*
Tcl_FSFileSystemInfo(pathPtr)
Tcl_Obj* pathPtr;
@@ -4374,15 +4472,15 @@ Tcl_FSFileSystemInfo(pathPtr)
Tcl_Obj *resPtr;
Tcl_FSFilesystemPathTypeProc *proc;
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
+
if (fsPtr == NULL) {
return NULL;
}
-
+
resPtr = Tcl_NewListObj(0,NULL);
-
- Tcl_ListObjAppendElement(NULL, resPtr,
- Tcl_NewStringObj(fsPtr->typeName,-1));
+
+ Tcl_ListObjAppendElement(NULL, resPtr,
+ Tcl_NewStringObj(fsPtr->typeName,-1));
proc = fsPtr->filesystemPathTypeProc;
if (proc != NULL) {
@@ -4391,7 +4489,7 @@ Tcl_FSFileSystemInfo(pathPtr)
Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
}
}
-
+
return resPtr;
}
@@ -4400,36 +4498,37 @@ Tcl_FSFileSystemInfo(pathPtr)
*
* Tcl_FSPathSeparator --
*
- * This function returns the separator to be used for a given
- * path. The object returned should have a refCount of zero
+ * This function returns the separator to be used for a given path. The
+ * object returned should have a refCount of zero
*
* Results:
- * A Tcl object, with a refCount of zero. If the caller
- * needs to retain a reference to the object, it should
- * call Tcl_IncrRefCount, and should otherwise free the
- * object.
+ * A Tcl object, with a refCount of zero. If the caller needs to retain a
+ * reference to the object, it should call Tcl_IncrRefCount, and should
+ * otherwise free the object.
*
* Side effects:
* The path object may be converted to a path type.
*
*---------------------------------------------------------------------------
*/
+
Tcl_Obj*
Tcl_FSPathSeparator(pathPtr)
Tcl_Obj* pathPtr;
{
Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
+
if (fsPtr == NULL) {
return NULL;
}
if (fsPtr->filesystemSeparatorProc != NULL) {
return (*fsPtr->filesystemSeparatorProc)(pathPtr);
} else {
- /*
- * Allow filesystems not to provide a filesystemSeparatorProc
- * if they wish to use the standard forward slash.
+ /*
+ * Allow filesystems not to provide a filesystemSeparatorProc if they
+ * wish to use the standard forward slash.
*/
+
return Tcl_NewStringObj("/", 1);
}
}
@@ -4439,29 +4538,30 @@ Tcl_FSPathSeparator(pathPtr)
*
* NativeFilesystemSeparator --
*
- * This function is part of the native filesystem support, and
- * returns the separator for the given path.
+ * This function is part of the native filesystem support, and returns
+ * the separator for the given path.
*
* Results:
- * String object containing the separator character.
+ * String object containing the separator character.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
+
static Tcl_Obj*
NativeFilesystemSeparator(pathPtr)
Tcl_Obj* pathPtr;
{
char *separator = NULL; /* lint */
switch (tclPlatform) {
- case TCL_PLATFORM_UNIX:
- separator = "/";
- break;
- case TCL_PLATFORM_WINDOWS:
- separator = "\\";
- break;
+ case TCL_PLATFORM_UNIX:
+ separator = "/";
+ break;
+ case TCL_PLATFORM_WINDOWS:
+ separator = "\\";
+ break;
}
return Tcl_NewStringObj(separator,1);
}
@@ -4475,18 +4575,17 @@ NativeFilesystemSeparator(pathPtr)
* TclStatInsertProc --
*
* Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to 'TclStat(...)'. The
- * passed function should behave exactly like 'TclStat' when called
- * during that time (see 'TclStat(...)' for more information).
- * The function will be added even if it already in the list.
+ * functions which are used during a call to 'TclStat(...)'. The passed
+ * function should behave exactly like 'TclStat' when called during that
+ * time (see 'TclStat(...)' for more information). The function will be
+ * added even if it already in the list.
*
* Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- * could not be allocated.
+ * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ * not be allocated.
*
* Side effects:
- * Memory allocated and modifies the link list for 'TclStat'
- * functions.
+ * Memory allocated and modifies the link list for 'TclStat' functions.
*
*----------------------------------------------------------------------
*/
@@ -4522,15 +4621,14 @@ TclStatInsertProc (proc)
* TclStatDeleteProc --
*
* Removed the passed function pointer from the list of 'TclStat'
- * functions. Ensures that the built-in stat function is not
- * removvable.
+ * functions. Ensures that the built-in stat function is not removvable.
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed,
- * TCL_ERROR otherwise.
+ * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * otherwise.
*
* Side effects:
- * Memory is deallocated and the respective list updated.
+ * Memory is deallocated and the respective list updated.
*
*----------------------------------------------------------------------
*/
@@ -4545,10 +4643,11 @@ TclStatDeleteProc (proc)
Tcl_MutexLock(&obsoleteFsHookMutex);
tmpStatProcPtr = statProcList;
+
/*
- * Traverse the 'statProcList' looking for the particular node
- * whose 'proc' member matches 'proc' and remove that one from
- * the list. Ensure that the "default" node cannot be removed.
+ * Traverse the 'statProcList' looking for the particular node whose
+ * 'proc' member matches 'proc' and remove that one from the list. Ensure
+ * that the "default" node cannot be removed.
*/
while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
@@ -4579,19 +4678,17 @@ TclStatDeleteProc (proc)
* TclAccessInsertProc --
*
* Insert the passed procedure pointer at the head of the list of
- * functions which are used during a call to 'TclAccess(...)'.
- * The passed function should behave exactly like 'TclAccess' when
- * called during that time (see 'TclAccess(...)' for more
- * information). The function will be added even if it already in
- * the list.
+ * functions which are used during a call to 'TclAccess(...)'. The
+ * passed function should behave exactly like 'TclAccess' when called
+ * during that time (see 'TclAccess(...)' for more information). The
+ * function will be added even if it already in the list.
*
* Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- * could not be allocated.
+ * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ * not be allocated.
*
* Side effects:
- * Memory allocated and modifies the link list for 'TclAccess'
- * functions.
+ * Memory allocated and modifies the link list for 'TclAccess' functions.
*
*----------------------------------------------------------------------
*/
@@ -4631,11 +4728,11 @@ TclAccessInsertProc(proc)
* removvable.
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed,
- * TCL_ERROR otherwise.
+ * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * otherwise.
*
* Side effects:
- * Memory is deallocated and the respective list updated.
+ * Memory is deallocated and the respective list updated.
*
*----------------------------------------------------------------------
*/
@@ -4649,9 +4746,9 @@ TclAccessDeleteProc(proc)
AccessProc *prevAccessProcPtr = NULL;
/*
- * Traverse the 'accessProcList' looking for the particular node
- * whose 'proc' member matches 'proc' and remove that one from
- * the list. Ensure that the "default" node cannot be removed.
+ * Traverse the 'accessProcList' looking for the particular node whose
+ * 'proc' member matches 'proc' and remove that one from the list. Ensure
+ * that the "default" node cannot be removed.
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -4684,18 +4781,18 @@ TclAccessDeleteProc(proc)
*
* Insert the passed procedure pointer at the head of the list of
* functions which are used during a call to
- * 'Tcl_OpenFileChannel(...)'. The passed function should behave
- * exactly like 'Tcl_OpenFileChannel' when called during that time
- * (see 'Tcl_OpenFileChannel(...)' for more information). The
- * function will be added even if it already in the list.
+ * 'Tcl_OpenFileChannel(...)'. The passed function should behave exactly
+ * like 'Tcl_OpenFileChannel' when called during that time (see
+ * 'Tcl_OpenFileChannel(...)' for more information). The function will be
+ * added even if it already in the list.
*
* Results:
- * Normally TCL_OK; TCL_ERROR if memory for a new node in the list
- * could not be allocated.
+ * Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
+ * not be allocated.
*
* Side effects:
- * Memory allocated and modifies the link list for
- * 'Tcl_OpenFileChannel' functions.
+ * Memory allocated and modifies the link list for 'Tcl_OpenFileChannel'
+ * functions.
*
*----------------------------------------------------------------------
*/
@@ -4709,21 +4806,19 @@ TclOpenFileChannelInsertProc(proc)
if (proc != NULL) {
OpenFileChannelProc *newOpenFileChannelProcPtr;
- newOpenFileChannelProcPtr =
- (OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
+ newOpenFileChannelProcPtr = (OpenFileChannelProc *)
+ ckalloc(sizeof(OpenFileChannelProc));
- if (newOpenFileChannelProcPtr != NULL) {
- newOpenFileChannelProcPtr->proc = proc;
- Tcl_MutexLock(&obsoleteFsHookMutex);
- newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
- openFileChannelProcList = newOpenFileChannelProcPtr;
- Tcl_MutexUnlock(&obsoleteFsHookMutex);
+ newOpenFileChannelProcPtr->proc = proc;
+ Tcl_MutexLock(&obsoleteFsHookMutex);
+ newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
+ openFileChannelProcList = newOpenFileChannelProcPtr;
+ Tcl_MutexUnlock(&obsoleteFsHookMutex);
- retVal = TCL_OK;
- }
+ retVal = TCL_OK;
}
- return (retVal);
+ return retVal;
}
/*
@@ -4732,15 +4827,15 @@ TclOpenFileChannelInsertProc(proc)
* TclOpenFileChannelDeleteProc --
*
* Removed the passed function pointer from the list of
- * 'Tcl_OpenFileChannel' functions. Ensures that the built-in
- * open file channel function is not removable.
+ * 'Tcl_OpenFileChannel' functions. Ensures that the built-in open file
+ * channel function is not removable.
*
* Results:
- * TCL_OK if the procedure pointer was successfully removed,
- * TCL_ERROR otherwise.
+ * TCL_OK if the procedure pointer was successfully removed, TCL_ERROR
+ * otherwise.
*
* Side effects:
- * Memory is deallocated and the respective list updated.
+ * Memory is deallocated and the respective list updated.
*
*----------------------------------------------------------------------
*/
@@ -4754,9 +4849,8 @@ TclOpenFileChannelDeleteProc(proc)
OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
/*
- * Traverse the 'openFileChannelProcList' looking for the particular
- * node whose 'proc' member matches 'proc' and remove that one from
- * the list.
+ * Traverse the 'openFileChannelProcList' looking for the particular node
+ * whose 'proc' member matches 'proc' and remove that one from the list.
*/
Tcl_MutexLock(&obsoleteFsHookMutex);
@@ -4771,7 +4865,7 @@ TclOpenFileChannelDeleteProc(proc)
tmpOpenFileChannelProcPtr->nextPtr;
}
- ckfree((char *)tmpOpenFileChannelProcPtr);
+ ckfree((char *) tmpOpenFileChannelProcPtr);
retVal = TCL_OK;
} else {
@@ -4784,3 +4878,11 @@ TclOpenFileChannelDeleteProc(proc)
return retVal;
}
#endif /* USE_OBSOLETE_FS_HOOKS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */