diff options
| -rw-r--r-- | tests/fCmd.test | 66 | ||||
| -rw-r--r-- | tests/fileSystem.test | 10 | ||||
| -rw-r--r-- | win/tclWinFile.c | 73 |
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; } |