Merge 9.0

5 files changed, 203 insertions, 194 deletions

diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 2836e4f..01fa6c3 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -379,7 +379,7 @@ TclWinDriveLetterForVolMountPoint(
 	    if (!alreadyStored) {
 		dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
 		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
-		dlPtr2->driveLetter = (char) drive[0];
+		dlPtr2->driveLetter = (WCHAR) drive[0];
 		dlPtr2->nextPtr = driveLetterLookup;
 		driveLetterLookup = dlPtr2;
 	    }
@@ -405,7 +405,7 @@ TclWinDriveLetterForVolMountPoint(
 
     dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
     dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
-    dlPtr2->driveLetter = -1;
+    dlPtr2->driveLetter = (WCHAR)-1;
     dlPtr2->nextPtr = driveLetterLookup;
     driveLetterLookup = dlPtr2;
     Tcl_MutexUnlock(&mountPointMap);
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 4968802..ca79e42 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -613,7 +613,7 @@ FileInputProc(
 
     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
 	    (LPOVERLAPPED) NULL) != FALSE) {
-	return bytesRead;
+	return (int)bytesRead;
     }
 
     Tcl_WinConvertError(GetLastError());
@@ -670,7 +670,7 @@ FileOutputProc(
 	return -1;
     }
     infoPtr->dirty = 1;
-    return bytesWritten;
+    return (int)bytesWritten;
 }
 
 /*
@@ -1483,7 +1483,7 @@ NativeIsComPort(
     const WCHAR *nativePath)	/* Path of file to access, native encoding. */
 {
     const WCHAR *p = (const WCHAR *) nativePath;
-    int i, len = wcslen(p);
+    size_t i, len = wcslen(p);
 
     /*
      * 1. Look for com[1-9]:?
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 30ca622..4c63222 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -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;
 }
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
index 7c21167..7928dcd 100644
--- a/win/tclWinPanic.c
+++ b/win/tclWinPanic.c
@@ -56,10 +56,10 @@ Tcl_ConsolePanic(
     if (IsDebuggerPresent()) {
 	OutputDebugStringW(msgString);
     } else if (_isatty(2)) {
-	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
+	WriteConsoleW(handle, msgString, (DWORD)wcslen(msgString), &dummy, 0);
     } else {
 	buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */
-	WriteFile(handle, buf, strlen(buf), &dummy, 0);
+	WriteFile(handle, buf, (DWORD)strlen(buf), &dummy, 0);
 	WriteFile(handle, "\n", 1, &dummy, 0);
 	FlushFileBuffers(handle);
     }
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index c012b53..c7abcdc 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -22,9 +22,8 @@
 /*
  * For TestplatformChmod on Windows
  */
-#ifdef _WIN32
 #include <aclapi.h>
-#endif
+#include <sddl.h>
 
 /*
  * MinGW 3.4.2 does not define this.
@@ -390,176 +389,189 @@ TestExceptionCmd(
     return TCL_OK;
 }
 
+/*
+ * This "chmod" works sufficiently for test script purposes. Do not expect
+ * it to be exact emulation of Unix chmod (not sure if that's even possible)
+ */
 static int
 TestplatformChmod(
     const char *nativePath,
     int pmode)
 {
-    static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
-	    | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
-    /* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */
-    static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
-	    | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
-	    | FILE_WRITE_DATA
-	    | DELETE;
-
-    /*
-     * References to security functions (only available on NT and later).
+    /* 
+     * Note FILE_DELETE_CHILD missing from dirWriteMask because we do
+     * not want overriding of child's delete setting when testing
      */
-
-    const BOOL set_readOnly = !(pmode & 0222);
-    BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
-    SID_IDENTIFIER_AUTHORITY userSidAuthority = {
-	SECURITY_WORLD_SID_AUTHORITY
-    };
-    BYTE *secDesc = 0;
-    DWORD secDescLen, attr, newAclSize;
-    ACL_SIZE_INFORMATION ACLSize;
-    PACL curAcl, newAcl = 0;
-    WORD j;
-    SID *userSid = 0;
-    char *userDomain = 0;
+    static const DWORD dirWriteMask =
+	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA |
+	FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | STANDARD_RIGHTS_WRITE | DELETE |
+	SYNCHRONIZE;
+    static const DWORD dirReadMask = 
+	FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_LIST_DIRECTORY |
+	STANDARD_RIGHTS_READ | SYNCHRONIZE;
+    /* Note - default user privileges allow ignoring TRAVERSE setting */
+    static const DWORD dirExecuteMask =
+	FILE_TRAVERSE | STANDARD_RIGHTS_READ | SYNCHRONIZE;
+
+    static const DWORD fileWriteMask =
+	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_WRITE_DATA |
+	FILE_APPEND_DATA | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE;
+    static const DWORD fileReadMask = 
+	FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_READ_DATA |
+	STANDARD_RIGHTS_READ | SYNCHRONIZE;
+    static const DWORD fileExecuteMask =
+	FILE_EXECUTE | STANDARD_RIGHTS_READ | SYNCHRONIZE;
+
+    DWORD attr, newAclSize;
+    PACL newAcl = NULL;
     int res = 0;
 
-    /*
-     * Process the chmod request.
-     */
+    HANDLE hToken = NULL;
+    int i;
+    int nSids = 0;
+    struct {
+	PSID pSid;
+	DWORD mask;
+	DWORD sidLen;
+    } aceEntry[3];
+    DWORD dw;
+    int isDir;
+    TOKEN_USER *pTokenUser = NULL;
 
-    attr = GetFileAttributesA(nativePath);
-
-    /*
-     * nativePath not found
-     */
+    res = -1; /* Assume failure */
 
+    attr = GetFileAttributesA(nativePath);
     if (attr == 0xFFFFFFFF) {
-	res = -1;
-	goto done;
+	goto done; /* Not found */
     }
 
-    /*
-     * If nativePath is not a directory, there is no special handling.
-     */
+    isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0;
 
-    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+    if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) {
 	goto done;
     }
-
-    /*
-     * Set the result to error, if the ACL change is successful it will be
-     * reset to 0.
-     */
-
-    res = -1;
-
-    /*
-     * Read the security descriptor for the directory. Note the first call
-     * obtains the size of the security descriptor.
-     */
-
-    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
-	DWORD secDescLen2 = 0;
-
-	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
-	    goto done;
-	}
-
-	secDesc = (BYTE *)Tcl_Alloc(secDescLen);
-	if (!GetFileSecurityA(nativePath, infoBits,
-		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
-		|| (secDescLen < secDescLen2)) {
-	    goto done;
-	}
-    }
-
-    /*
-     * Get the World SID.
-     */
-
-    userSid = (SID *)Tcl_Alloc(GetSidLengthRequired((UCHAR) 1));
-    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
-    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
-
-    /*
-     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
-     */
-
-    if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
-	    &curAclPresent, &curAcl, &curAclDefaulted)) {
+    
+    /* Get process SID */
+    if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) &&
+	GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
 	goto done;
     }
-    if (!curAclPresent || !curAcl) {
-	ACLSize.AclBytesInUse = 0;
-	ACLSize.AceCount = 0;
-    } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
-	    AclSizeInformation)) {
+    pTokenUser = (TOKEN_USER *)Tcl_Alloc(dw);
+    if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) {
 	goto done;
     }
-
-    /*
-     * Allocate memory for the new ACL.
-     */
-
-    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
-	    + GetLengthSid(userSid) - sizeof(DWORD);
-    newAcl = (PACL) Tcl_Alloc(newAclSize);
-
-    /*
-     * Initialize the new ACL.
-     */
-
-    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
+    aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid);
+    aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
+    if (!CopySid(aceEntry[nSids].sidLen,
+		 aceEntry[nSids].pSid,
+		 pTokenUser->User.Sid)) {
+	Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
 	goto done;
     }
-
-    /*
-     * Add denied to make readonly, this will be known as a "read-only tag".
+    /* 
+     * Always include DACL modify rights so we don't get locked out
      */
-
-    if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
-	    readOnlyMask, userSid)) {
-	goto done;
+    aceEntry[nSids].mask = READ_CONTROL | WRITE_DAC | WRITE_OWNER | SYNCHRONIZE |
+			   FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
+    if (pmode & 0700) {
+	/* Owner permissions. Assumes current process is owner */
+	if (pmode & 0400) {
+	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
+	}
+	if (pmode & 0200) {
+	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
+	}
+	if (pmode & 0100) {
+	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
+	}
     }
+    ++nSids;
+
+    if (pmode & 0070) {
+	/* Group permissions. */
 
-    acl_readOnly_found = FALSE;
-    for (j = 0; j < ACLSize.AceCount; j++) {
-	LPVOID pACE2;
-	ACE_HEADER *phACE2;
+	TOKEN_PRIMARY_GROUP *pTokenGroup;
 
-	if (!GetAce(curAcl, j, &pACE2)) {
+	/* Get primary group SID */
+	if (!GetTokenInformation(
+		hToken, TokenPrimaryGroup, NULL, 0, &dw) &&
+		GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
 	    goto done;
 	}
+	pTokenGroup = (TOKEN_PRIMARY_GROUP *)Tcl_Alloc(dw);
+	if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) {
+	    Tcl_Free(pTokenGroup);
+	    goto done;
+	}
+	aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup);
+	aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
+	if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) {
+	    Tcl_Free(pTokenGroup);
+	    Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+	    goto done;
+	}
+	Tcl_Free(pTokenGroup);
 
-	phACE2 = (ACE_HEADER *) pACE2;
-
-	/*
-	 * Do NOT propagate inherited ACEs.
-	 */
+	/* Generate mask for group ACL */
 
-	if (phACE2->AceFlags & INHERITED_ACE) {
-	    continue;
+	aceEntry[nSids].mask = 0;
+	if (pmode & 0040) {
+	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
 	}
+	if (pmode & 0020) {
+	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
+	}
+	if (pmode & 0010) {
+	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
+	}
+	++nSids;
+    }
 
-	/*
-	 * Skip the "read-only tag" restriction (either added above, or it is
-	 * being removed).
-	 */
+    if (pmode & 0007) {
+	/* World permissions */
+	PSID pWorldSid;
+	if (!ConvertStringSidToSidA("S-1-1-0", &pWorldSid)) {
+	    goto done;
+	}
+	aceEntry[nSids].sidLen = GetLengthSid(pWorldSid);
+	aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen);
+	if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) {
+	    LocalFree(pWorldSid);
+	    Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+	    goto done;
+	}
+	LocalFree(pWorldSid);
 
-	if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
-	    ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
+	/* Generate mask for world ACL */
 
-	    if (pACEd->Mask == readOnlyMask
-		    && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
-		acl_readOnly_found = TRUE;
-		continue;
-	    }
+	aceEntry[nSids].mask = 0;
+	if (pmode & 0004) {
+	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
+	}
+	if (pmode & 0002) {
+	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
 	}
+	if (pmode & 0001) {
+	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
+	}
+	++nSids;
+    }
 
-	/*
-	 * Copy the current ACE from the old to the new ACL.
-	 */
+    /* Allocate memory and initialize the new ACL. */
+
+    newAclSize = sizeof(ACL);
+    /* Add in size required for each ACE entry in the ACL */
+    for (i = 0; i < nSids; ++i) {
+	newAclSize +=
+	    offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen;
+    }
+    newAcl = (PACL)Tcl_Alloc(newAclSize);
+    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
+	goto done;
+    }
 
-	if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
-		((PACE_HEADER) pACE2)->AceSize)) {
+    for (i = 0; i < nSids; ++i) {
+	if (!AddAccessAllowedAce(newAcl, ACL_REVISION, aceEntry[i].mask, aceEntry[i].pSid)) {
 	    goto done;
 	}
     }
@@ -569,36 +581,39 @@ TestplatformChmod(
      * to remove inherited ACL (we need to overwrite the default ACL's in this case)
      */
 
-    if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
-	    (LPSTR) nativePath, SE_FILE_OBJECT,
-	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
-	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
+    if (SetNamedSecurityInfoA((LPSTR)nativePath,
+			      SE_FILE_OBJECT,
+			      DACL_SECURITY_INFORMATION |
+				  PROTECTED_DACL_SECURITY_INFORMATION,
+			      NULL,
+			      NULL,
+			      newAcl,
+			      NULL) == ERROR_SUCCESS) {
 	res = 0;
     }
 
   done:
-    if (secDesc) {
-	Tcl_Free(secDesc);
+    if (pTokenUser) {
+	Tcl_Free(pTokenUser);
+    }
+    if (hToken) {
+	CloseHandle(hToken);
     }
     if (newAcl) {
 	Tcl_Free(newAcl);
     }
-    if (userSid) {
-	Tcl_Free(userSid);
-    }
-    if (userDomain) {
-	Tcl_Free(userDomain);
+    for (i = 0; i < nSids; ++i) {
+	Tcl_Free(aceEntry[i].pSid);
     }
 
     if (res != 0) {
 	return res;
     }
 
-    /*
-     * Run normal chmod command.
-     */
-
+    /* Run normal chmod command */
     return chmod(nativePath, pmode);
+
+
 }
 
 /*