diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinTest.c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinTest.c Fri Jun 15 03:10:57 2012 +0200
@@ -0,0 +1,832 @@
+/*
+ * tclWinTest.c --
+ *
+ * Contains commands for platform specific tests on Windows.
+ *
+ * Copyright (c) 1996 Sun Microsystems, Inc.
+ *
+ * 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.8.2.6 2006/03/27 23:30:54 patthoyts Exp $
+ */
+
+#define USE_COMPAT_CONST
+#include "tclWinInt.h"
+
+/*
+ * For TestplatformChmod on Windows
+ */
+#ifdef __WIN32__
+#include <aclapi.h>
+#endif
+
+/*
+ * MinGW 3.4.2 does not define this.
+ */
+#ifndef INHERITED_ACE
+#define INHERITED_ACE (0x10)
+#endif
+
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST84 char **argv));
+static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
+ Tcl_Interp* interp,
+ int objc,
+ Tcl_Obj *CONST objv[] ));
+static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
+ Tcl_Interp* interp,
+ int objc,
+ Tcl_Obj *CONST objv[] ));
+static Tcl_ObjCmdProc TestExceptionCmd;
+static int TestwincpuidCmd _ANSI_ARGS_(( ClientData dummy,
+ Tcl_Interp* interp,
+ int objc,
+ Tcl_Obj *CONST objv[] ));
+static int TestplatformChmod _ANSI_ARGS_((CONST char *nativePath,
+ int pmode));
+static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, CONST84 char **argv));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclplatformtestInit --
+ *
+ * Defines commands that test platform specific functionality for
+ * Windows platforms.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclplatformtestInit(interp)
+ Tcl_Interp *interp; /* Interpreter to add commands to. */
+{
+ /*
+ * Add commands for platform specific tests for Windows here.
+ */
+
+ Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
+ Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL );
+ Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TesteventloopCmd --
+ *
+ * This procedure implements the "testeventloop" command. It is
+ * used to test the Tcl notifier from an "external" event loop
+ * (i.e. not Tcl_DoOneEvent()).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TesteventloopCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ CONST84 char **argv; /* Argument strings. */
+{
+ static int *framePtr = NULL; /* Pointer to integer on stack frame of
+ * innermost invocation of the "wait"
+ * subcommand. */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " option ... \"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[1], "done") == 0) {
+ *framePtr = 1;
+ } else if (strcmp(argv[1], "wait") == 0) {
+ int *oldFramePtr;
+ int done;
+ MSG msg;
+ int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+
+ /*
+ * Save the old stack frame pointer and set up the current frame.
+ */
+
+ oldFramePtr = framePtr;
+ framePtr = &done;
+
+ /*
+ * Enter a standard Windows event loop until the flag changes.
+ * Note that we do not explicitly call Tcl_ServiceEvent().
+ */
+
+ done = 0;
+ while (!done) {
+ if (!GetMessage(&msg, NULL, 0, 0)) {
+ /*
+ * The application is exiting, so repost the quit message
+ * and start unwinding.
+ */
+
+ PostQuitMessage((int)msg.wParam);
+ break;
+ }
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
+ }
+ (void) Tcl_SetServiceMode(oldMode);
+ framePtr = oldFramePtr;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be done or wait", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Testvolumetype --
+ *
+ * This procedure implements the "testvolumetype" command. It is
+ * used to check the volume type (FAT, NTFS) of a volume.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestvolumetypeCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+#define VOL_BUF_SIZE 32
+ int found;
+ char volType[VOL_BUF_SIZE];
+ char *path;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?name?");
+ return TCL_ERROR;
+ }
+ if (objc == 2) {
+ /*
+ * path has to be really a proper volume, but we don't
+ * get query APIs for that until NT5
+ */
+ path = Tcl_GetString(objv[1]);
+ } else {
+ path = NULL;
+ }
+ found = GetVolumeInformationA(path, NULL, 0, NULL, NULL,
+ NULL, volType, VOL_BUF_SIZE);
+
+ if (found == 0) {
+ Tcl_AppendResult(interp, "could not get volume type for \"",
+ (path?path:""), "\"", (char *) NULL);
+ TclWinConvertError(GetLastError());
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, volType, TCL_VOLATILE);
+ return TCL_OK;
+#undef VOL_BUF_SIZE
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwinclockCmd --
+ *
+ * Command that returns the seconds and microseconds portions of
+ * the system clock and of the Tcl clock so that they can be
+ * compared to validate that the Tcl clock is staying in sync.
+ *
+ * Usage:
+ * testclock
+ *
+ * Parameters:
+ * None.
+ *
+ * Results:
+ * Returns a standard Tcl result comprising a four-element list:
+ * the seconds and microseconds portions of the system clock,
+ * and the seconds and microseconds portions of the Tcl clock.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwinclockCmd( ClientData dummy,
+ /* Unused */
+ Tcl_Interp* interp,
+ /* Tcl interpreter */
+ int objc,
+ /* Argument count */
+ Tcl_Obj *CONST objv[] )
+ /* Argument vector */
+{
+ CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
+ /* The Posix epoch, expressed as a
+ * Windows FILETIME */
+ Tcl_Time tclTime; /* Tcl clock */
+ FILETIME sysTime; /* System clock */
+ Tcl_Obj* result; /* Result of the command */
+ LARGE_INTEGER t1, t2;
+ LARGE_INTEGER p1, p2;
+
+ if ( objc != 1 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "" );
+ return TCL_ERROR;
+ }
+
+ QueryPerformanceCounter( &p1 );
+
+ Tcl_GetTime( &tclTime );
+ GetSystemTimeAsFileTime( &sysTime );
+ t1.LowPart = posixEpoch.dwLowDateTime;
+ t1.HighPart = posixEpoch.dwHighDateTime;
+ t2.LowPart = sysTime.dwLowDateTime;
+ t2.HighPart = sysTime.dwHighDateTime;
+ t2.QuadPart -= t1.QuadPart;
+
+ QueryPerformanceCounter( &p2 );
+
+ result = Tcl_NewObj();
+ Tcl_ListObjAppendElement
+ ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
+ Tcl_ListObjAppendElement
+ ( interp, result,
+ Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
+
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) );
+
+ Tcl_SetObjResult( interp, result );
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwincpuidCmd --
+ *
+ * Retrieves CPU ID information.
+ *
+ * Usage:
+ * testwincpuid <eax>
+ *
+ * Parameters:
+ * eax - The value to pass in the EAX register to a CPUID instruction.
+ *
+ * Results:
+ * Returns a four-element list containing the values from the
+ * EAX, EBX, ECX and EDX registers returned from the CPUID instruction.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwincpuidCmd( ClientData dummy,
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *CONST * objv ) /* Parameter vector */
+{
+ int status;
+ int index;
+ unsigned int regs[4];
+ Tcl_Obj * regsObjs[4];
+ int i;
+
+ if ( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "eax" );
+ return TCL_ERROR;
+ }
+ if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ status = TclWinCPUID( (unsigned int) index, regs );
+ if ( status != TCL_OK ) {
+ Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available",
+ -1 ) );
+ return status;
+ }
+ for ( i = 0; i < 4; ++i ) {
+ regsObjs[i] = Tcl_NewIntObj( (int) regs[i] );
+ }
+ Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) );
+ return TCL_OK;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwinsleepCmd --
+ *
+ * Causes this process to wait for the given number of milliseconds
+ * by means of a direct call to Sleep.
+ *
+ * Usage:
+ * testwinsleep <n>
+ *
+ * Parameters:
+ * n - the number of milliseconds to sleep
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sleeps for the requisite number of milliseconds.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwinsleepCmd( ClientData clientData,
+ /* Unused */
+ Tcl_Interp* interp,
+ /* Tcl interpreter */
+ int objc,
+ /* Parameter count */
+ Tcl_Obj * CONST * objv )
+ /* Parameter vector */
+{
+ int ms;
+ if ( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "ms" );
+ return TCL_ERROR;
+ }
+ if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ Sleep( (DWORD) ms );
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestExceptionCmd --
+ *
+ * Causes this process to end with the named exception. Used for
+ * testing Tcl_WaitPid().
+ *
+ * Usage:
+ * testexcept <type>
+ *
+ * Parameters:
+ * Type of exception.
+ *
+ * Results:
+ * None, this process closes now and doesn't return.
+ *
+ * Side effects:
+ * This Tcl process closes, hard... Bang!
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestExceptionCmd(
+ ClientData dummy, /* Unused */
+ Tcl_Interp* interp, /* Tcl interpreter */
+ int objc, /* Argument count */
+ Tcl_Obj *CONST objv[]) /* Argument vector */
+{
+ static char *cmds[] = {
+ "access_violation",
+ "datatype_misalignment",
+ "array_bounds",
+ "float_denormal",
+ "float_divbyzero",
+ "float_inexact",
+ "float_invalidop",
+ "float_overflow",
+ "float_stack",
+ "float_underflow",
+ "int_divbyzero",
+ "int_overflow",
+ "private_instruction",
+ "inpageerror",
+ "illegal_instruction",
+ "noncontinue",
+ "stack_overflow",
+ "invalid_disp",
+ "guard_page",
+ "invalid_handle",
+ "ctrl+c",
+ NULL
+ };
+ static DWORD exceptions[] = {
+ EXCEPTION_ACCESS_VIOLATION,
+ EXCEPTION_DATATYPE_MISALIGNMENT,
+ EXCEPTION_ARRAY_BOUNDS_EXCEEDED,
+ EXCEPTION_FLT_DENORMAL_OPERAND,
+ EXCEPTION_FLT_DIVIDE_BY_ZERO,
+ EXCEPTION_FLT_INEXACT_RESULT,
+ EXCEPTION_FLT_INVALID_OPERATION,
+ EXCEPTION_FLT_OVERFLOW,
+ EXCEPTION_FLT_STACK_CHECK,
+ EXCEPTION_FLT_UNDERFLOW,
+ EXCEPTION_INT_DIVIDE_BY_ZERO,
+ EXCEPTION_INT_OVERFLOW,
+ EXCEPTION_PRIV_INSTRUCTION,
+ EXCEPTION_IN_PAGE_ERROR,
+ EXCEPTION_ILLEGAL_INSTRUCTION,
+ EXCEPTION_NONCONTINUABLE_EXCEPTION,
+ EXCEPTION_STACK_OVERFLOW,
+ EXCEPTION_INVALID_DISPOSITION,
+ EXCEPTION_GUARD_PAGE,
+ EXCEPTION_INVALID_HANDLE,
+ CONTROL_C_EXIT
+ };
+ int cmd;
+
+ if ( objc != 2 ) {
+ Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0,
+ &cmd) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure the GPF dialog doesn't popup.
+ */
+
+ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
+
+ /*
+ * As Tcl does not handle structured exceptions, this falls all the way
+ * back up the instruction stack to the C run-time portion that called
+ * main() where the process will now be terminated with this exception
+ * code by the default handler the C run-time provides.
+ */
+
+ /* SMASH! */
+ RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);
+
+ /* NOTREACHED */
+ return TCL_OK;
+}
+
+static int
+TestplatformChmod(CONST char *nativePath, int pmode)
+{
+ SID_IDENTIFIER_AUTHORITY userSidAuthority =
+ { SECURITY_WORLD_SID_AUTHORITY };
+
+ typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR );
+ typedef BOOL (WINAPI *initializeSidDef) ( PSID,
+ PSID_IDENTIFIER_AUTHORITY, BYTE );
+ typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD );
+
+ static getSidLengthRequiredDef getSidLengthRequiredProc;
+ static initializeSidDef initializeSidProc;
+ static getSidSubAuthorityDef getSidSubAuthorityProc;
+ 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;
+
+ SID *userSid = 0;
+ TCHAR *userDomain = NULL;
+
+ 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(initializeMutex)
+ 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");
+ getSidLengthRequiredProc = (getSidLengthRequiredDef)
+ GetProcAddress(hInstance, "GetSidLengthRequired");
+ initializeSidProc = (initializeSidDef)
+ GetProcAddress(hInstance, "InitializeSid");
+ getSidSubAuthorityProc = (getSidSubAuthorityDef)
+ GetProcAddress(hInstance, "GetSidSubAuthority");
+ if (setNamedSecurityInfoProc && getAceProc
+ && addAceProc && equalSidProc && addAccessDeniedAceProc
+ && initializeAclProc && getLengthSidProc
+ && getAclInformationProc && getSecurityDescriptorDaclProc
+ && lookupAccountNameProc && getFileSecurityProc
+ && getSidLengthRequiredProc && initializeSidProc
+ && getSidSubAuthorityProc)
+ initialized = 1;
+ }
+ if (!initialized)
+ initialized = -1;
+ }
+ Tcl_MutexUnlock(&initializeMutex);
+ }
+
+ /* 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,
+ (PSECURITY_DESCRIPTOR)secDesc,
+ secDescLen, &secDescLen2)
+ || (secDescLen < secDescLen2)) {
+ goto done;
+ }
+ } else {
+ goto done;
+ }
+ }
+
+ /* Get the World SID */
+ userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1));
+ initializeSidProc( userSid, &userSidAuthority, (BYTE)1);
+ *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID;
+
+ /* 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. */
+ CONST84 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, mode) != 0) {
+ Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
+ NULL);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&buffer);
+ }
+ return TCL_OK;
+}