90% fix of file writable issues on Windows

6 files changed, 442 insertions, 72 deletions

diff --git a/ChangeLog b/ChangeLog
index dddef85..47f900d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2006-03-14  Vince Darley  <vincentdarley@sourceforge.net>
+
+	* win/tclWinFile.c: updated patch to deal with 'file writable'
+	issues on Windows XP/2000.
+	* generic/tclTest.c:
+	* unix/tclUnixTest.c:
+	* win/tclWinTest.c:
+	* tests/fCmd,test: updated test suite to deal with correct
+	permissions setting and differences between XP/2000 and 95/98
+	3 tests still fail; to be dealt with shortly
+
 2006-03-13  Don Porter  <dgp@users.sourceforge.net>
 
         * generic/tclEncoding.c:        Report error when an escape encoding
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 74d430a..1249eb9 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.101 2006/02/08 21:41:27 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.102 2006/03/14 19:34:27 vincentdarley Exp $
  */
 
 #define TCL_TEST
@@ -217,8 +217,6 @@ static int		TestcmdtokenCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestcmdtraceCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
-static int		TestchmodCmd(ClientData dummy,
-			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestcreatecommandCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static int		TestdcallCmd(ClientData dummy,
@@ -585,8 +583,6 @@ Tcltest_Init(
             (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
             (ClientData) 0, NULL);
-    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
-            (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
 	    NULL);
     Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
@@ -4406,65 +4402,6 @@ TestpanicCmd(dummy, interp, argc, argv)
 
     return TCL_OK;
 }
-
-/*
- *---------------------------------------------------------------------------
- *
- * TestchmodCmd --
- *
- *	Implements the "testchmod" cmd.  Used when testing "file" command.
- *	The only attribute used by the Windows platform is the user write
- *	flag; if this is not set, the file is made read-only.  Otehrwise, the
- *	file is made read-write.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Changes permissions of specified files.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TestchmodCmd(dummy, interp, argc, argv)
-    ClientData dummy;			/* Not used. */
-    Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    CONST char **argv;			/* Argument strings. */
-{
-    int i, mode;
-    char *rest;
-
-    if (argc < 2) {
-	usage:
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" mode file ?file ...?", NULL);
-	return TCL_ERROR;
-    }
-
-    mode = (int) strtol(argv[1], &rest, 8);
-    if ((rest == argv[1]) || (*rest != '\0')) {
-	goto usage;
-    }
-
-    for (i = 2; i < argc; i++) {
-        Tcl_DString buffer;
-	CONST char *translated;
-
-        translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
-        if (translated == NULL) {
-            return TCL_ERROR;
-        }
-	if (chmod(translated, (unsigned) mode) != 0) {
-	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
-		    NULL);
-	    return TCL_ERROR;
-	}
-        Tcl_DStringFree(&buffer);
-    }
-    return TCL_OK;
-}
 
 static int
 TestfileCmd(dummy, interp, argc, argv)
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 64bfbd7..4e3b66a 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.48 2005/10/23 18:51:31 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.49 2006/03/14 19:34:28 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -22,6 +22,8 @@ testConstraint testsetplatform [llength [info commands testsetplatform]]
 testConstraint testchmod [llength [info commands testchmod]]
 # Don't know how to determine this constraint correctly
 testConstraint notNetworkFilesystem 0
+testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
+testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
 
 # Several tests require need to match results against the unix username
 set user {}
@@ -897,7 +899,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod}
     file copy tf2 tf4
     list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
 } {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
-test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} {
+test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 95or98 testchmod} {
     cleanup
     file mkdir [file join td1 tdx]
     file mkdir [file join td2 tdy]
@@ -910,6 +912,20 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc tes
     testchmod 755 td4
     set msg
 } [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
+test fCmd-10.3.1 {file copy: comprehensive: dir to new name} {notRoot unixOrPc 2000orNewer testchmod} {
+    # On Windows with ACLs, copying a directory is defined like this
+    cleanup
+    file mkdir [file join td1 tdx]
+    file mkdir [file join td2 tdy]
+    testchmod 555 td2
+    file copy td1 td3
+    file copy td2 td4
+    set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
+	    [glob -directory td4 t*] [file writable td3] [file writable td4]]
+    testchmod 755 td2
+    testchmod 755 td4
+    set msg
+} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1}]
 test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
     cleanup
     createfile tf1
@@ -980,7 +996,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot t
     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
 } [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
 test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
-	{notRoot unixOrPc testchmod} {
+	{notRoot unixOrPc 95or98 testchmod} {
     cleanup
     file mkdir td1
     file mkdir td2
@@ -991,6 +1007,19 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
     [file writable [file join td3 td3]] [file writable [file join td3 td4]]
 } [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
+test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} \
+	{notRoot unixOrPc 2000orNewer testchmod} {
+    # On Windows with ACLs, copying a directory is defined like this
+    cleanup
+    file mkdir td1
+    file mkdir td2
+    file mkdir td3
+    testchmod 555 td2
+    file copy td1 [file join td3 td3]
+    file copy td2 [file join td3 td4]
+    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
+    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
+} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
 test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
 	{notRoot} {
     cleanup
@@ -2342,6 +2371,17 @@ removeFile abc.file
 removeDirectory abc2.dir
 removeDirectory abc.dir
 
+test fCmd-30.1 {file writable on 'My Documents'} {pc 2000orNewer} {
+    # Would be good to localise this name, since this test will only
+    # function on english-speaking windows otherwise
+    if {[file exists "~/My Documents"]} {
+	set res [file writable "~/My Documents"]
+    } else {
+	set res 1
+    }
+    set res
+} {1}
+
 # cleanup
 cleanup
 ::tcltest::cleanupTests
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index d376c65..1110b07 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixTest.c,v 1.21 2005/11/02 23:26:50 dkf Exp $
+ * RCS: @(#) $Id: tclUnixTest.c,v 1.22 2006/03/14 19:34:30 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -80,6 +80,8 @@ static int		TestalarmCmd(ClientData dummy,
 static int		TestgotsigCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, CONST char **argv);
 static void		AlarmHandler(int signum);
+static int		TestchmodCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, CONST char **argv);
 
 /*
  *----------------------------------------------------------------------
@@ -102,6 +104,8 @@ int
 TclplatformtestInit(
     Tcl_Interp *interp)		/* Interpreter to add commands to. */
 {
+    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
             (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
@@ -673,3 +677,62 @@ TestgotsigCmd(
     gotsig = "0";
     return TCL_OK;
 }
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TestchmodCmd --
+ *
+ *	Implements the "testchmod" cmd.  Used when testing "file" command.
+ *	The only attribute used by the Windows platform is the user write
+ *	flag; if this is not set, the file is made read-only.  Otehrwise, the
+ *	file is made read-write.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Changes permissions of specified files.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TestchmodCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
+{
+    int i, mode;
+    char *rest;
+
+    if (argc < 2) {
+	usage:
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" mode file ?file ...?", NULL);
+	return TCL_ERROR;
+    }
+
+    mode = (int) strtol(argv[1], &rest, 8);
+    if ((rest == argv[1]) || (*rest != '\0')) {
+	goto usage;
+    }
+
+    for (i = 2; i < argc; i++) {
+	Tcl_DString buffer;
+	CONST char *translated;
+
+	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
+	if (translated == NULL) {
+	    return TCL_ERROR;
+	}
+	if (chmod(translated, (unsigned) mode) != 0) {
+	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
+		    NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringFree(&buffer);
+    }
+    return TCL_OK;
+}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 4a13d39..196c7ac 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.84 2006/03/10 10:33:55 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.85 2006/03/14 19:34:30 vincentdarley Exp $
  */
 
 /* #define _WIN32_WINNT	0x0500 */
@@ -1547,8 +1547,7 @@ NativeAccess(
     }
 
     if ((mode & W_OK) 
-      && !(attr & FILE_ATTRIBUTE_DIRECTORY)
-	/* && (tclWinProcs->getFileSecurityProc == NULL) */
+      && (tclWinProcs->getFileSecurityProc == NULL)
       && (attr & FILE_ATTRIBUTE_READONLY)) {
 	/*
 	 * We don't have the advanced 'getFileSecurityProc', and
@@ -1725,6 +1724,7 @@ NativeAccess(
 	 * we must still check the 'attr' value.
 	 */
 	if ((mode & W_OK)
+	  && !(attr & FILE_ATTRIBUTE_DIRECTORY)
 	  && (attr & FILE_ATTRIBUTE_READONLY)) {
 	    Tcl_SetErrno(EACCES);
 	    return -1;
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 71d76e6..3d713c9 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -8,13 +8,20 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinTest.c,v 1.12 2005/11/04 00:06:51 dkf Exp $
+ * RCS: @(#) $Id: tclWinTest.c,v 1.13 2006/03/14 19:34:33 vincentdarley Exp $
  */
 
 #define USE_COMPAT_CONST
 #include "tclInt.h"
 
 /*
+ * For Testplaftorm_chmod on Windows
+ */
+#ifdef __WIN32__
+#include <aclapi.h>
+#endif
+
+/*
  * Forward declarations of functions defined later in this file:
  */
 
@@ -31,6 +38,9 @@ static int		TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
 static Tcl_ObjCmdProc	TestExceptionCmd;
 static int		TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp,
 			    int objc, Tcl_Obj *CONST objv[]);
+static int		TestplatformChmod(CONST char *nativePath, int pmode);
+static int		TestchmodCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, CONST char **argv);
 
 /*
  *----------------------------------------------------------------------
@@ -57,6 +67,8 @@ TclplatformtestInit(
      * Add commands for platform specific tests for Windows here.
      */
 
+    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
+	    (ClientData) 0, NULL);
     Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
             (ClientData) 0, NULL);
     Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
@@ -485,3 +497,310 @@ TestExceptionCmd(
     /* NOTREACHED */
     return TCL_OK;
 }
+
+static int 
+TestplatformChmod(CONST char *nativePath, int pmode)
+{
+    static const char everyoneBuf[] = "EVERYONE";
+    static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION 
+      | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
+    static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE 
+      | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA |  FILE_APPEND_DATA 
+      | FILE_WRITE_DATA | DELETE;
+
+    BYTE *secDesc = 0;
+    DWORD secDescLen;
+
+    const BOOL set_readOnly = !(pmode & 0222);
+    BOOL acl_readOnly_found = FALSE;
+
+    ACL_SIZE_INFORMATION ACLSize;
+    BOOL curAclPresent, curAclDefaulted;
+    PACL curAcl; 
+    PACL newAcl = 0;
+    DWORD newAclSize;
+
+    WORD j;
+  
+    DWORD userSidLen = 4096;
+    SID *userSid = 0;
+    DWORD userDomainLen = 32;
+    TCHAR *userDomain = 0;
+    SID_NAME_USE userSidUse;
+
+    DWORD attr;
+
+    int res = 0;
+
+    /*
+     * One time initialization, dynamically load Windows NT features
+     */
+    typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR,
+      IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
+      IN PACL, IN PACL );
+    typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *);
+    typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD );
+    typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID );
+    typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID );
+    typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD );
+    typedef DWORD (WINAPI *getLengthSidDef) ( PSID );
+    typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, 
+      ACL_INFORMATION_CLASS );
+    typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR,
+      LPBOOL, PACL *, LPBOOL );
+    typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, 
+      PDWORD, LPSTR, LPDWORD, PSID_NAME_USE );
+    typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION,
+      PSECURITY_DESCRIPTOR, DWORD, LPDWORD );
+
+    static setNamedSecurityInfoADef setNamedSecurityInfoProc;
+    static getAceDef getAceProc;
+    static addAceDef addAceProc;
+    static equalSidDef equalSidProc;
+    static addAccessDeniedAceDef addAccessDeniedAceProc;
+    static initializeAclDef initializeAclProc;
+    static getLengthSidDef getLengthSidProc;
+    static getAclInformationDef getAclInformationProc;
+    static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
+    static lookupAccountNameADef lookupAccountNameProc; 
+    static getFileSecurityADef getFileSecurityProc;
+
+    static int initialized = 0;
+    if (!initialized) {
+	TCL_DECLARE_MUTEX(initialzeMutex)
+	Tcl_MutexLock(&initializeMutex);
+	if (!initialized) {
+	    HINSTANCE hInstance = LoadLibrary("Advapi32");
+	    if (hInstance != NULL) {
+		setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
+		  GetProcAddress(hInstance, "SetNamedSecurityInfoA");
+		getFileSecurityProc = (getFileSecurityADef)
+		  GetProcAddress(hInstance, "GetFileSecurityA");
+		getAceProc = (getAceDef)
+		  GetProcAddress(hInstance, "GetAce");
+		addAceProc = (addAceDef)
+		  GetProcAddress(hInstance, "AddAce");
+		equalSidProc = (equalSidDef)
+		  GetProcAddress(hInstance, "EqualSid");
+		addAccessDeniedAceProc = (addAccessDeniedAceDef)
+		  GetProcAddress(hInstance, "AddAccessDeniedAce");
+		initializeAclProc = (initializeAclDef)
+		  GetProcAddress(hInstance, "InitializeAcl");
+		getLengthSidProc = (getLengthSidDef)
+		  GetProcAddress(hInstance, "GetLengthSid");
+		getAclInformationProc = (getAclInformationDef)
+		  GetProcAddress(hInstance, "GetAclInformation");
+		getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
+		  GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
+		lookupAccountNameProc = (lookupAccountNameADef)
+		  GetProcAddress(hInstance, "LookupAccountNameA");
+		if (setNamedSecurityInfoProc && getAceProc
+		  && addAceProc && equalSidProc && addAccessDeniedAceProc
+		  && initializeAclProc && getLengthSidProc
+		  && getAclInformationProc && getSecurityDescriptorDaclProc
+		  && lookupAccountNameProc && getFileSecurityProc)
+		    initialized = 1;
+	    }
+	    if (!initialized)
+		initialized = -1;
+	}
+	Tcl_MutexUnlock(&intializeMutex);
+    }
+
+    /* Process the chmod request */
+    attr = GetFileAttributes(nativePath);
+
+    /* nativePath not found */
+    if (attr == 0xffffffff) {
+	res = -1;
+	goto done;
+    }
+
+    /* If no ACL API is present or nativePath is not a directory, 
+     * there is no special handling 
+     */
+    if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+	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 (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
+	if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
+	    DWORD secDescLen2 = 0;
+	    secDesc = (BYTE *) ckalloc(secDescLen);
+	    if (!getFileSecurityProc(nativePath, infoBits, secDesc, 
+				     secDescLen, &secDescLen2) 
+		|| (secDescLen < secDescLen2)) {
+		goto done;
+	    }
+	} else {
+	    goto done;
+	}
+    }
+
+    /* Get the "Everyone" SID */
+    userSid = (SID *) ckalloc(userSidLen);
+    userDomain = (TCHAR *) ckalloc(userDomainLen);
+    if (!lookupAccountNameProc(NULL, everyoneBuf, userSid, &userSidLen, 
+			       userDomain, &userDomainLen, &userSidUse)) {
+	if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
+	    ckfree((char *)userSid);
+	    userSid = (SID *) ckalloc(userSidLen);
+	    ckfree(userDomain);
+	    userDomain = (TCHAR *) ckalloc(userDomainLen);
+	    if (!lookupAccountNameProc(NULL, everyoneBuf, userSid, 
+	      &userSidLen, userDomain, &userDomainLen, &userSidUse))
+		goto done;
+	} else
+	    goto done;
+    }
+
+    /* If curAclPresent == false then curAcl and curAclDefaulted not valid */
+    if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, 
+      &curAcl, &curAclDefaulted))
+	goto done;
+
+    if (!curAclPresent || !curAcl) {
+	ACLSize.AclBytesInUse = 0;
+	ACLSize.AceCount = 0;
+    } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), 
+      AclSizeInformation))
+	goto done;
+
+    /* Allocate memory for the new ACL */
+    newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) 
+      + getLengthSidProc(userSid) - sizeof (DWORD);
+    newAcl = (ACL *) ckalloc (newAclSize);
+  
+    /* Initialize the new ACL */
+    if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
+	goto done;
+    }
+    
+    /* Add denied to make readonly, this will be known as a "read-only tag" */
+    if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, 
+      readOnlyMask, userSid)) {
+	goto done;
+    }
+      
+    acl_readOnly_found = FALSE;
+    for (j = 0; j < ACLSize.AceCount; j++) {
+	PACL *pACE2;
+	ACE_HEADER *phACE2;
+	if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) {
+	    goto done;
+	}
+	
+	phACE2 = ((ACE_HEADER *) pACE2);
+
+	/* Do NOT propagate inherited ACEs */
+	if (phACE2->AceFlags & INHERITED_ACE) {
+	    continue;
+	}
+	
+	/* Skip the "read-only tag" restriction (either added above, or it
+	 * is being removed) 
+	 */
+	if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
+	    ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2;
+	    if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, 
+	      (PSID)&(pACEd->SidStart))) {
+		acl_readOnly_found = TRUE;
+		continue;
+	    }
+	}
+
+	/* Copy the current ACE from the old to the new ACL */
+	if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, 
+	  ((PACE_HEADER) pACE2)->AceSize)) {
+	    goto done;
+	}
+    }
+
+    /* Apply the new ACL */
+    if (set_readOnly == acl_readOnly_found
+	|| setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, 
+	     DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL)
+	   == ERROR_SUCCESS ) {
+	res = 0;
+    }
+
+ done:
+    if (secDesc) ckfree(secDesc);
+    if (newAcl) ckfree((char *)newAcl);
+    if (userSid) ckfree((char *)userSid);
+    if (userDomain) ckfree(userDomain);
+
+    if (res != 0)
+	return res;
+    
+    /* Run normal chmod command */
+    return chmod(nativePath, pmode);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TestchmodCmd --
+ *
+ *	Implements the "testchmod" cmd.  Used when testing "file" command.
+ *	The only attribute used by the Windows platform is the user write
+ *	flag; if this is not set, the file is made read-only.  Otehrwise, the
+ *	file is made read-write.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Changes permissions of specified files.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+TestchmodCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
+{
+    int i, mode;
+    char *rest;
+
+    if (argc < 2) {
+	usage:
+	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+		" mode file ?file ...?", NULL);
+	return TCL_ERROR;
+    }
+
+    mode = (int) strtol(argv[1], &rest, 8);
+    if ((rest == argv[1]) || (*rest != '\0')) {
+	goto usage;
+    }
+
+    for (i = 2; i < argc; i++) {
+	Tcl_DString buffer;
+	CONST char *translated;
+
+	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
+	if (translated == NULL) {
+	    return TCL_ERROR;
+	}
+	if (TestplatformChmod(translated, (unsigned) mode) != 0) {
+	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
+		    NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_DStringFree(&buffer);
+    }
+    return TCL_OK;
+}