os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinTest.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinTest.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,832 @@
1.4 +/*
1.5 + * tclWinTest.c --
1.6 + *
1.7 + * Contains commands for platform specific tests on Windows.
1.8 + *
1.9 + * Copyright (c) 1996 Sun Microsystems, Inc.
1.10 + *
1.11 + * See the file "license.terms" for information on usage and redistribution
1.12 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.13 + *
1.14 + * RCS: @(#) $Id: tclWinTest.c,v 1.8.2.6 2006/03/27 23:30:54 patthoyts Exp $
1.15 + */
1.16 +
1.17 +#define USE_COMPAT_CONST
1.18 +#include "tclWinInt.h"
1.19 +
1.20 +/*
1.21 + * For TestplatformChmod on Windows
1.22 + */
1.23 +#ifdef __WIN32__
1.24 +#include <aclapi.h>
1.25 +#endif
1.26 +
1.27 +/*
1.28 + * MinGW 3.4.2 does not define this.
1.29 + */
1.30 +#ifndef INHERITED_ACE
1.31 +#define INHERITED_ACE (0x10)
1.32 +#endif
1.33 +
1.34 +/*
1.35 + * Forward declarations of procedures defined later in this file:
1.36 + */
1.37 +int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
1.38 +static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
1.39 + Tcl_Interp *interp, int argc, CONST84 char **argv));
1.40 +static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
1.41 + Tcl_Interp *interp, int objc,
1.42 + Tcl_Obj *CONST objv[]));
1.43 +static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
1.44 + Tcl_Interp* interp,
1.45 + int objc,
1.46 + Tcl_Obj *CONST objv[] ));
1.47 +static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
1.48 + Tcl_Interp* interp,
1.49 + int objc,
1.50 + Tcl_Obj *CONST objv[] ));
1.51 +static Tcl_ObjCmdProc TestExceptionCmd;
1.52 +static int TestwincpuidCmd _ANSI_ARGS_(( ClientData dummy,
1.53 + Tcl_Interp* interp,
1.54 + int objc,
1.55 + Tcl_Obj *CONST objv[] ));
1.56 +static int TestplatformChmod _ANSI_ARGS_((CONST char *nativePath,
1.57 + int pmode));
1.58 +static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
1.59 + Tcl_Interp *interp, int argc, CONST84 char **argv));
1.60 +
1.61 +
1.62 +/*
1.63 + *----------------------------------------------------------------------
1.64 + *
1.65 + * TclplatformtestInit --
1.66 + *
1.67 + * Defines commands that test platform specific functionality for
1.68 + * Windows platforms.
1.69 + *
1.70 + * Results:
1.71 + * A standard Tcl result.
1.72 + *
1.73 + * Side effects:
1.74 + * Defines new commands.
1.75 + *
1.76 + *----------------------------------------------------------------------
1.77 + */
1.78 +
1.79 +int
1.80 +TclplatformtestInit(interp)
1.81 + Tcl_Interp *interp; /* Interpreter to add commands to. */
1.82 +{
1.83 + /*
1.84 + * Add commands for platform specific tests for Windows here.
1.85 + */
1.86 +
1.87 + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
1.88 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.89 + Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
1.90 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.91 + Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
1.92 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.93 + Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
1.94 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.95 + Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd,
1.96 + (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
1.97 + Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd,
1.98 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL );
1.99 + Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd,
1.100 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.101 + return TCL_OK;
1.102 +}
1.103 +
1.104 +/*
1.105 + *----------------------------------------------------------------------
1.106 + *
1.107 + * TesteventloopCmd --
1.108 + *
1.109 + * This procedure implements the "testeventloop" command. It is
1.110 + * used to test the Tcl notifier from an "external" event loop
1.111 + * (i.e. not Tcl_DoOneEvent()).
1.112 + *
1.113 + * Results:
1.114 + * A standard Tcl result.
1.115 + *
1.116 + * Side effects:
1.117 + * None.
1.118 + *
1.119 + *----------------------------------------------------------------------
1.120 + */
1.121 +
1.122 +static int
1.123 +TesteventloopCmd(clientData, interp, argc, argv)
1.124 + ClientData clientData; /* Not used. */
1.125 + Tcl_Interp *interp; /* Current interpreter. */
1.126 + int argc; /* Number of arguments. */
1.127 + CONST84 char **argv; /* Argument strings. */
1.128 +{
1.129 + static int *framePtr = NULL; /* Pointer to integer on stack frame of
1.130 + * innermost invocation of the "wait"
1.131 + * subcommand. */
1.132 +
1.133 + if (argc < 2) {
1.134 + Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
1.135 + " option ... \"", (char *) NULL);
1.136 + return TCL_ERROR;
1.137 + }
1.138 + if (strcmp(argv[1], "done") == 0) {
1.139 + *framePtr = 1;
1.140 + } else if (strcmp(argv[1], "wait") == 0) {
1.141 + int *oldFramePtr;
1.142 + int done;
1.143 + MSG msg;
1.144 + int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
1.145 +
1.146 + /*
1.147 + * Save the old stack frame pointer and set up the current frame.
1.148 + */
1.149 +
1.150 + oldFramePtr = framePtr;
1.151 + framePtr = &done;
1.152 +
1.153 + /*
1.154 + * Enter a standard Windows event loop until the flag changes.
1.155 + * Note that we do not explicitly call Tcl_ServiceEvent().
1.156 + */
1.157 +
1.158 + done = 0;
1.159 + while (!done) {
1.160 + if (!GetMessage(&msg, NULL, 0, 0)) {
1.161 + /*
1.162 + * The application is exiting, so repost the quit message
1.163 + * and start unwinding.
1.164 + */
1.165 +
1.166 + PostQuitMessage((int)msg.wParam);
1.167 + break;
1.168 + }
1.169 + TranslateMessage(&msg);
1.170 + DispatchMessage(&msg);
1.171 + }
1.172 + (void) Tcl_SetServiceMode(oldMode);
1.173 + framePtr = oldFramePtr;
1.174 + } else {
1.175 + Tcl_AppendResult(interp, "bad option \"", argv[1],
1.176 + "\": must be done or wait", (char *) NULL);
1.177 + return TCL_ERROR;
1.178 + }
1.179 + return TCL_OK;
1.180 +}
1.181 +
1.182 +/*
1.183 + *----------------------------------------------------------------------
1.184 + *
1.185 + * Testvolumetype --
1.186 + *
1.187 + * This procedure implements the "testvolumetype" command. It is
1.188 + * used to check the volume type (FAT, NTFS) of a volume.
1.189 + *
1.190 + * Results:
1.191 + * A standard Tcl result.
1.192 + *
1.193 + * Side effects:
1.194 + * None.
1.195 + *
1.196 + *----------------------------------------------------------------------
1.197 + */
1.198 +
1.199 +static int
1.200 +TestvolumetypeCmd(clientData, interp, objc, objv)
1.201 + ClientData clientData; /* Not used. */
1.202 + Tcl_Interp *interp; /* Current interpreter. */
1.203 + int objc; /* Number of arguments. */
1.204 + Tcl_Obj *CONST objv[]; /* Argument objects. */
1.205 +{
1.206 +#define VOL_BUF_SIZE 32
1.207 + int found;
1.208 + char volType[VOL_BUF_SIZE];
1.209 + char *path;
1.210 +
1.211 + if (objc > 2) {
1.212 + Tcl_WrongNumArgs(interp, 1, objv, "?name?");
1.213 + return TCL_ERROR;
1.214 + }
1.215 + if (objc == 2) {
1.216 + /*
1.217 + * path has to be really a proper volume, but we don't
1.218 + * get query APIs for that until NT5
1.219 + */
1.220 + path = Tcl_GetString(objv[1]);
1.221 + } else {
1.222 + path = NULL;
1.223 + }
1.224 + found = GetVolumeInformationA(path, NULL, 0, NULL, NULL,
1.225 + NULL, volType, VOL_BUF_SIZE);
1.226 +
1.227 + if (found == 0) {
1.228 + Tcl_AppendResult(interp, "could not get volume type for \"",
1.229 + (path?path:""), "\"", (char *) NULL);
1.230 + TclWinConvertError(GetLastError());
1.231 + return TCL_ERROR;
1.232 + }
1.233 + Tcl_SetResult(interp, volType, TCL_VOLATILE);
1.234 + return TCL_OK;
1.235 +#undef VOL_BUF_SIZE
1.236 +}
1.237 +
1.238 +/*
1.239 + *----------------------------------------------------------------------
1.240 + *
1.241 + * TestwinclockCmd --
1.242 + *
1.243 + * Command that returns the seconds and microseconds portions of
1.244 + * the system clock and of the Tcl clock so that they can be
1.245 + * compared to validate that the Tcl clock is staying in sync.
1.246 + *
1.247 + * Usage:
1.248 + * testclock
1.249 + *
1.250 + * Parameters:
1.251 + * None.
1.252 + *
1.253 + * Results:
1.254 + * Returns a standard Tcl result comprising a four-element list:
1.255 + * the seconds and microseconds portions of the system clock,
1.256 + * and the seconds and microseconds portions of the Tcl clock.
1.257 + *
1.258 + * Side effects:
1.259 + * None.
1.260 + *
1.261 + *----------------------------------------------------------------------
1.262 + */
1.263 +
1.264 +static int
1.265 +TestwinclockCmd( ClientData dummy,
1.266 + /* Unused */
1.267 + Tcl_Interp* interp,
1.268 + /* Tcl interpreter */
1.269 + int objc,
1.270 + /* Argument count */
1.271 + Tcl_Obj *CONST objv[] )
1.272 + /* Argument vector */
1.273 +{
1.274 + CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
1.275 + /* The Posix epoch, expressed as a
1.276 + * Windows FILETIME */
1.277 + Tcl_Time tclTime; /* Tcl clock */
1.278 + FILETIME sysTime; /* System clock */
1.279 + Tcl_Obj* result; /* Result of the command */
1.280 + LARGE_INTEGER t1, t2;
1.281 + LARGE_INTEGER p1, p2;
1.282 +
1.283 + if ( objc != 1 ) {
1.284 + Tcl_WrongNumArgs( interp, 1, objv, "" );
1.285 + return TCL_ERROR;
1.286 + }
1.287 +
1.288 + QueryPerformanceCounter( &p1 );
1.289 +
1.290 + Tcl_GetTime( &tclTime );
1.291 + GetSystemTimeAsFileTime( &sysTime );
1.292 + t1.LowPart = posixEpoch.dwLowDateTime;
1.293 + t1.HighPart = posixEpoch.dwHighDateTime;
1.294 + t2.LowPart = sysTime.dwLowDateTime;
1.295 + t2.HighPart = sysTime.dwHighDateTime;
1.296 + t2.QuadPart -= t1.QuadPart;
1.297 +
1.298 + QueryPerformanceCounter( &p2 );
1.299 +
1.300 + result = Tcl_NewObj();
1.301 + Tcl_ListObjAppendElement
1.302 + ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
1.303 + Tcl_ListObjAppendElement
1.304 + ( interp, result,
1.305 + Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
1.306 + Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
1.307 + Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
1.308 +
1.309 + Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) );
1.310 + Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) );
1.311 +
1.312 + Tcl_SetObjResult( interp, result );
1.313 +
1.314 + return TCL_OK;
1.315 +}
1.316 +
1.317 +/*
1.318 + *----------------------------------------------------------------------
1.319 + *
1.320 + * TestwincpuidCmd --
1.321 + *
1.322 + * Retrieves CPU ID information.
1.323 + *
1.324 + * Usage:
1.325 + * testwincpuid <eax>
1.326 + *
1.327 + * Parameters:
1.328 + * eax - The value to pass in the EAX register to a CPUID instruction.
1.329 + *
1.330 + * Results:
1.331 + * Returns a four-element list containing the values from the
1.332 + * EAX, EBX, ECX and EDX registers returned from the CPUID instruction.
1.333 + *
1.334 + * Side effects:
1.335 + * None.
1.336 + *
1.337 + *----------------------------------------------------------------------
1.338 + */
1.339 +
1.340 +static int
1.341 +TestwincpuidCmd( ClientData dummy,
1.342 + Tcl_Interp* interp, /* Tcl interpreter */
1.343 + int objc, /* Parameter count */
1.344 + Tcl_Obj *CONST * objv ) /* Parameter vector */
1.345 +{
1.346 + int status;
1.347 + int index;
1.348 + unsigned int regs[4];
1.349 + Tcl_Obj * regsObjs[4];
1.350 + int i;
1.351 +
1.352 + if ( objc != 2 ) {
1.353 + Tcl_WrongNumArgs( interp, 1, objv, "eax" );
1.354 + return TCL_ERROR;
1.355 + }
1.356 + if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) {
1.357 + return TCL_ERROR;
1.358 + }
1.359 + status = TclWinCPUID( (unsigned int) index, regs );
1.360 + if ( status != TCL_OK ) {
1.361 + Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available",
1.362 + -1 ) );
1.363 + return status;
1.364 + }
1.365 + for ( i = 0; i < 4; ++i ) {
1.366 + regsObjs[i] = Tcl_NewIntObj( (int) regs[i] );
1.367 + }
1.368 + Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) );
1.369 + return TCL_OK;
1.370 +
1.371 +}
1.372 +
1.373 +/*
1.374 + *----------------------------------------------------------------------
1.375 + *
1.376 + * TestwinsleepCmd --
1.377 + *
1.378 + * Causes this process to wait for the given number of milliseconds
1.379 + * by means of a direct call to Sleep.
1.380 + *
1.381 + * Usage:
1.382 + * testwinsleep <n>
1.383 + *
1.384 + * Parameters:
1.385 + * n - the number of milliseconds to sleep
1.386 + *
1.387 + * Results:
1.388 + * None.
1.389 + *
1.390 + * Side effects:
1.391 + * Sleeps for the requisite number of milliseconds.
1.392 + *
1.393 + *----------------------------------------------------------------------
1.394 + */
1.395 +
1.396 +static int
1.397 +TestwinsleepCmd( ClientData clientData,
1.398 + /* Unused */
1.399 + Tcl_Interp* interp,
1.400 + /* Tcl interpreter */
1.401 + int objc,
1.402 + /* Parameter count */
1.403 + Tcl_Obj * CONST * objv )
1.404 + /* Parameter vector */
1.405 +{
1.406 + int ms;
1.407 + if ( objc != 2 ) {
1.408 + Tcl_WrongNumArgs( interp, 1, objv, "ms" );
1.409 + return TCL_ERROR;
1.410 + }
1.411 + if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) {
1.412 + return TCL_ERROR;
1.413 + }
1.414 + Sleep( (DWORD) ms );
1.415 + return TCL_OK;
1.416 +}
1.417 +
1.418 +/*
1.419 + *----------------------------------------------------------------------
1.420 + *
1.421 + * TestExceptionCmd --
1.422 + *
1.423 + * Causes this process to end with the named exception. Used for
1.424 + * testing Tcl_WaitPid().
1.425 + *
1.426 + * Usage:
1.427 + * testexcept <type>
1.428 + *
1.429 + * Parameters:
1.430 + * Type of exception.
1.431 + *
1.432 + * Results:
1.433 + * None, this process closes now and doesn't return.
1.434 + *
1.435 + * Side effects:
1.436 + * This Tcl process closes, hard... Bang!
1.437 + *
1.438 + *----------------------------------------------------------------------
1.439 + */
1.440 +
1.441 +static int
1.442 +TestExceptionCmd(
1.443 + ClientData dummy, /* Unused */
1.444 + Tcl_Interp* interp, /* Tcl interpreter */
1.445 + int objc, /* Argument count */
1.446 + Tcl_Obj *CONST objv[]) /* Argument vector */
1.447 +{
1.448 + static char *cmds[] = {
1.449 + "access_violation",
1.450 + "datatype_misalignment",
1.451 + "array_bounds",
1.452 + "float_denormal",
1.453 + "float_divbyzero",
1.454 + "float_inexact",
1.455 + "float_invalidop",
1.456 + "float_overflow",
1.457 + "float_stack",
1.458 + "float_underflow",
1.459 + "int_divbyzero",
1.460 + "int_overflow",
1.461 + "private_instruction",
1.462 + "inpageerror",
1.463 + "illegal_instruction",
1.464 + "noncontinue",
1.465 + "stack_overflow",
1.466 + "invalid_disp",
1.467 + "guard_page",
1.468 + "invalid_handle",
1.469 + "ctrl+c",
1.470 + NULL
1.471 + };
1.472 + static DWORD exceptions[] = {
1.473 + EXCEPTION_ACCESS_VIOLATION,
1.474 + EXCEPTION_DATATYPE_MISALIGNMENT,
1.475 + EXCEPTION_ARRAY_BOUNDS_EXCEEDED,
1.476 + EXCEPTION_FLT_DENORMAL_OPERAND,
1.477 + EXCEPTION_FLT_DIVIDE_BY_ZERO,
1.478 + EXCEPTION_FLT_INEXACT_RESULT,
1.479 + EXCEPTION_FLT_INVALID_OPERATION,
1.480 + EXCEPTION_FLT_OVERFLOW,
1.481 + EXCEPTION_FLT_STACK_CHECK,
1.482 + EXCEPTION_FLT_UNDERFLOW,
1.483 + EXCEPTION_INT_DIVIDE_BY_ZERO,
1.484 + EXCEPTION_INT_OVERFLOW,
1.485 + EXCEPTION_PRIV_INSTRUCTION,
1.486 + EXCEPTION_IN_PAGE_ERROR,
1.487 + EXCEPTION_ILLEGAL_INSTRUCTION,
1.488 + EXCEPTION_NONCONTINUABLE_EXCEPTION,
1.489 + EXCEPTION_STACK_OVERFLOW,
1.490 + EXCEPTION_INVALID_DISPOSITION,
1.491 + EXCEPTION_GUARD_PAGE,
1.492 + EXCEPTION_INVALID_HANDLE,
1.493 + CONTROL_C_EXIT
1.494 + };
1.495 + int cmd;
1.496 +
1.497 + if ( objc != 2 ) {
1.498 + Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
1.499 + return TCL_ERROR;
1.500 + }
1.501 + if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0,
1.502 + &cmd) != TCL_OK) {
1.503 + return TCL_ERROR;
1.504 + }
1.505 +
1.506 + /*
1.507 + * Make sure the GPF dialog doesn't popup.
1.508 + */
1.509 +
1.510 + SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
1.511 +
1.512 + /*
1.513 + * As Tcl does not handle structured exceptions, this falls all the way
1.514 + * back up the instruction stack to the C run-time portion that called
1.515 + * main() where the process will now be terminated with this exception
1.516 + * code by the default handler the C run-time provides.
1.517 + */
1.518 +
1.519 + /* SMASH! */
1.520 + RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);
1.521 +
1.522 + /* NOTREACHED */
1.523 + return TCL_OK;
1.524 +}
1.525 +
1.526 +static int
1.527 +TestplatformChmod(CONST char *nativePath, int pmode)
1.528 +{
1.529 + SID_IDENTIFIER_AUTHORITY userSidAuthority =
1.530 + { SECURITY_WORLD_SID_AUTHORITY };
1.531 +
1.532 + typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR );
1.533 + typedef BOOL (WINAPI *initializeSidDef) ( PSID,
1.534 + PSID_IDENTIFIER_AUTHORITY, BYTE );
1.535 + typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD );
1.536 +
1.537 + static getSidLengthRequiredDef getSidLengthRequiredProc;
1.538 + static initializeSidDef initializeSidProc;
1.539 + static getSidSubAuthorityDef getSidSubAuthorityProc;
1.540 + static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
1.541 + | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
1.542 + static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
1.543 + | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
1.544 + | FILE_WRITE_DATA | DELETE;
1.545 +
1.546 + BYTE *secDesc = 0;
1.547 + DWORD secDescLen;
1.548 +
1.549 + const BOOL set_readOnly = !(pmode & 0222);
1.550 + BOOL acl_readOnly_found = FALSE;
1.551 +
1.552 + ACL_SIZE_INFORMATION ACLSize;
1.553 + BOOL curAclPresent, curAclDefaulted;
1.554 + PACL curAcl;
1.555 + PACL newAcl = 0;
1.556 + DWORD newAclSize;
1.557 +
1.558 + WORD j;
1.559 +
1.560 + SID *userSid = 0;
1.561 + TCHAR *userDomain = NULL;
1.562 +
1.563 + DWORD attr;
1.564 +
1.565 + int res = 0;
1.566 +
1.567 + /*
1.568 + * One time initialization, dynamically load Windows NT features
1.569 + */
1.570 + typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR,
1.571 + IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
1.572 + IN PACL, IN PACL );
1.573 + typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *);
1.574 + typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD );
1.575 + typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID );
1.576 + typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID );
1.577 + typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD );
1.578 + typedef DWORD (WINAPI *getLengthSidDef) ( PSID );
1.579 + typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD,
1.580 + ACL_INFORMATION_CLASS );
1.581 + typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR,
1.582 + LPBOOL, PACL *, LPBOOL );
1.583 + typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID,
1.584 + PDWORD, LPSTR, LPDWORD, PSID_NAME_USE );
1.585 + typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION,
1.586 + PSECURITY_DESCRIPTOR, DWORD, LPDWORD );
1.587 +
1.588 + static setNamedSecurityInfoADef setNamedSecurityInfoProc;
1.589 + static getAceDef getAceProc;
1.590 + static addAceDef addAceProc;
1.591 + static equalSidDef equalSidProc;
1.592 + static addAccessDeniedAceDef addAccessDeniedAceProc;
1.593 + static initializeAclDef initializeAclProc;
1.594 + static getLengthSidDef getLengthSidProc;
1.595 + static getAclInformationDef getAclInformationProc;
1.596 + static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
1.597 + static lookupAccountNameADef lookupAccountNameProc;
1.598 + static getFileSecurityADef getFileSecurityProc;
1.599 +
1.600 + static int initialized = 0;
1.601 + if (!initialized) {
1.602 + TCL_DECLARE_MUTEX(initializeMutex)
1.603 + Tcl_MutexLock(&initializeMutex);
1.604 + if (!initialized) {
1.605 + HINSTANCE hInstance = LoadLibrary("Advapi32");
1.606 + if (hInstance != NULL) {
1.607 + setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
1.608 + GetProcAddress(hInstance, "SetNamedSecurityInfoA");
1.609 + getFileSecurityProc = (getFileSecurityADef)
1.610 + GetProcAddress(hInstance, "GetFileSecurityA");
1.611 + getAceProc = (getAceDef)
1.612 + GetProcAddress(hInstance, "GetAce");
1.613 + addAceProc = (addAceDef)
1.614 + GetProcAddress(hInstance, "AddAce");
1.615 + equalSidProc = (equalSidDef)
1.616 + GetProcAddress(hInstance, "EqualSid");
1.617 + addAccessDeniedAceProc = (addAccessDeniedAceDef)
1.618 + GetProcAddress(hInstance, "AddAccessDeniedAce");
1.619 + initializeAclProc = (initializeAclDef)
1.620 + GetProcAddress(hInstance, "InitializeAcl");
1.621 + getLengthSidProc = (getLengthSidDef)
1.622 + GetProcAddress(hInstance, "GetLengthSid");
1.623 + getAclInformationProc = (getAclInformationDef)
1.624 + GetProcAddress(hInstance, "GetAclInformation");
1.625 + getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
1.626 + GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
1.627 + lookupAccountNameProc = (lookupAccountNameADef)
1.628 + GetProcAddress(hInstance, "LookupAccountNameA");
1.629 + getSidLengthRequiredProc = (getSidLengthRequiredDef)
1.630 + GetProcAddress(hInstance, "GetSidLengthRequired");
1.631 + initializeSidProc = (initializeSidDef)
1.632 + GetProcAddress(hInstance, "InitializeSid");
1.633 + getSidSubAuthorityProc = (getSidSubAuthorityDef)
1.634 + GetProcAddress(hInstance, "GetSidSubAuthority");
1.635 + if (setNamedSecurityInfoProc && getAceProc
1.636 + && addAceProc && equalSidProc && addAccessDeniedAceProc
1.637 + && initializeAclProc && getLengthSidProc
1.638 + && getAclInformationProc && getSecurityDescriptorDaclProc
1.639 + && lookupAccountNameProc && getFileSecurityProc
1.640 + && getSidLengthRequiredProc && initializeSidProc
1.641 + && getSidSubAuthorityProc)
1.642 + initialized = 1;
1.643 + }
1.644 + if (!initialized)
1.645 + initialized = -1;
1.646 + }
1.647 + Tcl_MutexUnlock(&initializeMutex);
1.648 + }
1.649 +
1.650 + /* Process the chmod request */
1.651 + attr = GetFileAttributes(nativePath);
1.652 +
1.653 + /* nativePath not found */
1.654 + if (attr == 0xffffffff) {
1.655 + res = -1;
1.656 + goto done;
1.657 + }
1.658 +
1.659 + /* If no ACL API is present or nativePath is not a directory,
1.660 + * there is no special handling
1.661 + */
1.662 + if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
1.663 + goto done;
1.664 + }
1.665 +
1.666 + /* Set the result to error, if the ACL change is successful it will
1.667 + * be reset to 0
1.668 + */
1.669 + res = -1;
1.670 +
1.671 + /*
1.672 + * Read the security descriptor for the directory. Note the
1.673 + * first call obtains the size of the security descriptor.
1.674 + */
1.675 + if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
1.676 + if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
1.677 + DWORD secDescLen2 = 0;
1.678 + secDesc = (BYTE *) ckalloc(secDescLen);
1.679 + if (!getFileSecurityProc(nativePath, infoBits,
1.680 + (PSECURITY_DESCRIPTOR)secDesc,
1.681 + secDescLen, &secDescLen2)
1.682 + || (secDescLen < secDescLen2)) {
1.683 + goto done;
1.684 + }
1.685 + } else {
1.686 + goto done;
1.687 + }
1.688 + }
1.689 +
1.690 + /* Get the World SID */
1.691 + userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1));
1.692 + initializeSidProc( userSid, &userSidAuthority, (BYTE)1);
1.693 + *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID;
1.694 +
1.695 + /* If curAclPresent == false then curAcl and curAclDefaulted not valid */
1.696 + if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent,
1.697 + &curAcl, &curAclDefaulted))
1.698 + goto done;
1.699 +
1.700 + if (!curAclPresent || !curAcl) {
1.701 + ACLSize.AclBytesInUse = 0;
1.702 + ACLSize.AceCount = 0;
1.703 + } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
1.704 + AclSizeInformation))
1.705 + goto done;
1.706 +
1.707 + /* Allocate memory for the new ACL */
1.708 + newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE)
1.709 + + getLengthSidProc(userSid) - sizeof (DWORD);
1.710 + newAcl = (ACL *) ckalloc (newAclSize);
1.711 +
1.712 + /* Initialize the new ACL */
1.713 + if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
1.714 + goto done;
1.715 + }
1.716 +
1.717 + /* Add denied to make readonly, this will be known as a "read-only tag" */
1.718 + if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
1.719 + readOnlyMask, userSid)) {
1.720 + goto done;
1.721 + }
1.722 +
1.723 + acl_readOnly_found = FALSE;
1.724 + for (j = 0; j < ACLSize.AceCount; j++) {
1.725 + PACL *pACE2;
1.726 + ACE_HEADER *phACE2;
1.727 + if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) {
1.728 + goto done;
1.729 + }
1.730 +
1.731 + phACE2 = ((ACE_HEADER *) pACE2);
1.732 +
1.733 + /* Do NOT propagate inherited ACEs */
1.734 + if (phACE2->AceFlags & INHERITED_ACE) {
1.735 + continue;
1.736 + }
1.737 +
1.738 + /* Skip the "read-only tag" restriction (either added above, or it
1.739 + * is being removed)
1.740 + */
1.741 + if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
1.742 + ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2;
1.743 + if (pACEd->Mask == readOnlyMask && equalSidProc(userSid,
1.744 + (PSID)&(pACEd->SidStart))) {
1.745 + acl_readOnly_found = TRUE;
1.746 + continue;
1.747 + }
1.748 + }
1.749 +
1.750 + /* Copy the current ACE from the old to the new ACL */
1.751 + if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2,
1.752 + ((PACE_HEADER) pACE2)->AceSize)) {
1.753 + goto done;
1.754 + }
1.755 + }
1.756 +
1.757 + /* Apply the new ACL */
1.758 + if (set_readOnly == acl_readOnly_found
1.759 + || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT,
1.760 + DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL)
1.761 + == ERROR_SUCCESS ) {
1.762 + res = 0;
1.763 + }
1.764 +
1.765 + done:
1.766 + if (secDesc) ckfree(secDesc);
1.767 + if (newAcl) ckfree((char *)newAcl);
1.768 + if (userSid) ckfree((char *)userSid);
1.769 + if (userDomain) ckfree(userDomain);
1.770 +
1.771 + if (res != 0)
1.772 + return res;
1.773 +
1.774 + /* Run normal chmod command */
1.775 + return chmod(nativePath, pmode);
1.776 +}
1.777 +
1.778 +/*
1.779 + *---------------------------------------------------------------------------
1.780 + *
1.781 + * TestchmodCmd --
1.782 + *
1.783 + * Implements the "testchmod" cmd. Used when testing "file" command.
1.784 + * The only attribute used by the Windows platform is the user write
1.785 + * flag; if this is not set, the file is made read-only. Otehrwise, the
1.786 + * file is made read-write.
1.787 + *
1.788 + * Results:
1.789 + * A standard Tcl result.
1.790 + *
1.791 + * Side effects:
1.792 + * Changes permissions of specified files.
1.793 + *
1.794 + *---------------------------------------------------------------------------
1.795 + */
1.796 +
1.797 +static int
1.798 +TestchmodCmd(dummy, interp, argc, argv)
1.799 + ClientData dummy; /* Not used. */
1.800 + Tcl_Interp *interp; /* Current interpreter. */
1.801 + int argc; /* Number of arguments. */
1.802 + CONST84 char **argv; /* Argument strings. */
1.803 +{
1.804 + int i, mode;
1.805 + char *rest;
1.806 +
1.807 + if (argc < 2) {
1.808 + usage:
1.809 + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1.810 + " mode file ?file ...?", NULL);
1.811 + return TCL_ERROR;
1.812 + }
1.813 +
1.814 + mode = (int) strtol(argv[1], &rest, 8);
1.815 + if ((rest == argv[1]) || (*rest != '\0')) {
1.816 + goto usage;
1.817 + }
1.818 +
1.819 + for (i = 2; i < argc; i++) {
1.820 + Tcl_DString buffer;
1.821 + CONST char *translated;
1.822 +
1.823 + translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
1.824 + if (translated == NULL) {
1.825 + return TCL_ERROR;
1.826 + }
1.827 + if (TestplatformChmod(translated, mode) != 0) {
1.828 + Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
1.829 + NULL);
1.830 + return TCL_ERROR;
1.831 + }
1.832 + Tcl_DStringFree(&buffer);
1.833 + }
1.834 + return TCL_OK;
1.835 +}