开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tclWinTest.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：23k
源码类别：

通讯编程

开发平台：

Visual C++

tclWinTest.c：源码内容
  1. /* 
  2.  * tclWinTest.c --
  3.  *
  4.  * Contains commands for platform specific tests on Windows.
  5.  *
  6.  * Copyright (c) 1996 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * RCS: @(#) $Id: tclWinTest.c,v 1.8.2.6 2006/03/27 23:30:54 patthoyts Exp $
  12.  */
  14. #define USE_COMPAT_CONST
  15. #include "tclWinInt.h"
  17. /*
  18.  * For TestplatformChmod on Windows
  19.  */
  20. #ifdef __WIN32__
  21. #include <aclapi.h>
  22. #endif
  24. /*
  25.  * MinGW 3.4.2 does not define this.
  26.  */
  27. #ifndef INHERITED_ACE
  28. #define INHERITED_ACE (0x10)
  29. #endif
  31. /*
  32.  * Forward declarations of procedures defined later in this file:
  33.  */
  34. int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
  35. static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
  36. Tcl_Interp *interp, int argc, CONST84 char **argv));
  37. static int TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
  38. Tcl_Interp *interp, int objc,
  39. Tcl_Obj *CONST objv[]));
  40. static int      TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
  41.       Tcl_Interp* interp,
  42.       int objc,
  43.       Tcl_Obj *CONST objv[] ));
  44. static int      TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
  45.       Tcl_Interp* interp,
  46.       int objc,
  47.       Tcl_Obj *CONST objv[] ));
  48. static Tcl_ObjCmdProc TestExceptionCmd;
  49. static int TestwincpuidCmd _ANSI_ARGS_(( ClientData dummy,
  50.       Tcl_Interp* interp,
  51.       int objc,
  52.       Tcl_Obj *CONST objv[] ));
  53. static int TestplatformChmod _ANSI_ARGS_((CONST char *nativePath, 
  54.  int pmode));
  55. static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
  56.   Tcl_Interp *interp, int argc, CONST84 char **argv));
  59. /*
  60.  *----------------------------------------------------------------------
  61.  *
  62.  * TclplatformtestInit --
  63.  *
  64.  * Defines commands that test platform specific functionality for
  65.  * Windows platforms.
  66.  *
  67.  * Results:
  68.  * A standard Tcl result.
  69.  *
  70.  * Side effects:
  71.  * Defines new commands.
  72.  *
  73.  *----------------------------------------------------------------------
  74.  */
  76. int
  77. TclplatformtestInit(interp)
  78.     Tcl_Interp *interp; /* Interpreter to add commands to. */
  79. {
  80.     /*
  81.      * Add commands for platform specific tests for Windows here.
  82.      */
  84.     Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
  85.       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  86.     Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
  87.       (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  88.     Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
  89.  (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  90.     Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
  91.  (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  92.     Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd,
  93.  (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
  94.     Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd,
  95.  (ClientData) 0, (Tcl_CmdDeleteProc *) NULL );
  96.     Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd,
  97.  (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  98.     return TCL_OK;
  99. }
  101. /*
  102.  *----------------------------------------------------------------------
  103.  *
  104.  * TesteventloopCmd --
  105.  *
  106.  * This procedure implements the "testeventloop" command. It is
  107.  * used to test the Tcl notifier from an "external" event loop
  108.  * (i.e. not Tcl_DoOneEvent()).
  109.  *
  110.  * Results:
  111.  * A standard Tcl result.
  112.  *
  113.  * Side effects:
  114.  * None.
  115.  *
  116.  *----------------------------------------------------------------------
  117.  */
  119. static int
  120. TesteventloopCmd(clientData, interp, argc, argv)
  121.     ClientData clientData; /* Not used. */
  122.     Tcl_Interp *interp; /* Current interpreter. */
  123.     int argc; /* Number of arguments. */
  124.     CONST84 char **argv; /* Argument strings. */
  125. {
  126.     static int *framePtr = NULL; /* Pointer to integer on stack frame of
  127.   * innermost invocation of the "wait"
  128.   * subcommand. */
  130.    if (argc < 2) {
  131. Tcl_AppendResult(interp, "wrong # arguments: should be "", argv[0],
  132.                 " option ... "", (char *) NULL);
  133.         return TCL_ERROR;
  134.     }
  135.     if (strcmp(argv[1], "done") == 0) {
  136. *framePtr = 1;
  137.     } else if (strcmp(argv[1], "wait") == 0) {
  138. int *oldFramePtr;
  139. int done;
  140. MSG msg;
  141. int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  143. /*
  144.  * Save the old stack frame pointer and set up the current frame.
  145.  */
  147. oldFramePtr = framePtr;
  148. framePtr = &done;
  150. /*
  151.  * Enter a standard Windows event loop until the flag changes.
  152.  * Note that we do not explicitly call Tcl_ServiceEvent().
  153.  */
  155. done = 0;
  156. while (!done) {
  157.     if (!GetMessage(&msg, NULL, 0, 0)) {
  158. /*
  159.  * The application is exiting, so repost the quit message
  160.  * and start unwinding.
  161.  */
  163. PostQuitMessage((int)msg.wParam);
  164. break;
  165.     }
  166.     TranslateMessage(&msg);
  167.     DispatchMessage(&msg);
  168. }
  169. (void) Tcl_SetServiceMode(oldMode);
  170. framePtr = oldFramePtr;
  171.     } else {
  172. Tcl_AppendResult(interp, "bad option "", argv[1],
  173. "": must be done or wait", (char *) NULL);
  174. return TCL_ERROR;
  175.     }
  176.     return TCL_OK;
  177. }
  179. /*
  180.  *----------------------------------------------------------------------
  181.  *
  182.  * Testvolumetype --
  183.  *
  184.  * This procedure implements the "testvolumetype" command. It is
  185.  * used to check the volume type (FAT, NTFS) of a volume.
  186.  *
  187.  * Results:
  188.  * A standard Tcl result.
  189.  *
  190.  * Side effects:
  191.  * None.
  192.  *
  193.  *----------------------------------------------------------------------
  194.  */
  196. static int
  197. TestvolumetypeCmd(clientData, interp, objc, objv)
  198.     ClientData clientData; /* Not used. */
  199.     Tcl_Interp *interp; /* Current interpreter. */
  200.     int objc; /* Number of arguments. */
  201.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  202. {
  203. #define VOL_BUF_SIZE 32
  204.     int found;
  205.     char volType[VOL_BUF_SIZE];
  206.     char *path;
  208.     if (objc > 2) {
  209. Tcl_WrongNumArgs(interp, 1, objv, "?name?");
  210.         return TCL_ERROR;
  211.     }
  212.     if (objc == 2) {
  213. /*
  214.  * path has to be really a proper volume, but we don't
  215.  * get query APIs for that until NT5
  216.  */
  217. path = Tcl_GetString(objv[1]);
  218.     } else {
  219. path = NULL;
  220.     }
  221.     found = GetVolumeInformationA(path, NULL, 0, NULL, NULL, 
  222.     NULL, volType, VOL_BUF_SIZE);
  224.     if (found == 0) {
  225. Tcl_AppendResult(interp, "could not get volume type for "",
  226. (path?path:""), """, (char *) NULL);
  227. TclWinConvertError(GetLastError());
  228. return TCL_ERROR;
  229.     }
  230.     Tcl_SetResult(interp, volType, TCL_VOLATILE);
  231.     return TCL_OK;
  232. #undef VOL_BUF_SIZE
  233. }
  235. /*
  236.  *----------------------------------------------------------------------
  237.  *
  238.  * TestwinclockCmd --
  239.  *
  240.  * Command that returns the seconds and microseconds portions of
  241.  * the system clock and of the Tcl clock so that they can be
  242.  * compared to validate that the Tcl clock is staying in sync.
  243.  *
  244.  * Usage:
  245.  * testclock
  246.  *
  247.  * Parameters:
  248.  * None.
  249.  *
  250.  * Results:
  251.  * Returns a standard Tcl result comprising a four-element list:
  252.  * the seconds and microseconds portions of the system clock,
  253.  * and the seconds and microseconds portions of the Tcl clock.
  254.  *
  255.  * Side effects:
  256.  * None.
  257.  *
  258.  *----------------------------------------------------------------------
  259.  */
  261. static int
  262. TestwinclockCmd( ClientData dummy,
  263. /* Unused */
  264.  Tcl_Interp* interp,
  265. /* Tcl interpreter */
  266.  int objc,
  267. /* Argument count */
  268.  Tcl_Obj *CONST objv[] )
  269. /* Argument vector */
  270. {
  271.     CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
  272. /* The Posix epoch, expressed as a
  273.  * Windows FILETIME */
  274.     Tcl_Time tclTime; /* Tcl clock */
  275.     FILETIME sysTime; /* System clock */
  276.     Tcl_Obj* result; /* Result of the command */
  277.     LARGE_INTEGER t1, t2;
  278.     LARGE_INTEGER p1, p2;
  280.     if ( objc != 1 ) {
  281. Tcl_WrongNumArgs( interp, 1, objv, "" );
  282. return TCL_ERROR;
  283.     }
  285.     QueryPerformanceCounter( &p1 );
  287.     Tcl_GetTime( &tclTime );
  288.     GetSystemTimeAsFileTime( &sysTime );
  289.     t1.LowPart = posixEpoch.dwLowDateTime;
  290.     t1.HighPart = posixEpoch.dwHighDateTime;
  291.     t2.LowPart = sysTime.dwLowDateTime;
  292.     t2.HighPart = sysTime.dwHighDateTime;
  293.     t2.QuadPart -= t1.QuadPart;
  295.     QueryPerformanceCounter( &p2 );
  297.     result = Tcl_NewObj();
  298.     Tcl_ListObjAppendElement
  299. ( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
  300.     Tcl_ListObjAppendElement
  301. ( interp, result,
  302.   Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
  303.     Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
  304.     Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
  306.     Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) );
  307.     Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) );
  309.     Tcl_SetObjResult( interp, result );
  311.     return TCL_OK;
  312. }
  314. /*
  315.  *----------------------------------------------------------------------
  316.  *
  317.  * TestwincpuidCmd --
  318.  *
  319.  * Retrieves CPU ID information.
  320.  *
  321.  * Usage:
  322.  * testwincpuid <eax>
  323.  *
  324.  * Parameters:
  325.  * eax - The value to pass in the EAX register to a CPUID instruction.
  326.  *
  327.  * Results:
  328.  * Returns a four-element list containing the values from the
  329.  * EAX, EBX, ECX and EDX registers returned from the CPUID instruction.
  330.  *
  331.  * Side effects:
  332.  * None.
  333.  *
  334.  *----------------------------------------------------------------------
  335.  */
  337. static int
  338. TestwincpuidCmd( ClientData dummy,
  339.  Tcl_Interp* interp, /* Tcl interpreter */
  340.  int objc, /* Parameter count */
  341.  Tcl_Obj *CONST * objv ) /* Parameter vector */
  342. {
  343.     int status;
  344.     int index;
  345.     unsigned int regs[4];
  346.     Tcl_Obj * regsObjs[4];
  347.     int i;
  349.     if ( objc != 2 ) {
  350. Tcl_WrongNumArgs( interp, 1, objv, "eax" );
  351. return TCL_ERROR;
  352.     }
  353.     if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) {
  354. return TCL_ERROR;
  355.     }
  356.     status = TclWinCPUID( (unsigned int) index, regs );
  357.     if ( status != TCL_OK ) {
  358. Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available", 
  359.     -1 ) );
  360. return status;
  361.     }
  362.     for ( i = 0; i < 4; ++i ) {
  363. regsObjs[i] = Tcl_NewIntObj( (int) regs[i] );
  364.     }
  365.     Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) );
  366.     return TCL_OK;
  367.        
  368. }
  370. /*
  371.  *----------------------------------------------------------------------
  372.  *
  373.  * TestwinsleepCmd --
  374.  *
  375.  * Causes this process to wait for the given number of milliseconds
  376.  * by means of a direct call to Sleep.
  377.  *
  378.  * Usage:
  379.  * testwinsleep <n>
  380.  *
  381.  * Parameters:
  382.  * n - the number of milliseconds to sleep
  383.  *
  384.  * Results:
  385.  * None.
  386.  *
  387.  * Side effects:
  388.  * Sleeps for the requisite number of milliseconds.
  389.  *
  390.  *----------------------------------------------------------------------
  391.  */
  393. static int
  394. TestwinsleepCmd( ClientData clientData,
  395. /* Unused */
  396.  Tcl_Interp* interp,
  397. /* Tcl interpreter */
  398.  int objc,
  399. /* Parameter count */
  400.  Tcl_Obj * CONST * objv )
  401. /* Parameter vector */
  402. {
  403.     int ms;
  404.     if ( objc != 2 ) {
  405. Tcl_WrongNumArgs( interp, 1, objv, "ms" );
  406. return TCL_ERROR;
  407.     }
  408.     if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) {
  409. return TCL_ERROR;
  410.     }
  411.     Sleep( (DWORD) ms );
  412.     return TCL_OK;
  413. }
  415. /*
  416.  *----------------------------------------------------------------------
  417.  *
  418.  * TestExceptionCmd --
  419.  *
  420.  * Causes this process to end with the named exception. Used for
  421.  * testing Tcl_WaitPid().
  422.  *
  423.  * Usage:
  424.  * testexcept <type>
  425.  *
  426.  * Parameters:
  427.  * Type of exception.
  428.  *
  429.  * Results:
  430.  * None, this process closes now and doesn't return.
  431.  *
  432.  * Side effects:
  433.  * This Tcl process closes, hard... Bang!
  434.  *
  435.  *----------------------------------------------------------------------
  436.  */
  438. static int
  439. TestExceptionCmd(
  440.     ClientData dummy, /* Unused */
  441.     Tcl_Interp* interp, /* Tcl interpreter */
  442.     int objc, /* Argument count */
  443.     Tcl_Obj *CONST objv[]) /* Argument vector */
  444. {
  445.     static char *cmds[] = {
  446.     "access_violation",
  447.     "datatype_misalignment",
  448.     "array_bounds",
  449.     "float_denormal",
  450.     "float_divbyzero",
  451.     "float_inexact",
  452.     "float_invalidop",
  453.     "float_overflow",
  454.     "float_stack",
  455.     "float_underflow",
  456.     "int_divbyzero",
  457.     "int_overflow",
  458.     "private_instruction",
  459.     "inpageerror",
  460.     "illegal_instruction",
  461.     "noncontinue",
  462.     "stack_overflow",
  463.     "invalid_disp",
  464.     "guard_page",
  465.     "invalid_handle",
  466.     "ctrl+c",
  467.     NULL
  468.     };
  469.     static DWORD exceptions[] = {
  470.     EXCEPTION_ACCESS_VIOLATION,
  471.     EXCEPTION_DATATYPE_MISALIGNMENT,
  472.     EXCEPTION_ARRAY_BOUNDS_EXCEEDED,
  473.     EXCEPTION_FLT_DENORMAL_OPERAND,
  474.     EXCEPTION_FLT_DIVIDE_BY_ZERO,
  475.     EXCEPTION_FLT_INEXACT_RESULT,
  476.     EXCEPTION_FLT_INVALID_OPERATION,
  477.     EXCEPTION_FLT_OVERFLOW,
  478.     EXCEPTION_FLT_STACK_CHECK,
  479.     EXCEPTION_FLT_UNDERFLOW,
  480.     EXCEPTION_INT_DIVIDE_BY_ZERO,
  481.     EXCEPTION_INT_OVERFLOW,
  482.     EXCEPTION_PRIV_INSTRUCTION,
  483.     EXCEPTION_IN_PAGE_ERROR,
  484.     EXCEPTION_ILLEGAL_INSTRUCTION,
  485.     EXCEPTION_NONCONTINUABLE_EXCEPTION,
  486.     EXCEPTION_STACK_OVERFLOW,
  487.     EXCEPTION_INVALID_DISPOSITION,
  488.     EXCEPTION_GUARD_PAGE,
  489.     EXCEPTION_INVALID_HANDLE,
  490.     CONTROL_C_EXIT
  491.     };
  492.     int cmd;
  494.     if ( objc != 2 ) {
  495. Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
  496. return TCL_ERROR;
  497.     }
  498.     if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0,
  499.     &cmd) != TCL_OK) {
  500. return TCL_ERROR;
  501.     }
  503.     /*
  504.      * Make sure the GPF dialog doesn't popup.
  505.      */
  507.     SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX);
  509.     /*
  510.      * As Tcl does not handle structured exceptions, this falls all the way
  511.      * back up the instruction stack to the C run-time portion that called
  512.      * main() where the process will now be terminated with this exception
  513.      * code by the default handler the C run-time provides.
  514.      */
  516.     /* SMASH! */
  517.     RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);
  519.     /* NOTREACHED */
  520.     return TCL_OK;
  521. }
  523. static int 
  524. TestplatformChmod(CONST char *nativePath, int pmode)
  525. {
  526.     SID_IDENTIFIER_AUTHORITY userSidAuthority =
  527.     { SECURITY_WORLD_SID_AUTHORITY };
  529.     typedef DWORD (WINAPI *getSidLengthRequiredDef) ( UCHAR );
  530.     typedef BOOL (WINAPI *initializeSidDef) ( PSID,
  531.     PSID_IDENTIFIER_AUTHORITY, BYTE );
  532.     typedef PDWORD (WINAPI *getSidSubAuthorityDef) ( PSID, DWORD );
  534.     static getSidLengthRequiredDef getSidLengthRequiredProc;
  535.     static initializeSidDef initializeSidProc;
  536.     static getSidSubAuthorityDef getSidSubAuthorityProc;
  537.     static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION 
  538.       | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
  539.     static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE 
  540.       | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA |  FILE_APPEND_DATA 
  541.       | FILE_WRITE_DATA | DELETE;
  543.     BYTE *secDesc = 0;
  544.     DWORD secDescLen;
  546.     const BOOL set_readOnly = !(pmode & 0222);
  547.     BOOL acl_readOnly_found = FALSE;
  549.     ACL_SIZE_INFORMATION ACLSize;
  550.     BOOL curAclPresent, curAclDefaulted;
  551.     PACL curAcl; 
  552.     PACL newAcl = 0;
  553.     DWORD newAclSize;
  555.     WORD j;
  556.   
  557.     SID *userSid = 0;
  558.     TCHAR *userDomain = NULL;
  560.     DWORD attr;
  562.     int res = 0;
  564.     /*
  565.      * One time initialization, dynamically load Windows NT features
  566.      */
  567.     typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR,
  568.       IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
  569.       IN PACL, IN PACL );
  570.     typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *);
  571.     typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD );
  572.     typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID );
  573.     typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID );
  574.     typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD );
  575.     typedef DWORD (WINAPI *getLengthSidDef) ( PSID );
  576.     typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, 
  577.       ACL_INFORMATION_CLASS );
  578.     typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR,
  579.       LPBOOL, PACL *, LPBOOL );
  580.     typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, 
  581.       PDWORD, LPSTR, LPDWORD, PSID_NAME_USE );
  582.     typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION,
  583.       PSECURITY_DESCRIPTOR, DWORD, LPDWORD );
  585.     static setNamedSecurityInfoADef setNamedSecurityInfoProc;
  586.     static getAceDef getAceProc;
  587.     static addAceDef addAceProc;
  588.     static equalSidDef equalSidProc;
  589.     static addAccessDeniedAceDef addAccessDeniedAceProc;
  590.     static initializeAclDef initializeAclProc;
  591.     static getLengthSidDef getLengthSidProc;
  592.     static getAclInformationDef getAclInformationProc;
  593.     static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
  594.     static lookupAccountNameADef lookupAccountNameProc; 
  595.     static getFileSecurityADef getFileSecurityProc;
  597.     static int initialized = 0;
  598.     if (!initialized) {
  599. TCL_DECLARE_MUTEX(initializeMutex)
  600. Tcl_MutexLock(&initializeMutex);
  601. if (!initialized) {
  602.     HINSTANCE hInstance = LoadLibrary("Advapi32");
  603.     if (hInstance != NULL) {
  604. setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
  605.   GetProcAddress(hInstance, "SetNamedSecurityInfoA");
  606. getFileSecurityProc = (getFileSecurityADef)
  607.   GetProcAddress(hInstance, "GetFileSecurityA");
  608. getAceProc = (getAceDef)
  609.   GetProcAddress(hInstance, "GetAce");
  610. addAceProc = (addAceDef)
  611.   GetProcAddress(hInstance, "AddAce");
  612. equalSidProc = (equalSidDef)
  613.   GetProcAddress(hInstance, "EqualSid");
  614. addAccessDeniedAceProc = (addAccessDeniedAceDef)
  615.   GetProcAddress(hInstance, "AddAccessDeniedAce");
  616. initializeAclProc = (initializeAclDef)
  617.   GetProcAddress(hInstance, "InitializeAcl");
  618. getLengthSidProc = (getLengthSidDef)
  619.   GetProcAddress(hInstance, "GetLengthSid");
  620. getAclInformationProc = (getAclInformationDef)
  621.   GetProcAddress(hInstance, "GetAclInformation");
  622. getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
  623.   GetProcAddress(hInstance, "GetSecurityDescriptorDacl");
  624. lookupAccountNameProc = (lookupAccountNameADef)
  625.   GetProcAddress(hInstance, "LookupAccountNameA");
  626. getSidLengthRequiredProc = (getSidLengthRequiredDef)
  627.   GetProcAddress(hInstance, "GetSidLengthRequired");
  628. initializeSidProc = (initializeSidDef)
  629.   GetProcAddress(hInstance, "InitializeSid");
  630. getSidSubAuthorityProc = (getSidSubAuthorityDef)
  631.   GetProcAddress(hInstance, "GetSidSubAuthority");
  632. if (setNamedSecurityInfoProc && getAceProc
  633.   && addAceProc && equalSidProc && addAccessDeniedAceProc
  634.   && initializeAclProc && getLengthSidProc
  635.   && getAclInformationProc && getSecurityDescriptorDaclProc
  636.   && lookupAccountNameProc && getFileSecurityProc
  637.   && getSidLengthRequiredProc && initializeSidProc
  638.   && getSidSubAuthorityProc)
  639.     initialized = 1;
  640.     }
  641.     if (!initialized)
  642. initialized = -1;
  643. }
  644. Tcl_MutexUnlock(&initializeMutex);
  645.     }
  647.     /* Process the chmod request */
  648.     attr = GetFileAttributes(nativePath);
  650.     /* nativePath not found */
  651.     if (attr == 0xffffffff) {
  652. res = -1;
  653. goto done;
  654.     }
  656.     /* If no ACL API is present or nativePath is not a directory, 
  657.      * there is no special handling 
  658.      */
  659.     if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
  660. goto done;
  661.     }
  662.     
  663.     /* Set the result to error, if the ACL change is successful it will 
  664.      *  be reset to 0 
  665.      */
  666.     res = -1;
  668.     /*
  669.      * Read the security descriptor for the directory. Note the
  670.      * first call obtains the size of the security descriptor.
  671.      */
  672.     if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
  673. if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
  674.     DWORD secDescLen2 = 0;
  675.     secDesc = (BYTE *) ckalloc(secDescLen);
  676.     if (!getFileSecurityProc(nativePath, infoBits,
  677.      (PSECURITY_DESCRIPTOR)secDesc, 
  678.      secDescLen, &secDescLen2) 
  679. || (secDescLen < secDescLen2)) {
  680. goto done;
  681.     }
  682. } else {
  683.     goto done;
  684. }
  685.     }
  687.     /* Get the World SID */
  688.     userSid = (SID*) ckalloc(getSidLengthRequiredProc((UCHAR)1));
  689.     initializeSidProc( userSid, &userSidAuthority, (BYTE)1);
  690.     *(getSidSubAuthorityProc( userSid, 0)) = SECURITY_WORLD_RID;
  692.     /* If curAclPresent == false then curAcl and curAclDefaulted not valid */
  693.     if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, 
  694.        &curAcl, &curAclDefaulted))
  695. goto done;
  697.     if (!curAclPresent || !curAcl) {
  698. ACLSize.AclBytesInUse = 0;
  699. ACLSize.AceCount = 0;
  700.     } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), 
  701.       AclSizeInformation))
  702. goto done;
  704.     /* Allocate memory for the new ACL */
  705.     newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) 
  706.       + getLengthSidProc(userSid) - sizeof (DWORD);
  707.     newAcl = (ACL *) ckalloc (newAclSize);
  708.   
  709.     /* Initialize the new ACL */
  710.     if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
  711. goto done;
  712.     }
  713.     
  714.     /* Add denied to make readonly, this will be known as a "read-only tag" */
  715.     if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, 
  716.       readOnlyMask, userSid)) {
  717. goto done;
  718.     }
  719.       
  720.     acl_readOnly_found = FALSE;
  721.     for (j = 0; j < ACLSize.AceCount; j++) {
  722. PACL *pACE2;
  723. ACE_HEADER *phACE2;
  724. if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) {
  725.     goto done;
  726. }
  728. phACE2 = ((ACE_HEADER *) pACE2);
  730. /* Do NOT propagate inherited ACEs */
  731. if (phACE2->AceFlags & INHERITED_ACE) {
  732.     continue;
  733. }
  735. /* Skip the "read-only tag" restriction (either added above, or it
  736.  * is being removed) 
  737.  */
  738. if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
  739.     ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2;
  740.     if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, 
  741.       (PSID)&(pACEd->SidStart))) {
  742. acl_readOnly_found = TRUE;
  743. continue;
  744.     }
  745. }
  747. /* Copy the current ACE from the old to the new ACL */
  748. if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, 
  749.   ((PACE_HEADER) pACE2)->AceSize)) {
  750.     goto done;
  751. }
  752.     }
  754.     /* Apply the new ACL */
  755.     if (set_readOnly == acl_readOnly_found
  756. || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, 
  757.      DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL)
  758.    == ERROR_SUCCESS ) {
  759. res = 0;
  760.     }
  762.  done:
  763.     if (secDesc) ckfree(secDesc);
  764.     if (newAcl) ckfree((char *)newAcl);
  765.     if (userSid) ckfree((char *)userSid);
  766.     if (userDomain) ckfree(userDomain);
  768.     if (res != 0)
  769. return res;
  770.     
  771.     /* Run normal chmod command */
  772.     return chmod(nativePath, pmode);
  773. }
  775. /*
  776.  *---------------------------------------------------------------------------
  777.  *
  778.  * TestchmodCmd --
  779.  *
  780.  * Implements the "testchmod" cmd.  Used when testing "file" command.
  781.  * The only attribute used by the Windows platform is the user write
  782.  * flag; if this is not set, the file is made read-only.  Otehrwise, the
  783.  * file is made read-write.
  784.  *
  785.  * Results:
  786.  * A standard Tcl result.
  787.  *
  788.  * Side effects:
  789.  * Changes permissions of specified files.
  790.  *
  791.  *---------------------------------------------------------------------------
  792.  */
  794. static int
  795. TestchmodCmd(dummy, interp, argc, argv)
  796.     ClientData dummy; /* Not used. */
  797.     Tcl_Interp *interp; /* Current interpreter. */
  798.     int argc; /* Number of arguments. */
  799.     CONST84 char **argv; /* Argument strings. */
  800. {
  801.     int i, mode;
  802.     char *rest;
  804.     if (argc < 2) {
  805. usage:
  806. Tcl_AppendResult(interp, "wrong # args: should be "", argv[0],
  807. " mode file ?file ...?", NULL);
  808. return TCL_ERROR;
  809.     }
  811.     mode = (int) strtol(argv[1], &rest, 8);
  812.     if ((rest == argv[1]) || (*rest != '')) {
  813. goto usage;
  814.     }
  816.     for (i = 2; i < argc; i++) {
  817. Tcl_DString buffer;
  818. CONST char *translated;
  820. translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
  821. if (translated == NULL) {
  822.     return TCL_ERROR;
  823. }
  824. if (TestplatformChmod(translated, mode) != 0) {
  825.     Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
  826.     NULL);
  827.     return TCL_ERROR;
  828. }
  829. Tcl_DStringFree(&buffer);
  830.     }
  831.     return TCL_OK;
  832. }