diff options
| -rw-r--r-- | ChangeLog | 37 | ||||
| -rw-r--r-- | generic/tcl.h | 5 | ||||
| -rw-r--r-- | generic/tclFileName.c | 12 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 177 | ||||
| -rw-r--r-- | generic/tclPathObj.c | 16 | ||||
| -rw-r--r-- | generic/tclTest.c | 20 | ||||
| -rw-r--r-- | mac/tclMacFile.c | 7 | ||||
| -rw-r--r-- | tests/fileName.test | 19 | ||||
| -rw-r--r-- | unix/tclUnixFCmd.c | 24 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 13 | ||||
| -rw-r--r-- | win/tclWin32Dll.c | 37 | ||||
| -rw-r--r-- | win/tclWinFCmd.c | 31 | ||||
| -rw-r--r-- | win/tclWinFile.c | 158 | ||||
| -rw-r--r-- | win/tclWinInt.h | 27 |
14 files changed, 526 insertions, 57 deletions
@@ -1,3 +1,40 @@ +2003-10-13 Vince Darley <vincentdarley@users.sourceforge.net> + + * generic/tcl.h: + * generic/tclFileName.c: + * generic/tclIOUtil.c: + * generic/tclPathObj.c: + * generic/tclTest.c: + * mac/tclMacFile.c: + * tests/fileName.test: better tests for [Bug 813273] + * unix/tclUnixFCmd.c: + * unix/tclUnixFile.c: + * win/tclWin32Dll.c: + * win/tclWinFCmd.c: + * win/tclWinFile.c: + * win/tclFileInt.h: + + Fixed [Bug 800106] in which 'glob' was incapable of merging the + results of a directory listing (real or virtual) and any virtual + filesystem mountpoints in that directory (the latter were + ignored). This meant boundaries between different filesystems + were not seamless (e.g. 'glob */*' across a filesystem boundary + was wrong). Added new entry to Tcl_GlobTypeData in a totally + backwards compatible way. To allow listing of mounts, registered + filesystems must support the 'TCL_GLOB_TYPE_MOUNT' flag. If this + is not supported (e.g. in tclvfs 1.2) then mounts will simply not + be listed for that filesystem. + + Fixed [Bug 749876] 'file writable/readable/etc' (NativeAccess) + using correct permission checking code for Windows NT/2000/XP + where more complex user-based security/access priveleges are + available, particularly on shared volumes. The performance + impact of this extra checking will need further investigation. + Note: Win 95,98,ME have no support for this. + + Also made better use of normalized rather than translated paths + in the platform specific code. + 2003-10-12 Jeff Hobbs <jeffh@ActiveState.com> * unix/tclUnixTest.c (TestalarmCmd): don't bother checking return diff --git a/generic/tcl.h b/generic/tcl.h index 692cbf3..e89690d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.165 2003/09/04 16:44:12 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.166 2003/10/13 16:48:06 vincentdarley Exp $ */ #ifndef _TCL @@ -1615,6 +1615,7 @@ typedef struct Tcl_GlobTypeData { #define TCL_GLOB_TYPE_FILE (1<<4) #define TCL_GLOB_TYPE_LINK (1<<5) #define TCL_GLOB_TYPE_SOCK (1<<6) +#define TCL_GLOB_TYPE_MOUNT (1<<7) #define TCL_GLOB_PERM_RONLY (1<<0) #define TCL_GLOB_PERM_HIDDEN (1<<1) @@ -1790,7 +1791,7 @@ typedef struct Tcl_Filesystem { * 'Tcl_FSLink()' call. Should be * implemented only if the filesystem supports * links (reading or creating). */ - Tcl_FSListVolumesProc *listVolumesProc; + Tcl_FSListVolumesProc *listVolumesProc; /* Function to list any filesystem volumes * added by this filesystem. Should be * implemented only if the filesystem adds diff --git a/generic/tclFileName.c b/generic/tclFileName.c index f607def..c9995f6 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.43 2003/07/17 00:20:41 hobbs Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.44 2003/10/13 16:48:06 vincentdarley Exp $ */ #include "tclInt.h" @@ -1380,17 +1380,19 @@ Tcl_TranslateFileName(interp, name, bufferPtr) * with name after tilde substitution. */ { Tcl_Obj *path = Tcl_NewStringObj(name, -1); - CONST char *result; + Tcl_Obj *transPtr; Tcl_IncrRefCount(path); - result = Tcl_FSGetTranslatedStringPath(interp, path); - if (result == NULL) { + transPtr = Tcl_FSGetTranslatedPath(interp, path); + if (transPtr == NULL) { Tcl_DecrRefCount(path); return NULL; } + Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, result, -1); + Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); Tcl_DecrRefCount(path); + Tcl_DecrRefCount(transPtr); /* * Convert forward slashes to backslashes in Windows paths because diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 43f68e0..8586eb3 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.85 2003/10/10 15:50:35 dkf Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.86 2003/10/13 16:48:06 vincentdarley Exp $ */ #include "tclInt.h" @@ -35,9 +35,13 @@ * Prototypes for procedures defined later in this file. */ -static FilesystemRecord* FsGetFirstFilesystem(void); -static void FsThrExitProc(ClientData cd); - +static FilesystemRecord* FsGetFirstFilesystem _ANSI_ARGS_((void)); +static void FsThrExitProc _ANSI_ARGS_((ClientData cd)); +static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, + CONST char *pattern)); +static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_((Tcl_Obj *result, + Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)); + #ifdef TCL_THREADS static void FsRecacheFilesystemList(void); #endif @@ -922,7 +926,12 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) if (fsPtr != NULL) { Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc; if (proc != NULL) { - return (*proc)(interp, result, pathPtr, pattern, types); + int ret = (*proc)(interp, result, pathPtr, pattern, types); + if (ret == TCL_OK && pattern != NULL) { + result = FsAddMountsToGlobResult(result, pathPtr, + pattern, types); + } + return ret; } } else { Tcl_Obj* cwd; @@ -967,6 +976,9 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) if (ret == TCL_OK) { int resLength; + tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd, + pattern, types); + ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength); if (ret == TCL_OK) { int i; @@ -993,6 +1005,92 @@ Tcl_FSMatchInDirectory(interp, result, 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: + * + * The passed in 'result' may be modified (in place, if + * necessary), and the correct list is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static Tcl_Obj* +FsAddMountsToGlobResult(result, pathPtr, pattern, types) + Tcl_Obj *result; /* The current list of matching paths */ + Tcl_Obj *pathPtr; /* The directory in question */ + CONST char *pattern; + Tcl_GlobTypeData *types; +{ + int mLength, gLength, i; + int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); + Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); + + if (mounts == NULL) return result; + + if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) { + goto endOfMounts; + } + if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) { + goto endOfMounts; + } + 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++) { + Tcl_Obj *gElt; + Tcl_ListObjIndex(NULL, result, j, &gElt); + if (Tcl_FSEqualPaths(mElt, gElt)) { + found = 1; + if (!dir) { + /* We don't want to list this */ + if (Tcl_IsShared(result)) { + Tcl_Obj *newList; + newList = Tcl_DuplicateObj(result); + Tcl_DecrRefCount(result); + result = newList; + } + Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL); + gLength--; + } + /* Break out of for loop */ + break; + } + } + if (!found && dir) { + if (Tcl_IsShared(result)) { + Tcl_Obj *newList; + newList = Tcl_DuplicateObj(result); + Tcl_DecrRefCount(result); + result = newList; + } + Tcl_ListObjAppendElement(NULL, result, mElt); + /* + * No need to increment gLength, since we + * don't want to compare mounts against + * mounts. + */ + } + } + endOfMounts: + Tcl_DecrRefCount(mounts); + return result; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_FSMountsChanged -- * * Notify the filesystem that the available mounted filesystems @@ -1627,6 +1725,9 @@ Tcl_FSStat(pathPtr, buf) retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer); statProcPtr = statProcPtr->nextPtr; } + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } } Tcl_MutexUnlock(&obsoleteFsHookMutex); @@ -1754,6 +1855,9 @@ Tcl_FSAccess(pathPtr, mode) retVal = (*accessProcPtr->proc)(path, mode); accessProcPtr = accessProcPtr->nextPtr; } + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } } Tcl_MutexUnlock(&obsoleteFsHookMutex); @@ -1831,6 +1935,9 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) modeString, permissions); openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; } + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } } Tcl_MutexUnlock(&obsoleteFsHookMutex); if (retVal != NULL) { @@ -2816,7 +2923,7 @@ Tcl_FSListVolumes(void) * a list of all drives from all filesystems. */ - fsRecPtr = FsGetFirstFilesystem(); + fsRecPtr = FsGetFirstFilesystem(); while (fsRecPtr != NULL) { Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc; if (proc != NULL) { @@ -2835,6 +2942,59 @@ Tcl_FSListVolumes(void) /* *--------------------------------------------------------------------------- * + * FsListMounts -- + * + * 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. + * + * Side effects: + * None + * + *--------------------------------------------------------------------------- + */ + +static Tcl_Obj* +FsListMounts(pathPtr, pattern) + 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 "listMounts" functions in succession. + * 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; + if (proc != NULL) { + if (resultPtr == NULL) { + resultPtr = Tcl_NewObj(); + } + (*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly); + } + } + fsRecPtr = fsRecPtr->nextPtr; + } + + return resultPtr; +} + +/* + *--------------------------------------------------------------------------- + * * Tcl_FSSplitPath -- * * This function takes the given Tcl_Obj, which should be a valid @@ -3431,6 +3591,11 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) FilesystemRecord *fsRecPtr; Tcl_Filesystem* retVal = NULL; + if (pathObjPtr == NULL) { + 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 diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 18d3dd4..8fa73d5 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPathObj.c,v 1.11 2003/10/10 15:50:35 dkf Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.12 2003/10/13 16:48:06 vincentdarley Exp $ */ #include "tclInt.h" @@ -377,6 +377,7 @@ Tcl_FSJoinPath(listObj, elements) * '/'. There's no need to return a special path * object, when the base itself is just fine! */ + Tcl_DecrRefCount(res); return elt; } /* @@ -390,6 +391,7 @@ Tcl_FSJoinPath(listObj, elements) */ if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(str, '\\') == NULL))) { + Tcl_DecrRefCount(res); return TclNewFSPathObj(elt, str, len); } /* @@ -399,6 +401,7 @@ Tcl_FSJoinPath(listObj, elements) */ } else { if (tclPlatform == TCL_PLATFORM_UNIX) { + Tcl_DecrRefCount(res); return tail; } else { CONST char *str; @@ -406,10 +409,12 @@ Tcl_FSJoinPath(listObj, elements) str = Tcl_GetStringFromObj(tail,&len); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { + Tcl_DecrRefCount(res); return tail; } } else if (tclPlatform == TCL_PLATFORM_MAC) { if (strchr(str, '/') == NULL) { + Tcl_DecrRefCount(res); return tail; } } @@ -965,6 +970,7 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) retObj = srcFsPathPtr->translatedPathPtr; } + Tcl_IncrRefCount(retObj); return retObj; } @@ -995,7 +1001,13 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr) Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - return Tcl_GetString(transPtr); + int len; + CONST char *result, *orig; + orig = Tcl_GetStringFromObj(transPtr, &len); + result = (char*) ckalloc((unsigned)(len+1)); + memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1)); + Tcl_DecrRefCount(transPtr); + return result; } return NULL; diff --git a/generic/tclTest.c b/generic/tclTest.c index 8f322fc..effa8a3 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.68 2003/10/08 14:24:41 dkf Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.69 2003/10/13 16:48:06 vincentdarley Exp $ */ #define TCL_TEST @@ -6080,17 +6080,23 @@ TestReportOpenFileChannel(interp, fileName, mode, permissions) static int TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types) - Tcl_Interp *interp; /* Interpreter to receive results. */ - Tcl_Obj *resultPtr; /* Directory separators to pass to TclDoGlob. */ + Tcl_Interp *interp; /* Interpreter for error + * messages. */ + Tcl_Obj *resultPtr; /* Object to lappend results. */ Tcl_Obj *dirPtr; /* 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. */ { - TestReport("matchindirectory",dirPtr, NULL); - return Tcl_FSMatchInDirectory(interp, resultPtr, - TestReportGetNativePath(dirPtr), pattern, - types); + if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) { + TestReport("matchmounts",dirPtr, NULL); + return TCL_OK; + } else { + TestReport("matchindirectory",dirPtr, NULL); + return Tcl_FSMatchInDirectory(interp, resultPtr, + TestReportGetNativePath(dirPtr), pattern, + types); + } } static int TestReportChdir(dirName) diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c index 0311ecd..be89237 100644 --- a/mac/tclMacFile.c +++ b/mac/tclMacFile.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacFile.c,v 1.27 2003/03/03 20:22:43 das Exp $ + * RCS: @(#) $Id: tclMacFile.c,v 1.28 2003/10/13 16:48:07 vincentdarley Exp $ */ /* @@ -178,6 +178,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (TclpObjLstat(fileNamePtr, &buf) != 0) { /* File doesn't exist */ + Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } @@ -202,6 +203,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } } + Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } else { char *fname; @@ -258,6 +260,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if ((err != noErr) || !isDirectory) { Tcl_DStringFree(&dsOrig); + Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } } @@ -326,6 +329,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } Tcl_DStringFree(&dsOrig); + Tcl_DecrRefCount(fileNamePtr); return result; } } @@ -1211,6 +1215,7 @@ TclpObjLink(pathPtr, toPtr, linkAction) Tcl_IncrRefCount(link); Tcl_DStringFree(&ds); } + Tcl_DecrRefCount(transPtr); } return link; } diff --git a/tests/fileName.test b/tests/fileName.test index de5c655..e75a1b7 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fileName.test,v 1.32 2003/09/30 14:05:45 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.33 2003/10/13 16:48:07 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -911,6 +911,23 @@ test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} { [file join C:/blah {C:\foo\bar}] \ [file join C:/blah C:/blah {C:\foo\bar}] } {C:/foo/bar C:/foo/bar C:/foo/bar} +test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} { + testsetplatform win + set res {} + lappend res \ + [file join {foo\bar}] \ + [file join C:/blah {foo\bar}] \ + [file join C:/blah C:/blah {foo\bar}] +} {foo/bar C:/blah/foo/bar C:/blah/foo/bar} +test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform winOnly} { + testsetplatform win + set res {} + lappend res \ + [file join {foo\bar}] \ + [file join [pwd] {foo\bar}] \ + [file join [pwd] [pwd] {foo\bar}] + string map [list [pwd] pwd] $res +} {foo/bar pwd/foo/bar pwd/foo/bar} test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix set res {} diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 1754e2d..7301017 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.31 2003/07/18 02:02:02 das Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.32 2003/10/13 16:48:07 vincentdarley Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -658,13 +658,22 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_DString ds; Tcl_DString srcString, dstString; int ret; - + Tcl_Obj *transPtr; + + transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); Tcl_UtfToExternalDString(NULL, - Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), -1, &srcString); + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } + transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); Tcl_UtfToExternalDString(NULL, - Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), -1, &dstString); + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds); @@ -715,9 +724,14 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) Tcl_DString ds; Tcl_DString pathString; int ret; + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr), + Tcl_UtfToExternalDString(NULL, + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), -1, &pathString); + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } ret = DoRemoveDirectory(&pathString, recursive, &ds); Tcl_DStringFree(&pathString); diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 3e74d16..d68bebd 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.32 2003/02/12 18:57:52 vincentdarley Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.33 2003/10/13 16:48:07 vincentdarley Exp $ */ #include "tclInt.h" @@ -221,6 +221,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (NativeMatchType(native, types)) { Tcl_ListObjAppendElement(interp, resultPtr, pathPtr); } + Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } else { DIR *d; @@ -277,6 +278,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_DStringValue(&dsOrig), "\": ", Tcl_PosixError(interp), (char *) NULL); Tcl_DStringFree(&dsOrig); + Tcl_DecrRefCount(fileNamePtr); return TCL_ERROR; } @@ -330,6 +332,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) closedir(d); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); + Tcl_DecrRefCount(fileNamePtr); return TCL_OK; } } @@ -745,10 +748,14 @@ TclpObjLink(pathPtr, toPtr, linkAction) char link[MAXPATHLEN]; int length; Tcl_DString ds; - - if (Tcl_FSGetTranslatedPath(NULL, pathPtr) == NULL) { + Tcl_Obj *transPtr; + + transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (transPtr == NULL) { return NULL; } + Tcl_DecrRefCount(transPtr); + length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link)); if (length < 0) { return NULL; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 09b9046..dc497f4 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWin32Dll.c,v 1.27 2003/09/29 22:38:21 dkf Exp $ + * RCS: @(#) $Id: tclWin32Dll.c,v 1.28 2003/10/13 16:48:07 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -99,6 +99,8 @@ static TclWinProcs asciiProcs = { (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, NULL, NULL, + /* Security SDK - not available on 95,98,ME */ + NULL, NULL, NULL, NULL, NULL, NULL }; static TclWinProcs unicodeProcs = { @@ -148,6 +150,8 @@ static TclWinProcs unicodeProcs = { (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, NULL, NULL, + /* Security SDK - will be filled in on NT,XP,2000,2003 */ + NULL, NULL, NULL, NULL, NULL, NULL }; TclWinProcs *tclWinProcs; @@ -567,6 +571,37 @@ TclWinSetInterfaces( "GetVolumeNameForVolumeMountPointW"); FreeLibrary(hInstance); } + hInstance = LoadLibraryA("advapi32"); + if (hInstance != NULL) { + tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)( + LPCTSTR lpFileName, + SECURITY_INFORMATION RequestedInformation, + PSECURITY_DESCRIPTOR pSecurityDescriptor, DWORD nLength, + LPDWORD lpnLengthNeeded)) GetProcAddress(hInstance, + "GetFileSecurityW"); + tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) ( + SECURITY_IMPERSONATION_LEVEL ImpersonationLevel)) + GetProcAddress(hInstance, "ImpersonateSelf"); + tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) ( + HANDLE ThreadHandle, DWORD DesiredAccess, BOOL OpenAsSelf, + PHANDLE TokenHandle)) GetProcAddress(hInstance, + "OpenThreadToken"); + tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void)) + GetProcAddress(hInstance, "RevertToSelf"); + tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) ( + PDWORD AccessMask, PGENERIC_MAPPING GenericMapping)) + GetProcAddress(hInstance, "MapGenericMask"); + tclWinProcs->accessCheckProc = (BOOL (WINAPI *)( + PSECURITY_DESCRIPTOR pSecurityDescriptor, + HANDLE ClientToken, DWORD DesiredAccess, + PGENERIC_MAPPING GenericMapping, + PPRIVILEGE_SET PrivilegeSet, + LPDWORD PrivilegeSetLength, + LPDWORD GrantedAccess, + LPBOOL AccessStatus)) GetProcAddress(hInstance, + "AccessCheck"); + FreeLibrary(hInstance); + } } } else { tclWinProcs = &asciiProcs; diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 3f2addb..519df62 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.36 2003/06/02 15:58:47 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.37 2003/10/13 16:48:07 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -862,12 +862,13 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) { Tcl_DString ds; Tcl_DString srcString, dstString; + Tcl_Obj *normSrcPtr, *normDestPtr; int ret; - Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), - -1, &srcString); - Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), - -1, &dstString); + normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr); + Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString); + normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr); + Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString); ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); @@ -875,7 +876,13 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_DStringFree(&dstString); if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normSrcPtr))) { + *errorPtr = srcPathPtr; + } else if (!strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normDestPtr))) { + *errorPtr = destPathPtr; + } else { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } @@ -918,6 +925,7 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) Tcl_Obj **errorPtr; { Tcl_DString ds; + Tcl_Obj *normPtr = NULL; int ret; if (recursive) { /* @@ -926,8 +934,8 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) * optimize this case easily. */ Tcl_DString native; - Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), - -1, &native); + normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); + Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native); ret = DoRemoveDirectory(&native, recursive, &ds); Tcl_DStringFree(&native); } else { @@ -937,7 +945,12 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) if (ret != TCL_OK) { int len = Tcl_DStringLength(&ds); if (len > 0) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + if (normPtr != NULL + && !strcmp(Tcl_DStringValue(&ds), Tcl_GetString(normPtr))) { + *errorPtr = pathPtr; + } else { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + } Tcl_IncrRefCount(*errorPtr); } Tcl_DStringFree(&ds); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8768261..f787669 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.54 2003/09/29 22:38:21 dkf Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.55 2003/10/13 16:48:07 vincentdarley Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -1291,9 +1291,10 @@ TclpGetUserHome(name, bufferPtr) */ static int -NativeAccess( - CONST TCHAR *nativePath, /* Path of file to access (UTF-8). */ - int mode) /* Permission setting. */ +NativeAccess(nativePath, mode) + CONST TCHAR *nativePath; /* Path of file to access, native + * encoding. */ + int mode; /* Permission setting. */ { DWORD attr; @@ -1312,26 +1313,151 @@ NativeAccess( /* * File is not writable. */ - Tcl_SetErrno(EACCES); return -1; } if (mode & X_OK) { - if (attr & FILE_ATTRIBUTE_DIRECTORY) { + if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) { /* - * Directories are always executable. + * It's not a directory and doesn't have the correct + * extension. Therefore it can't be executable */ - - return 0; - } - if (NativeIsExec(nativePath)) { - return 0; + Tcl_SetErrno(EACCES); + return -1; } - Tcl_SetErrno(EACCES); - return -1; } + /* + * It looks as if the permissions are ok, but if we are on NT, 2000 + * or XP, we have a more complex permissions structure so we try to + * check that. The code below is remarkably complex for such a + * simple thing as finding what permissions the OS has set for a + * file. + * + * If we are simply checking for file existence, then we don't + * need all these complications (which are really quite slow: + * with this code 'file readable' is 5-6 times slower than 'file + * exists'). + */ + + if ((mode != F_OK) && (tclWinProcs->getFileSecurityProc != NULL)) { + SECURITY_DESCRIPTOR *sdPtr = NULL; + unsigned long size; + GENERIC_MAPPING genMap; + HANDLE hToken = NULL; + DWORD desiredAccess = 0; + DWORD grantedAccess; + BOOL accessYesNo; + PRIVILEGE_SET privSet; + DWORD privSetSize = sizeof(PRIVILEGE_SET); + int error; + + /* + * First find out how big the buffer needs to be + */ + size = 0; + (*tclWinProcs->getFileSecurityProc)(nativePath, + OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION + | DACL_SECURITY_INFORMATION, 0, 0, &size); + + /* + * Should have failed with ERROR_INSUFFICIENT_BUFFER + */ + error = GetLastError(); + if (error != ERROR_INSUFFICIENT_BUFFER) { + /* + * Most likely case is ERROR_ACCESS_DENIED, which + * we will convert to EACCES - just what we want! + */ + TclWinConvertError(error); + return -1; + } + + /* + * Now size contains the size of buffer needed + */ + sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size); + + if (sdPtr == NULL) { + goto accessError; + } + + /* + * Call GetFileSecurity() for real + */ + if (!(*tclWinProcs->getFileSecurityProc)(nativePath, + OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION + | DACL_SECURITY_INFORMATION, sdPtr, size, &size)) { + /* + * Error getting owner SD + */ + goto accessError; + } + + /* + * Perform security impersonation of the user and open the + * resulting thread token. + */ + if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) { + /* + * Unable to perform security impersonation. + */ + goto accessError; + } + if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread (), + TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) { + /* + * Unable to get current thread's token. + */ + goto accessError; + } + (*tclWinProcs->revertToSelfProc)(); + memset (&genMap, 0x00, sizeof (GENERIC_MAPPING)); + /* + * Fill GenericMask type according to access priveleges + * we are checking. + */ + genMap.GenericAll = 0; + if (mode & R_OK) { + genMap.GenericRead = FILE_GENERIC_READ; + } + if (mode & W_OK) { + genMap.GenericWrite = FILE_GENERIC_WRITE; + } + if (mode & X_OK) { + genMap.GenericExecute = FILE_GENERIC_EXECUTE; + } + (*tclWinProcs->mapGenericMaskProc)(&desiredAccess, &genMap); + /* + * Perform access check using the token. + */ + if (!(*tclWinProcs->accessCheckProc )(sdPtr, hToken, desiredAccess, + &genMap, &privSet, &privSetSize, &grantedAccess, + &accessYesNo)) { + /* + * Unable to perform access check. + */ + accessError: + TclWinConvertError(GetLastError()); + if (sdPtr != NULL) { + HeapFree(GetProcessHeap(), 0, sdPtr); + } + if (hToken != NULL) { + CloseHandle(hToken); + } + return -1; + } + /* + * Clean up. + */ + HeapFree(GetProcessHeap (), 0, sdPtr); + CloseHandle(hToken); + if (!accessYesNo) { + Tcl_SetErrno(EACCES); + return -1; + } + } return 0; } @@ -1582,9 +1708,13 @@ TclpObjStat(pathPtr, statPtr) transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } Tcl_SetErrno(ENOENT); return -1; } + Tcl_DecrRefCount(transPtr); #endif /* diff --git a/win/tclWinInt.h b/win/tclWinInt.h index d953c5b..b2cb74e 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinInt.h,v 1.22 2003/04/18 20:17:45 hobbs Exp $ + * RCS: @(#) $Id: tclWinInt.h,v 1.23 2003/10/13 16:48:07 vincentdarley Exp $ */ #ifndef _TCLWININT @@ -111,6 +111,31 @@ typedef struct TclWinProcs { LPVOID, UINT, LPVOID, DWORD); BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD); + /* + * These six are for the security sdk to get correct file + * permissions on NT, 2000, XP, etc. On 95,98,ME they are + * always null. + */ + BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName, + SECURITY_INFORMATION RequestedInformation, + PSECURITY_DESCRIPTOR pSecurityDescriptor, + DWORD nLength, + LPDWORD lpnLengthNeeded); + BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL + ImpersonationLevel); + BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle, + DWORD DesiredAccess, BOOL OpenAsSelf, + PHANDLE TokenHandle); + BOOL (WINAPI *revertToSelfProc) (void); + VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask, + PGENERIC_MAPPING GenericMapping); + BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor, + HANDLE ClientToken, DWORD DesiredAccess, + PGENERIC_MAPPING GenericMapping, + PPRIVILEGE_SET PrivilegeSet, + LPDWORD PrivilegeSetLength, + LPDWORD GrantedAccess, + LPBOOL AccessStatus); } TclWinProcs; EXTERN TclWinProcs *tclWinProcs; |