filesystem bug fixes

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;