/* * 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.14 2006/03/17 09:59:55 mistachkin Exp $ */ #define USE_COMPAT_CONST #include "tclInt.h" /* * For Testplaftorm_chmod on Windows */ #ifdef __WIN32__ #include #endif /* * Forward declarations of functions defined later in this file: */ int TclplatformtestInit(Tcl_Interp *interp); static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp, int argc, char **argv); static int TestvolumetypeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[]); static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[]); static Tcl_ObjCmdProc TestExceptionCmd; static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *CONST objv[]); static int TestplatformChmod(CONST char *nativePath, int pmode); static int TestchmodCmd(ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv); /* *---------------------------------------------------------------------- * * TclplatformtestInit -- * * Defines commands that test platform specific functionality for Windows * platforms. * * Results: * A standard Tcl result. * * Side effects: * Defines new commands. * *---------------------------------------------------------------------- */ int TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { /* * Add commands for platform specific tests for Windows here. */ Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * TesteventloopCmd -- * * This function 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 clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ 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 ... \"", 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(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", NULL); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * Testvolumetype -- * * This function 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 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:""), "\"", 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 * * 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 * * 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 * * 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, ""); 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) { static const char everyoneBuf[] = "EVERYONE"; static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION; static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA | FILE_WRITE_DATA | DELETE; BYTE *secDesc = 0; DWORD secDescLen; const BOOL set_readOnly = !(pmode & 0222); BOOL acl_readOnly_found = FALSE; ACL_SIZE_INFORMATION ACLSize; BOOL curAclPresent, curAclDefaulted; PACL curAcl; PACL newAcl = 0; DWORD newAclSize; WORD j; DWORD userSidLen = 4096; SID *userSid = 0; DWORD userDomainLen = 32; TCHAR *userDomain = 0; SID_NAME_USE userSidUse; DWORD attr; int res = 0; /* * One time initialization, dynamically load Windows NT features */ typedef DWORD (WINAPI *setNamedSecurityInfoADef)( IN LPSTR, IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID, IN PACL, IN PACL ); typedef BOOL (WINAPI *getAceDef) (PACL, DWORD, LPVOID *); typedef BOOL (WINAPI *addAceDef) ( PACL, DWORD, DWORD, LPVOID, DWORD ); typedef BOOL (WINAPI *equalSidDef) ( PSID, PSID ); typedef BOOL (WINAPI *addAccessDeniedAceDef) ( PACL, DWORD, DWORD, PSID ); typedef BOOL (WINAPI *initializeAclDef) ( PACL, DWORD, DWORD ); typedef DWORD (WINAPI *getLengthSidDef) ( PSID ); typedef BOOL (WINAPI *getAclInformationDef) (PACL, LPVOID, DWORD, ACL_INFORMATION_CLASS ); typedef BOOL (WINAPI *getSecurityDescriptorDaclDef) (PSECURITY_DESCRIPTOR, LPBOOL, PACL *, LPBOOL ); typedef BOOL (WINAPI *lookupAccountNameADef) ( LPCSTR, LPCSTR, PSID, PDWORD, LPSTR, LPDWORD, PSID_NAME_USE ); typedef BOOL (WINAPI *getFileSecurityADef) ( LPCSTR, SECURITY_INFORMATION, PSECURITY_DESCRIPTOR, DWORD, LPDWORD ); static setNamedSecurityInfoADef setNamedSecurityInfoProc; static getAceDef getAceProc; static addAceDef addAceProc; static equalSidDef equalSidProc; static addAccessDeniedAceDef addAccessDeniedAceProc; static initializeAclDef initializeAclProc; static getLengthSidDef getLengthSidProc; static getAclInformationDef getAclInformationProc; static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc; static lookupAccountNameADef lookupAccountNameProc; static getFileSecurityADef getFileSecurityProc; static int initialized = 0; if (!initialized) { TCL_DECLARE_MUTEX(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"); if (setNamedSecurityInfoProc && getAceProc && addAceProc && equalSidProc && addAccessDeniedAceProc && initializeAclProc && getLengthSidProc && getAclInformationProc && getSecurityDescriptorDaclProc && lookupAccountNameProc && getFileSecurityProc) 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, secDesc, secDescLen, &secDescLen2) || (secDescLen < secDescLen2)) { goto done; } } else { goto done; } } /* Get the "Everyone" SID */ userSid = (SID *) ckalloc(userSidLen); userDomain = (TCHAR *) ckalloc(userDomainLen); if (!lookupAccountNameProc(NULL, everyoneBuf, userSid, &userSidLen, userDomain, &userDomainLen, &userSidUse)) { if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) { ckfree((char *)userSid); userSid = (SID *) ckalloc(userSidLen); ckfree(userDomain); userDomain = (TCHAR *) ckalloc(userDomainLen); if (!lookupAccountNameProc(NULL, everyoneBuf, userSid, &userSidLen, userDomain, &userDomainLen, &userSidUse)) goto done; } else goto done; } /* If curAclPresent == false then curAcl and curAclDefaulted not valid */ if (!getSecurityDescriptorDaclProc(secDesc, &curAclPresent, &curAcl, &curAclDefaulted)) goto done; if (!curAclPresent || !curAcl) { ACLSize.AclBytesInUse = 0; ACLSize.AceCount = 0; } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize), AclSizeInformation)) goto done; /* Allocate memory for the new ACL */ newAclSize = ACLSize.AclBytesInUse + sizeof (ACCESS_DENIED_ACE) + getLengthSidProc(userSid) - sizeof (DWORD); newAcl = (ACL *) ckalloc (newAclSize); /* Initialize the new ACL */ if(!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) { goto done; } /* Add denied to make readonly, this will be known as a "read-only tag" */ if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION, readOnlyMask, userSid)) { goto done; } acl_readOnly_found = FALSE; for (j = 0; j < ACLSize.AceCount; j++) { PACL *pACE2; ACE_HEADER *phACE2; if (! getAceProc (curAcl, j, (LPVOID*) &pACE2)) { goto done; } phACE2 = ((ACE_HEADER *) pACE2); /* Do NOT propagate inherited ACEs */ if (phACE2->AceFlags & INHERITED_ACE) { continue; } /* Skip the "read-only tag" restriction (either added above, or it * is being removed) */ if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) { ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *)phACE2; if (pACEd->Mask == readOnlyMask && equalSidProc(userSid, (PSID)&(pACEd->SidStart))) { acl_readOnly_found = TRUE; continue; } } /* Copy the current ACE from the old to the new ACL */ if(! addAceProc (newAcl, ACL_REVISION, MAXDWORD, pACE2, ((PACE_HEADER) pACE2)->AceSize)) { goto done; } } /* Apply the new ACL */ if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc((LPSTR)nativePath, SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) == ERROR_SUCCESS ) { res = 0; } done: if (secDesc) ckfree(secDesc); if (newAcl) ckfree((char *)newAcl); if (userSid) ckfree((char *)userSid); if (userDomain) ckfree(userDomain); if (res != 0) return res; /* Run normal chmod command */ return chmod(nativePath, pmode); } /* *--------------------------------------------------------------------------- * * TestchmodCmd -- * * Implements the "testchmod" cmd. Used when testing "file" command. * The only attribute used by the Windows platform is the user write * flag; if this is not set, the file is made read-only. Otehrwise, the * file is made read-write. * * Results: * A standard Tcl result. * * Side effects: * Changes permissions of specified files. * *--------------------------------------------------------------------------- */ static int TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { int i, mode; char *rest; if (argc < 2) { usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " mode file ?file ...?", NULL); return TCL_ERROR; } mode = (int) strtol(argv[1], &rest, 8); if ((rest == argv[1]) || (*rest != '\0')) { goto usage; } for (i = 2; i < argc; i++) { Tcl_DString buffer; CONST char *translated; translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (TestplatformChmod(translated, (unsigned) mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); } return TCL_OK; }