diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclTest.c | 65 | ||||
| -rw-r--r-- | tests/fCmd.test | 46 | ||||
| -rw-r--r-- | unix/tclUnixTest.c | 65 | ||||
| -rw-r--r-- | win/tclWinFile.c | 6 | ||||
| -rw-r--r-- | win/tclWinTest.c | 321 |
6 files changed, 442 insertions, 72 deletions
@@ -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; +} |