Tcl Source Code

Check-in [b65ecf6cb7]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge-integrate sebres-bug-9e6b569963-8-5-branch to 8.5
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA3-256: b65ecf6cb75f12687e0fe59ced41fdee7d1ec0c7f6ef13a0ce1d83e8a10a0eef
User & Date: sebres 2018-05-28 12:05:15
Context
2018-05-28
13:13
win: searching for FQDN in user-name should be utf-8 safe (user-name could contain non-ascii utf-8 c... check-in: 318c6b1966 user: sebres tags: core-8-5-branch
12:26
merge 8.5 (conflicts resolved, rewritten without winapi-stubs) check-in: a2b0c73364 user: sebres tags: core-8-6-branch
12:05
merge-integrate sebres-bug-9e6b569963-8-5-branch to 8.5 check-in: b65ecf6cb7 user: sebres tags: core-8-5-branch
2018-05-25
15:51
minor indentation fix (no functional changes) Closed-Leaf check-in: aafdcb52e3 user: sebres tags: sebres-bug-9e6b569963-8-5-branch
2018-05-24
20:20
fixed typo in winFCmd-12.6.2: unneeded extra-bracket removed check-in: 634425a216 user: sebres tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/fileSystem.test.

264
265
266
267
268
269
270






271
272
273
274
275
276
277
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} {
    list [catch {file normalize ~noonewiththisname} err] $err
} {1 {user "noonewiththisname" doesn't exist}}






test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar






>
>
>
>
>
>







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} {
    list [catch {file normalize ~noonewiththisname} err] $err
} {1 {user "noonewiththisname" doesn't exist}}
test filesystem-1.30.1 {normalisation of existing user} -body {
    catch {file normalize ~$::tcl_platform(user)}
} -result {0}
test filesystem-1.30.2 {normalisation of nonexistent user specified as [email protected]} -body {
    file normalize [email protected]
} -returnCodes error -result {user "[email protected]" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar

Changes to win/tclWinFile.c.

1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437

1438










1439
1440
1441
1442
1443
1444




1445
1446




1447
1448








1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
















1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472












1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    char *result;
    HINSTANCE netapiInst;
    HINSTANCE userenvInst;

    result = NULL;
    Tcl_DStringInit(bufferPtr);

    netapiInst = LoadLibraryA("netapi32.dll");
    userenvInst = LoadLibraryA("userenv.dll");
    if (netapiInst != NULL && userenvInst != NULL) {
	NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
	NETGETDCNAMEPROC *netGetDCNameProc;
	NETUSERGETINFOPROC *netUserGetInfoProc;
	GETPROFILESDIRECTORYPROC *getProfilesDirectoryProc;












	netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
		GetProcAddress(netapiInst, "NetApiBufferFree");
	netGetDCNameProc = (NETGETDCNAMEPROC *)
		GetProcAddress(netapiInst, "NetGetDCName");
	netUserGetInfoProc = (NETUSERGETINFOPROC *)
		GetProcAddress(netapiInst, "NetUserGetInfo");




	getProfilesDirectoryProc = (GETPROFILESDIRECTORYPROC *)
		GetProcAddress(userenvInst, "GetProfilesDirectoryW");




	if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
		&& (netApiBufferFreeProc != NULL) && (getProfilesDirectoryProc != NULL)) {








	    USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
	    Tcl_DString ds;
	    int nameLen, badDomain;
	    char *domain;
	    WCHAR *wName, *wHomeDir, *wDomain;
	    WCHAR buf[MAX_PATH];

	    badDomain = 0;
	    nameLen = -1;
	    wDomain = NULL;
	    domain = strchr(name, '@');
	    if (domain != NULL) {
















		Tcl_DStringInit(&ds);
		wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
		badDomain = (netGetDCNameProc)(NULL, wName,
			(LPBYTE *) &wDomain);
		Tcl_DStringFree(&ds);
		nameLen = domain - name;
	    }
	    if (badDomain == 0) {
		Tcl_DStringInit(&ds);
		wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
		if ((netUserGetInfoProc)(wDomain, wName, 1,
			(LPBYTE *) uiPtrPtr) == 0) {












		    DWORD i, size = MAX_PATH;
		    wHomeDir = uiPtr->usri1_home_dir;
		    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
			size = lstrlenW(wHomeDir);
			Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);
		    } else {
			/*
			 * User exists but has no home dir. Return
			 * "{GetProfilesDirectory}/<user>".
			 */
			getProfilesDirectoryProc(buf, &size);
			Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
			Tcl_DStringAppend(bufferPtr, "/", 1);
			Tcl_DStringAppend(bufferPtr, name, nameLen);
		    }
		    result = Tcl_DStringValue(bufferPtr);
		    /* be sure we returns normalized path */
		    for (i = 0; i < size; ++i){
			if (result[i] == '\\') result[i] = '/';
		    }
		    (*netApiBufferFreeProc)((void *) uiPtr);
		}
		Tcl_DStringFree(&ds);
	    }
	    if (wDomain != NULL) {
		(*netApiBufferFreeProc)((void *) wDomain);
	    }
	}
	FreeLibrary(userenvInst);
	FreeLibrary(netapiInst);
    }
    if (result == NULL) {
	/*
	 * Look in the "Password Lists" section of system.ini for the local
	 * user. There are also entries in that section that begin with a "*"
	 * character that are used by Windows for other purposes; ignore user
	 * names beginning with a "*".






<
<

<
<
<
<
<
<
|
|
|
|
>

>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
>
>
>
>
|
|
>
>
>
>
|
|
>
>
>
>
>
>
>
>
|
|
|
|
|
|

|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
<
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<







1418
1419
1420
1421
1422
1423
1424


1425






1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545



1546
1547
1548
1549
1550
1551
1552
char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    char *result;









    static NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
    static NETGETDCNAMEPROC *netGetDCNameProc;
    static NETUSERGETINFOPROC *netUserGetInfoProc;
    static GETPROFILESDIRECTORYPROC *getProfilesDirectoryProc;
    static int apistubs = 0;

    result = NULL;
    Tcl_DStringInit(bufferPtr);

    if (!apistubs) {
	HINSTANCE handle;
	TCL_DECLARE_MUTEX(initializeMutex)
	Tcl_MutexLock(&initializeMutex);
	if (!apistubs) {
	    handle = LoadLibraryA("netapi32.dll");
	    if (handle) {
		netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
			GetProcAddress(handle, "NetApiBufferFree");
		netGetDCNameProc = (NETGETDCNAMEPROC *)
			GetProcAddress(handle, "NetGetDCName");
		netUserGetInfoProc = (NETUSERGETINFOPROC *)
			GetProcAddress(handle, "NetUserGetInfo");
		Tcl_CreateExitHandler(TclpUnloadFile, handle);
	    }
	    handle = LoadLibraryA("userenv.dll");
	    if (handle) {
		getProfilesDirectoryProc = (GETPROFILESDIRECTORYPROC *)
			GetProcAddress(handle, "GetProfilesDirectoryW");
		Tcl_CreateExitHandler(TclpUnloadFile, handle);
	    }
	    
	    apistubs = -1;
	    if ( (netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
	      && (netApiBufferFreeProc != NULL) && (getProfilesDirectoryProc != NULL)
	    ) {
		apistubs = 1;
	    }
	}
	Tcl_MutexUnlock(&initializeMutex);
    }

    if (apistubs == 1) {
	USER_INFO_1 *uiPtr;
	Tcl_DString ds;
	int nameLen, rc;
	char *domain;
	WCHAR *wName, *wHomeDir, *wDomain;
	WCHAR buf[MAX_PATH];

	rc = 0;
	nameLen = -1;
	wDomain = NULL;
	domain = strchr(name, '@');
	if (domain == NULL) {
	    const char *ptr;
	    
	    /* no domain - firstly check it's the current user */
	    if ( (ptr = TclpGetUserName(&ds)) != NULL 
	      && strcasecmp(name, ptr) == 0
	    ) {
		/* try safest and fastest way to get current user home */
		ptr = TclGetEnv("HOME", &ds);
		if (ptr != NULL) {
		    Tcl_JoinPath(1, &ptr, bufferPtr);
		    rc = 1;
		    result = Tcl_DStringValue(bufferPtr);
		}
	    }
	    Tcl_DStringFree(&ds);
	} else {
	    Tcl_DStringInit(&ds);
	    wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
	    rc = (netGetDCNameProc)(NULL, wName, (LPBYTE *) &wDomain);

	    Tcl_DStringFree(&ds);
	    nameLen = domain - name;
	}
	if (rc == 0) {
	    Tcl_DStringInit(&ds);
	    wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	    while ((netUserGetInfoProc)(wDomain, wName, 1,
		    (LPBYTE *) &uiPtr) != 0) {
		/* 
		 * user does not exists - if domain was not specified,
		 * try again using current domain.
		 */
		rc = 1;
		if (domain != NULL) break;
		/* get current domain */
		rc = (netGetDCNameProc)(NULL, NULL, (LPBYTE *) &wDomain);
		if (rc != 0) break;
		domain = INT2PTR(-1); /* repeat once */
	    }
	    if (rc == 0) {
		DWORD i, size = MAX_PATH;
		wHomeDir = uiPtr->usri1_home_dir;
		if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
		    size = lstrlenW(wHomeDir);
		    Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);
		} else {
		    /*
		     * User exists but has no home dir. Return
		     * "{GetProfilesDirectory}/<user>".
		     */
		    getProfilesDirectoryProc(buf, &size);
		    Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
		    Tcl_DStringAppend(bufferPtr, "/", 1);
		    Tcl_DStringAppend(bufferPtr, name, nameLen);
		}
		result = Tcl_DStringValue(bufferPtr);
		/* be sure we returns normalized path */
		for (i = 0; i < size; ++i){
		    if (result[i] == '\\') result[i] = '/';
		}
		(*netApiBufferFreeProc)((void *) uiPtr);
	    }
	    Tcl_DStringFree(&ds);
	}
	if (wDomain != NULL) {
	    (*netApiBufferFreeProc)((void *) wDomain);
	}



    }
    if (result == NULL) {
	/*
	 * Look in the "Password Lists" section of system.ini for the local
	 * user. There are also entries in that section that begin with a "*"
	 * character that are used by Windows for other purposes; ignore user
	 * names beginning with a "*".

Changes to win/tclWinInit.c.

527
528
529
530
531
532
533





















534
535
536
537
538
539
540
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
...
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
{
    Tcl_DStringInit(bufPtr);
    Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
    wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
    Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    return Tcl_DStringValue(bufPtr);
}





















 
/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
 *	Performs platform-specific interpreter initialization related to the
................................................................................
    union {
	SYSTEM_INFO info;
	OemId oemId;
    } sys;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    Tcl_DString ds;
    WCHAR szUserName[UNLEN+1];
    DWORD cchUserNameLen = UNLEN;

    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
	int(__stdcall *getversion)(void *) =
................................................................................

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.
     */

    Tcl_DStringInit(&ds);
    if (TclGetEnv("USERNAME", &ds) == NULL) {
	if (tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen) != 0) {
	    int cbUserNameLen = cchUserNameLen - 1;
	    if (tclWinProcs->useWide) cbUserNameLen *= sizeof(WCHAR);
	    Tcl_WinTCharToUtf((LPTSTR)szUserName, cbUserNameLen, &ds);
	}
    }
    Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);
}
 
/*
 *----------------------------------------------------------------------
 *






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<







 







|
<
<
<
<
<
<
<
|







527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
...
579
580
581
582
583
584
585


586
587
588
589
590
591
592
...
656
657
658
659
660
661
662
663







664
665
666
667
668
669
670
671
{
    Tcl_DStringInit(bufPtr);
    Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
    wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
    Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    return Tcl_DStringValue(bufPtr);
}
 
const char *
TclpGetUserName(
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * the name of user. */
{
    Tcl_DStringInit(bufferPtr);

    if (TclGetEnv("USERNAME", bufferPtr) == NULL) {
	WCHAR szUserName[UNLEN+1];
	DWORD cchUserNameLen = UNLEN;

	if (!tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen)) {
	    return NULL;
	}
	cchUserNameLen--;
	if (tclWinProcs->useWide) cchUserNameLen *= sizeof(WCHAR);
	Tcl_WinTCharToUtf((LPTSTR)szUserName, cchUserNameLen, bufferPtr);
    }
    return Tcl_DStringValue(bufferPtr);
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
 *	Performs platform-specific interpreter initialization related to the
................................................................................
    union {
	SYSTEM_INFO info;
	OemId oemId;
    } sys;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    Tcl_DString ds;



    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
	int(__stdcall *getversion)(void *) =
................................................................................

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.
     */

    ptr = TclpGetUserName(&ds);







    Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "",
	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to win/tclWinInt.h.

196
197
198
199
200
201
202


203
204
205
206
207
208
209
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
MODULE_SCOPE void	TclWinFreeAllocCache(void);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
#endif /* TCL_THREADS */



/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif

#endif	/* _TCLWININT */






>
>







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
MODULE_SCOPE void	TclWinFreeAllocCache(void);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
#endif /* TCL_THREADS */

MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);

/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif

#endif	/* _TCLWININT */