Tcl Source Code

Changes On Branch bug-7a9dc52b29
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch bug-7a9dc52b29 Excluding Merge-Ins

This is equivalent to a diff from 38bd0e8890 to fba9c8383c

2018-11-22
12:48
fixes segfault [7a9dc52b29] and wrong normalization (inside TclJoinPath) for pure relative path-segm... check-in: bcee71a177 user: sebres tags: core-8-5-branch
12:45
prepare merge: TclJoinPath is in internal API (MODULE_SCOPE) since 8.6 and static (used locally in t... Closed-Leaf check-in: fba9c8383c user: sebres tags: bug-7a9dc52b29
2018-11-21
10:00
win: repair test command "testchmod": correct load module (ADVAPI32 for x86/x64) and fix readonly ma... check-in: a4746b4c9f user: sebres tags: bug-7a9dc52b29
2018-11-20
18:02
fixes segfault [7a9dc52b29]: unexpected decrement of the ref-count after TclJoinPath check-in: 10e9bd8b12 user: sebres tags: bug-7a9dc52b29
2018-11-15
16:34
merge 8.5 check-in: c6102118fb user: dgp tags: core-8-6-branch
2018-11-12
09:26
Fix brokenness in GNUmakefile check-in: 38bd0e8890 user: dkf tags: core-8-5-branch
2018-11-11
16:55
Fix builds on Travis. check-in: bdc17c4308 user: dkf tags: core-8-5-branch

Changes to generic/tclPathObj.c.

25
26
27
28
29
30
31



32
33
34
35
36
37
38
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);




/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static Tcl_ObjType tclFsPathType = {







>
>
>







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
static Tcl_Obj *	TclJoinPath(int elements, Tcl_Obj * const objv[],
			    int forceRelative);


/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static Tcl_ObjType tclFsPathType = {
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851


852
853
854
855
856
857
858
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);

Tcl_Obj *
Tcl_FSJoinPath(
    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
				 * reference count. */
    int elements)		/* Number of elements to use (-1 = all) */
{
    Tcl_Obj *copy, *res;
    int objc;
    Tcl_Obj **objv;

    if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
	return NULL;
    }

    elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
    copy = TclListObjCopy(NULL, listObj);
    Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
    res = TclJoinPath(elements, objv);
    Tcl_DecrRefCount(copy);
    return res;
}

Tcl_Obj *
TclJoinPath(
    int elements,
    Tcl_Obj * const objv[])


{
    Tcl_Obj *res = NULL;	/* Resulting path object (container of join) */
    Tcl_Obj *elt;		/* Path part (result if returns part of path) */
    int i;
    Tcl_Filesystem *fsPtr = NULL;

    for (i = 0; i < elements; i++) {







<
<






|








<

|
<



|

|
|
>
>







820
821
822
823
824
825
826


827
828
829
830
831
832
833
834
835
836
837
838
839
840
841

842
843

844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */



Tcl_Obj *
Tcl_FSJoinPath(
    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
				 * reference count. */
    int elements)		/* Number of elements to use (-1 = all) */
{
    Tcl_Obj *res;
    int objc;
    Tcl_Obj **objv;

    if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
	return NULL;
    }

    elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;

    Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
    res = TclJoinPath(elements, objv, 0);

    return res;
}

static Tcl_Obj *
TclJoinPath(
    int elements,		/* Number of elements to use (-1 = all) */
    Tcl_Obj * const objv[],	/* Path elements to join */
    int forceRelative)		/* If non-zero, assume all more paths are
				 * relative (e. g. simple normalization) */
{
    Tcl_Obj *res = NULL;	/* Resulting path object (container of join) */
    Tcl_Obj *elt;		/* Path part (result if returns part of path) */
    int i;
    Tcl_Filesystem *fsPtr = NULL;

    for (i = 0; i < elements; i++) {
871
872
873
874
875
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
891
	 * use the special case when we have exactly two elements, but we
	 * could expand that in the future.
         *
         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
         * to be an absolute path. Added a check for that elt is absolute.
	 */

	if ((i == (elements-2)) && (i == 0)
                && (elt->typePtr == &tclFsPathType)
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[i+1];


	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		int len;

		str = Tcl_GetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*







|




|
>
|







872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
	 * use the special case when we have exactly two elements, but we
	 * could expand that in the future.
         *
         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
         * to be an absolute path. Added a check for that elt is absolute.
	 */

	if ((i == 0) && (elements == 2)
                && (elt->typePtr == &tclFsPathType)
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[i+1];
	    /* if forceRelative - second path is relative */
	    type = forceRelative ? TCL_PATH_RELATIVE :
		    TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		int len;

		str = Tcl_GetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
949
950
951
952
953
954
955


956
957
958
959
960
961
962
963
			goto partReturn; /* return elt; */
		    }
		}
	    }
	}
	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;


	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
	     */

	    if (res != NULL) {
		TclDecrRefCount(res);







>
>
|







951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
			goto partReturn; /* return elt; */
		    }
		}
	    }
	}
	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;
	/* if forceRelative - all paths excepting first one are relative */
	type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
		TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
	     */

	    if (res != NULL) {
		TclDecrRefCount(res);
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425

2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463






2464
2465
2466
2467
2468
2469
2470

2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486

    name = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	char *expandedUser;
	Tcl_DString temp;
	int split;
	char separator = '/';

	split = FindSplitPos(name, separator);
	if (split != len) {
	    /*
	     * We have multiple pieces '~user/foo/bar...'

	     */

	    name[split] = '\0';
	}

	/*
	 * Do some tilde substitution.
	 */

	if (name[1] == '\0') {
	    /*
	     * We have just '~'
	     */

	    const char *dir;
	    Tcl_DString dirString;

	    if (split != len) {
		name[split] = separator;
	    }

	    dir = TclGetEnv("HOME", &dirString);
	    if (dir == NULL) {
		if (interp) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "couldn't find HOME environment "
			    "variable to expand path", NULL);
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringInit(&temp);
	    Tcl_JoinPath(1, &dir, &temp);
	    Tcl_DStringFree(&dirString);
	} else {
	    /*
	     * We have a user name '~user'
	     */







	    Tcl_DStringInit(&temp);
	    if (TclpGetUserHome(name+1, &temp) == NULL) {
		if (interp != NULL) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "user \"", name+1,
			    "\" doesn't exist", NULL);
		}

		Tcl_DStringFree(&temp);
		if (split != len) {
		    name[split] = separator;
		}
		return TCL_ERROR;
	    }
	    if (split != len) {
		name[split] = separator;
	    }
	}

	expandedUser = Tcl_DStringValue(&temp);
	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));

	if (split != len) {
	    /*







|





<
<
|
|
>
|
|
<
<





|

|





<
<
<
<

















>
>
>
>
>
>

|


|


>

<
<
<


<
|
<







2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425


2426
2427
2428
2429
2430


2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443




2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475



2476
2477

2478

2479
2480
2481
2482
2483
2484
2485

    name = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (len && name[0] == '~') {
	char *expandedUser;
	Tcl_DString temp;
	int split;
	char separator = '/';



	/*
	 * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
	 * split becomes value 1 for '~/...' as well as for '~'.
	 */
	split = FindSplitPos(name, separator);



	/*
	 * Do some tilde substitution.
	 */

	if (split == 1) {
	    /*
	     * We have just '~' (or '~/...')
	     */

	    const char *dir;
	    Tcl_DString dirString;





	    dir = TclGetEnv("HOME", &dirString);
	    if (dir == NULL) {
		if (interp) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "couldn't find HOME environment "
			    "variable to expand path", NULL);
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringInit(&temp);
	    Tcl_JoinPath(1, &dir, &temp);
	    Tcl_DStringFree(&dirString);
	} else {
	    /*
	     * We have a user name '~user'
	     */

	    Tcl_DString userName;

	    Tcl_DStringInit(&userName);
	    Tcl_DStringAppend(&userName, name+1, split-1);
	    expandedUser = Tcl_DStringValue(&userName);

	    Tcl_DStringInit(&temp);
	    if (TclpGetUserHome(expandedUser, &temp) == NULL) {
		if (interp != NULL) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "user \"", expandedUser,
			    "\" doesn't exist", NULL);
		}
		Tcl_DStringFree(&userName);
		Tcl_DStringFree(&temp);



		return TCL_ERROR;
	    }

	    Tcl_DStringFree(&userName);

	}

	expandedUser = Tcl_DStringValue(&temp);
	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));

	if (split != len) {
	    /*
2510
2511
2512
2513
2514
2515
2516
2517

2518


2519

2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
		}
		TclDecrRefCount(parts);
	    } else {
		Tcl_Obj *pair[2];

		pair[0] = transPtr;
		pair[1] = Tcl_NewStringObj(name+split+1, -1);
		transPtr = TclJoinPath(2, pair);

		TclDecrRefCount(pair[0]);


		TclDecrRefCount(pair[1]);

	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = TclJoinPath(1, &pathPtr);
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */








|
>
|
>
>
|
>




|







2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
		}
		TclDecrRefCount(parts);
	    } else {
		Tcl_Obj *pair[2];

		pair[0] = transPtr;
		pair[1] = Tcl_NewStringObj(name+split+1, -1);
		transPtr = TclJoinPath(2, pair, 1);
		if (transPtr != pair[0]) {
		    TclDecrRefCount(pair[0]);
		}
		if (transPtr != pair[1]) {
		    TclDecrRefCount(pair[1]);
		}
	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = TclJoinPath(1, &pathPtr, 1);
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

Changes to tests/cmdAH.test.

537
538
539
540
541
542
543







544
545
546
547
548
549
550
    testsetplatform windows
    file tail {c:/foo\bar}
} bar
test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform windows
    file tail {foo\bar}
} bar








# rootname

test cmdAH-10.1 {Tcl_FileObjCmd: rootname} testsetplatform {
    testsetplatform unix
    list [catch {file rootname a b} msg] $msg
} {1 {wrong # args: should be "file rootname name"}}







>
>
>
>
>
>
>







537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
    testsetplatform windows
    file tail {c:/foo\bar}
} bar
test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform windows
    file tail {foo\bar}
} bar
test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} {
    list \
	[file tail {~/~foo}] \
	[file tail {~/test/~foo}] \
	[file tail [file normalize {~/~foo}]] \
	[file tail [file normalize {~/test/~foo}]]
} [lrepeat 4 ./~foo]

# rootname

test cmdAH-10.1 {Tcl_FileObjCmd: rootname} testsetplatform {
    testsetplatform unix
    list [catch {file rootname a b} msg] $msg
} {1 {wrong # args: should be "file rootname name"}}

Changes to tests/winFile.test.

56
57
58
59
60
61
62

63
64
65
66
67
68

69
70
71
72
73
74
75
76
} {0}
test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob ~stanton@workgroup}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
    makeFile {} GlobCapS

    set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]
    removeFile GlobCapS
    set result
} {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
    makeFile {} globlower

    set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]
    removeFile globlower
    set result
} {globlower globlower}

test winFile-3.1 {file system} {win testvolumetype} {
    set res "volume types ok"
    foreach vol [file volumes] {







>
|





>
|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
} {0}
test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob ~stanton@workgroup}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
    makeFile {} GlobCapS
    set args [list -nocomplain -tails -directory [temporaryDirectory]]
    set result [list [glob {*}$args GlobC*] [glob {*}$args globc*]]
    removeFile GlobCapS
    set result
} {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
    makeFile {} globlower
    set args [list -nocomplain -tails -directory [temporaryDirectory]]
    set result [list [glob {*}$args globl*] [glob {*}$args gLOBl*]]
    removeFile globlower
    set result
} {globlower globlower}

test winFile-3.1 {file system} {win testvolumetype} {
    set res "volume types ok"
    foreach vol [file volumes] {

Changes to tests/winPipe.test.

13
14
15
16
17
18
19

20
21



22
23
24
25
26
27
28
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest
namespace import -force ::tcltest::*
unset -nocomplain path



set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]




testConstraint exec         [llength [info commands exec]]
testConstraint testexcept   [llength [info commands testexcept]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]








>
|

>
>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest
namespace import -force ::tcltest::*
unset -nocomplain path


set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint testexcept   [llength [info commands testexcept]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]

596
597
598
599
600
601
602


603
    unset env(TEMP)
}

# cleanup
file delete big little stdout stderr nothing echoArgs.tcl echoArgs.bat 
file delete -force [file join [temporaryDirectory] test(Dir)Check]
::tcltest::cleanupTests


return







>
>

600
601
602
603
604
605
606
607
608
609
    unset env(TEMP)
}

# cleanup
file delete big little stdout stderr nothing echoArgs.tcl echoArgs.bat 
file delete -force [file join [temporaryDirectory] test(Dir)Check]
::tcltest::cleanupTests
# back to original directory:
cd $org_pwd; unset org_pwd
return

Changes to win/tclWinTest.c.

416
417
418
419
420
421
422

423
424
425

426
427
428
429
430
431
432
    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 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;


    /*
     * References to security functions (only available on NT and later).
     */

    static getSidLengthRequiredDef getSidLengthRequiredProc;
    static initializeSidDef initializeSidProc;







>


|
>







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
    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 const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
	    | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
    /* don't deny DELETE mask (reset writable only, allow test-cases cleanup) */
    static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
	    | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
	    | FILE_WRITE_DATA
	    /* | DELETE */;

    /*
     * References to security functions (only available on NT and later).
     */

    static getSidLengthRequiredDef getSidLengthRequiredProc;
    static initializeSidDef initializeSidProc;
462
463
464
465
466
467
468
469



470
471
472
473
474
475
476
     * One time initialization, dynamically load Windows NT features
     */

    if (!initialized) {
	TCL_DECLARE_MUTEX(initializeMutex)
	Tcl_MutexLock(&initializeMutex);
	if (!initialized) {
	    HMODULE handle = GetModuleHandle(TEXT("ADVAPI"));




	    if (handle != NULL) {
		setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
			GetProcAddress(handle, "SetNamedSecurityInfoA");
		getFileSecurityProc = (getFileSecurityADef)
			GetProcAddress(handle, "GetFileSecurityA");
		getAceProc = (getAceDef)







|
>
>
>







464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
     * One time initialization, dynamically load Windows NT features
     */

    if (!initialized) {
	TCL_DECLARE_MUTEX(initializeMutex)
	Tcl_MutexLock(&initializeMutex);
	if (!initialized) {
	    HMODULE handle = GetModuleHandle(TEXT("ADVAPI32"));
	    if (handle == NULL) {
	    	handle = GetModuleHandle(TEXT("ADVAPI"));
	    }

	    if (handle != NULL) {
		setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
			GetProcAddress(handle, "SetNamedSecurityInfoA");
		getFileSecurityProc = (getFileSecurityADef)
			GetProcAddress(handle, "GetFileSecurityA");
		getAceProc = (getAceDef)
657
658
659
660
661
662
663
664

665
666
667
668

669
670
671
672
673
674
675
	if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)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((char *) secDesc);







|
>



|
>







662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
	if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2,
		((PACE_HEADER) pACE2)->AceSize)) {
	    goto done;
	}
    }

    /*
     * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
     * to remove inherited ACL (we need to overwrite the default ACL's in this case)
     */

    if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
	    (LPSTR) nativePath, SE_FILE_OBJECT, 
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	ckfree((char *) secDesc);