summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--tests/fCmd.test66
-rw-r--r--tests/fileSystem.test10
-rw-r--r--win/tclWinFile.c73
3 files changed, 106 insertions, 43 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 13f4cf1..246d65b 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -27,7 +27,7 @@ testConstraint winLessThan10 0
testConstraint notNetworkFilesystem 0
testConstraint reg 0
if {[testConstraint win]} {
- catch {
+ if {[catch {
# Is the registry extension already static to this shell?
try {
load {} Registry
@@ -38,8 +38,11 @@ if {[testConstraint win]} {
load $::reglib Registry
}
testConstraint reg 1
+ } regError]} {
+ catch {package require registry; testConstraint reg 1}
}
}
+
testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}]
# File permissions broken on wsl without some "exotic" wsl configuration
@@ -100,6 +103,45 @@ if {[testConstraint unix]} {
}
}
+# Try getting a lower case glob pattern that will match the home directory of
+# a given user to test ~user and [file tildeexpand ~user]. Note this may not
+# be the same as ~ even when "user" is current user. For example, on Unix
+# platforms ~ will return HOME envvar, but ~user will lookup password file
+# bypassing HOME. If home directory not found, returns *$user* so caller can
+# succeed by using glob matching under the hope that the path contains
+# the user name.
+proc gethomedirglob {user} {
+ if {[testConstraint unix]} {
+ if {![catch {
+ exec {*}[auto_execok sh] -c "echo ~$user"
+ } home]} {
+ set home [string trim $home]
+ if {$home ne ""} {
+ # Expect exact match (except case), no glob * added
+ return [string tolower $home]
+ }
+ }
+ } elseif {[testConstraint reg]} {
+ # Windows with registry extension loaded
+ if {![catch {
+ set sid [exec {*}[auto_execok powershell] -Command "(Get-LocalUser -Name '$user')\[0\].sid.Value"]
+ set sid [string trim $sid]
+ # Get path from the Windows registry
+ set home [registry get "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\$sid" ProfileImagePath]
+ set home [string trim $home]
+ } result]} {
+ if {$home ne ""} {
+ # file join for \ -> /
+ return [file join [string tolower $home]]
+ }
+ }
+ }
+
+ # Caller will need to use glob matching and hope user
+ # name is in the home directory path
+ return *$user*
+}
+
proc createfile {file {string a}} {
set f [open $file w]
puts -nonewline $f $string
@@ -2602,13 +2644,20 @@ test fCmd-31.6 {file home USER} -body {
# env(HOME) even when user is current user. Assume result contains user
# name, else not sure how to check
string tolower [file home $::tcl_platform(user)]
-} -match glob -result [string tolower "*$::tcl_platform(user)*"]
+} -match glob -result [gethomedirglob $::tcl_platform(user)]
test fCmd-31.7 {file home UNKNOWNUSER} -body {
file home nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test fCmd-31.8 {file home extra arg} -body {
file home $::tcl_platform(user) arg
} -returnCodes error -result {wrong # args: should be "file home ?user?"}
+test fCmd-31.9 {file home USER does not follow env(HOME)} -setup {
+ set ::env(HOME) [file join $::env(HOME) foo]
+} -cleanup {
+ set ::env(HOME) [file dirname $::env(HOME)]
+} -body {
+ string tolower [file home $::tcl_platform(user)]
+} -match glob -result [gethomedirglob $::tcl_platform(user)]
test fCmd-32.1 {file tildeexpand ~} -body {
file tildeexpand ~
@@ -2644,7 +2693,7 @@ test fCmd-32.5 {file tildeexpand ~USER} -body {
# env(HOME) even when user is current user. Assume result contains user
# name, else not sure how to check
string tolower [file tildeexpand ~$::tcl_platform(user)]
-} -match glob -result [string tolower "*$::tcl_platform(user)*"]
+} -match glob -result [gethomedirglob $::tcl_platform(user)]
test fCmd-32.6 {file tildeexpand ~UNKNOWNUSER} -body {
file tildeexpand ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
@@ -2659,7 +2708,7 @@ test fCmd-32.9 {file tildeexpand ~USER/bar} -body {
# env(HOME) even when user is current user. Assume result contains user
# name, else not sure how to check
string tolower [file tildeexpand ~$::tcl_platform(user)/bar]
-} -match glob -result [string tolower "*$::tcl_platform(user)*/bar"]
+} -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar]
test fCmd-32.10 {file tildeexpand ~UNKNOWNUSER} -body {
file tildeexpand ~nosuchuser/foo
} -returnCodes error -result {user "nosuchuser" doesn't exist}
@@ -2683,7 +2732,14 @@ test fCmd-32.16 {file tildeexpand ~USER\\bar} -body {
# env(HOME) even when user is current user. Assume result contains user
# name, else not sure how to check
string tolower [file tildeexpand ~$::tcl_platform(user)\\bar]
-} -constraints win -match glob -result [string tolower "*$::tcl_platform(user)*/bar"]
+} -constraints win -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar]
+test fCmd-32.17 {file tildeexpand ~USER does not mirror HOME} -setup {
+ set ::env(HOME) [file join $::env(HOME) foo]
+} -cleanup {
+ set ::env(HOME) [file dirname $::env(HOME)]
+} -body {
+ string tolower [file tildeexpand ~$::tcl_platform(user)]
+} -match glob -result [gethomedirglob $::tcl_platform(user)]
# cleanup
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 2bbf981..0b6fa1d 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -276,6 +276,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
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 7e0a763..a54077d 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1457,22 +1457,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 {
@@ -1543,30 +1564,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;
}