Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/win/tclWinTest.c @ 35

Last change on this file since 35 was 25, checked in by landauf, 18 years ago

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