diff options
Diffstat (limited to 'generic/tclIOUtil.c')
| -rw-r--r-- | generic/tclIOUtil.c | 3224 |
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: + */ |