/* 
 * 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;
}
