summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog37
-rw-r--r--generic/tcl.h5
-rw-r--r--generic/tclFileName.c12
-rw-r--r--generic/tclIOUtil.c177
-rw-r--r--generic/tclPathObj.c16
-rw-r--r--generic/tclTest.c20
-rw-r--r--mac/tclMacFile.c7
-rw-r--r--tests/fileName.test19
-rw-r--r--unix/tclUnixFCmd.c24
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--win/tclWin32Dll.c37
-rw-r--r--win/tclWinFCmd.c31
-rw-r--r--win/tclWinFile.c158
-rw-r--r--win/tclWinInt.h27
14 files changed, 526 insertions, 57 deletions
diff --git a/ChangeLog b/ChangeLog
index 376835e..25c702e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;