Merge trunk

1 files changed, 41 insertions, 47 deletions

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 30ca622..b16a707 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -170,7 +170,7 @@ static int		NativeWriteReparse(const WCHAR *LinkDirectory,
 static int		NativeMatchType(int isDrive, DWORD attr,
 			    const WCHAR *nativeName, Tcl_GlobTypeData *types);
 static int		WinIsDrive(const char *name, size_t nameLen);
-static Tcl_Size		WinIsReserved(const char *path);
+static size_t		WinIsReserved(const char *path);
 static Tcl_Obj *	WinReadLink(const WCHAR *LinkSource);
 static Tcl_Obj *	WinReadLinkDirectory(const WCHAR *LinkDirectory);
 static int		WinLink(const WCHAR *LinkSource,
@@ -921,7 +921,7 @@ TclpMatchInDirectory(
 
 	    DWORD attr;
 	    WIN32_FILE_ATTRIBUTE_DATA data;
-	    Tcl_Size len = 0;
+	    size_t len = 0;
 	    const char *str = Tcl_GetStringFromObj(norm, &len);
 
 	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
@@ -943,7 +943,7 @@ TclpMatchInDirectory(
 	WIN32_FIND_DATAW data;
 	const char *dirName;	/* UTF-8 dir name, later with pattern
 				 * appended. */
-	Tcl_Size dirLength;
+	size_t dirLength;
 	int matchSpecialDots;
 	Tcl_DString ds;		/* Native encoding of dir, also used
 				 * temporarily for other things. */
@@ -1226,7 +1226,7 @@ WinIsDrive(
  * (not any trailing :).
  */
 
-static Tcl_Size
+static size_t
 WinIsReserved(
     const char *path)		/* Path in UTF-8 */
 {
@@ -1438,21 +1438,39 @@ TclpGetUserHome(
     if (domain == NULL) {
 	const char *ptr;
 
-	/*
-	 * No domain. Firstly check it's the current user
-	 */
-
+        /*
+         * Treat the current user as a special case because the general case
+         * below does not properly retrieve the path. The NetUserGetInfo
+         * call returns an empty path and the code defaults to the user's
+         * name in the profiles directory. On modern Windows systems, this
+         * is generally wrong as when the account is a Microsoft account,
+         * for example abcdefghi@outlook.com, the directory name is
+         * abcde and not abcdefghi.
+         *
+         * Note we could have just used env(USERPROFILE) here but
+         * the intent is to retrieve (as on Unix) the system's view
+         * of the home irrespective of environment settings of HOME
+         * and USERPROFILE.
+         *
+         * Fixing this for the general user needs more investigating but
+         * at least for the current user we can use a direct call.
+         */
 	ptr = TclpGetUserName(&ds);
 	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
-	    /*
-	     * Try safest and fastest way to get current user home
-	     */
-
-	    ptr = TclGetEnv("HOME", &ds);
-	    if (ptr != NULL) {
-		Tcl_JoinPath(1, &ptr, bufferPtr);
-		rc = 1;
-		result = Tcl_DStringValue(bufferPtr);
+	    HANDLE hProcess;
+	    WCHAR buf[MAX_PATH];
+	    DWORD nChars = sizeof(buf) / sizeof(buf[0]);
+	    /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
+	    hProcess = GetCurrentProcess(); /* Need not be closed */
+	    if (hProcess) {
+		HANDLE hToken;
+		if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
+		    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
+			result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr));
+			rc = 1;
+		    }
+		    CloseHandle(hToken);
+		}
 	    }
 	}
 	Tcl_DStringFree(&ds);
@@ -1524,30 +1542,6 @@ TclpGetUserHome(
     if (wDomain != NULL) {
 	NetApiBufferFree((void *) wDomain);
     }
-    if (result == NULL) {
-	/*
-	 * Look in the "Password Lists" section of system.ini for the local
-	 * user. There are also entries in that section that begin with a "*"
-	 * character that are used by Windows for other purposes; ignore user
-	 * names beginning with a "*".
-	 */
-
-	char buf[MAX_PATH];
-
-	if (name[0] != '*') {
-	    if (GetPrivateProfileStringA("Password Lists", name, "", buf,
-		    MAX_PATH, "system.ini") > 0) {
-		/*
-		 * User exists, but there is no such thing as a home directory
-		 * in system.ini. Return "{Windows drive}:/".
-		 */
-
-		GetWindowsDirectoryA(buf, MAX_PATH);
-		Tcl_DStringAppend(bufferPtr, buf, 3);
-		result = Tcl_DStringValue(bufferPtr);
-	    }
-	}
-    }
 
     return result;
 }
@@ -2566,14 +2560,14 @@ TclpObjNormalizePath(
 		 */
 
 		if (isDrive) {
-		    Tcl_Size len = WinIsReserved(path);
+		    size_t len = WinIsReserved(path);
 
 		    if (len > 0) {
 			/*
 			 * Actually it does exist - COM1, etc.
 			 */
 
-			Tcl_Size i;
+			size_t i;
 
 			for (i=0 ; i<len ; i++) {
 			    WCHAR wc = ((WCHAR *)nativePath)[i];
@@ -2802,7 +2796,7 @@ TclpObjNormalizePath(
 	     */
 
 	    Tcl_Obj *tmpPathPtr;
-	    Tcl_Size len;
+	    size_t len;
 
 	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
 		    nextCheckpoint);
@@ -2891,7 +2885,7 @@ TclWinVolumeRelativeNormalize(
 	 * also on drive C.
 	 */
 
-	Tcl_Size cwdLen;
+	size_t cwdLen;
 	const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
 	char drive_cur = path[0];
 
@@ -2965,7 +2959,7 @@ TclpNativeToNormalized(
 {
     Tcl_DString ds;
     Tcl_Obj *objPtr;
-    Tcl_Size len;
+    size_t len;
     char *copy, *p;
 
     Tcl_DStringInit(&ds);
@@ -3028,7 +3022,7 @@ TclNativeCreateNativeRep(
     WCHAR *nativePathPtr = NULL;
     const char *str;
     Tcl_Obj *validPathPtr;
-    Tcl_Size len;
+    size_t len;
     WCHAR *wp;
 
     if (TclFSCwdIsNative()) {