summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2006-03-14 19:34:25 (GMT)
committervincentdarley <vincentdarley>2006-03-14 19:34:25 (GMT)
commit54b14791b5842fe7e3c0ad6a77e2e6bd10237627 (patch)
tree174d43369770a1c8db6a61a7f76f4fe572109cfd
parent02d304b56fb79258a992e9f47e325445f2e75d40 (diff)
downloadtcl-54b14791b5842fe7e3c0ad6a77e2e6bd10237627.zip
tcl-54b14791b5842fe7e3c0ad6a77e2e6bd10237627.tar.gz
tcl-54b14791b5842fe7e3c0ad6a77e2e6bd10237627.tar.bz2
90% fix of file writable issues on Windows
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclTest.c65
-rw-r--r--tests/fCmd.test46
-rw-r--r--unix/tclUnixTest.c65
-rw-r--r--win/tclWinFile.c6
-rw-r--r--win/tclWinTest.c321
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;
+}