From 0229ba1283c2457c63df5674f54831eeb4a120ca Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sat, 4 Mar 2023 12:13:31 +0000
Subject: Bug [9c5a00c69d]. Tilde expansion on Windows

---
 win/tclWinFile.c | 73 +++++++++++++++++++++++++++-----------------------------
 1 file changed, 35 insertions(+), 38 deletions(-)

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 9a6c5f1..639cd72 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1458,22 +1458,43 @@ 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)) {
+                        Tcl_WinTCharToUtf((TCHAR *)buf,
+                                          (nChars-1)*sizeof(WCHAR),
+                                          bufferPtr);
+                        result = Tcl_DStringValue(bufferPtr);
+                        rc = 1;
+                    }
+                    CloseHandle(hToken);
+                }
+            }
 	}
 	Tcl_DStringFree(&ds);
     } else {
@@ -1542,30 +1563,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;
 }
-- 
cgit v0.12


From c862e5709590a9330c9b814109a0fbfd70f027cb Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sat, 4 Mar 2023 15:11:01 +0000
Subject: Add test for [9c5a00c69d], tilde expansion of ~user

---
 tests/fileSystem.test | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index f363d86..2de778a 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -277,6 +277,16 @@ test filesystem-1.30.1 {normalisation of existing user} -body {
 test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body {
     file normalize ~nonexistentuser@nonexistentdomain
 } -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist}
+test filesystem-1.30.3 {file normalization should distinguish between ~ and ~user} -setup {
+    set oldhome $::env(HOME)
+    set olduserhome [file normalize ~$::tcl_platform(user)]
+    set ::env(HOME) [file join $oldhome temp]
+} -cleanup {
+    set env(HOME) $oldhome
+} -body {
+    list [string equal [file normalize ~] $::env(HOME)] \
+        [string equal $olduserhome [file normalize ~$::tcl_platform(user)]]
+} -result {1 1}
 test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
     testsetplatform unix
     file normalize /foo/../bar
-- 
cgit v0.12