diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-05-23 13:48:02 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-05-23 13:48:02 (GMT) |
commit | 4f971c68105bdff8520eb0e930f69dca5120b2e1 (patch) | |
tree | de6ed60344bd267fb502645508bd5c094d4b782f | |
parent | d707e1395bbbeba874f52e6aa30c013b12e88eaa (diff) | |
parent | bfca9ca68773d9a3dbc609448891363b52107ef9 (diff) | |
download | tcl-4f971c68105bdff8520eb0e930f69dca5120b2e1.zip tcl-4f971c68105bdff8520eb0e930f69dca5120b2e1.tar.gz tcl-4f971c68105bdff8520eb0e930f69dca5120b2e1.tar.bz2 |
Fix [3fc3287497]: TclGetProcessGlobalValue encodes information twice on Windows
-rw-r--r-- | generic/tclIO.c | 2 | ||||
-rw-r--r-- | generic/tclIORChan.c | 2 | ||||
-rw-r--r-- | generic/tclUtil.c | 16 | ||||
-rw-r--r-- | tests/oo.test | 2 | ||||
-rw-r--r-- | win/tclWinSock.c | 25 |
5 files changed, 26 insertions, 21 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index 55f3642..b800171 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2965,7 +2965,7 @@ FreeChannelState( ReleaseChannelBuffer(statePtr->curOutPtr); } DiscardOutputQueued(statePtr); - + DeleteTimerHandler(statePtr); if (statePtr->chanMsg) { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index f2bb186..dfc6dac 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -2216,7 +2216,7 @@ CleanRefChannelInstance( ReflectedChannel *rcPtr) { if (rcPtr->name) { - /* + /* * Reset obj-type (channel is deleted or dead anyway) to avoid leakage * by cyclic references (see bug [79474c58800cdf94]). */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9cf594f..0c2f305 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4212,6 +4212,7 @@ TclSetProcessGlobalValue( Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int dummy; + Tcl_DString ds; Tcl_MutexLock(&pgvPtr->mutex); @@ -4226,8 +4227,11 @@ TclSetProcessGlobalValue( Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr); } bytes = TclGetStringFromObj(newValue, &pgvPtr->numBytes); + Tcl_UtfToExternalDString(encoding, bytes, pgvPtr->numBytes, &ds); + pgvPtr->numBytes = Tcl_DStringLength(&ds); pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1); - memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); + memcpy(pgvPtr->value, Tcl_DStringValue(&ds), pgvPtr->numBytes + 1); + Tcl_DStringFree(&ds); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } @@ -4269,6 +4273,7 @@ TclGetProcessGlobalValue( Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int epoch = pgvPtr->epoch; + Tcl_DString newValue; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4280,7 +4285,7 @@ TclGetProcessGlobalValue( * system encoding. */ - Tcl_DString native, newValue; + Tcl_DString native; Tcl_MutexLock(&pgvPtr->mutex); epoch = ++pgvPtr->epoch; @@ -4330,10 +4335,13 @@ TclGetProcessGlobalValue( } /* - * Store a copy of the shared value in our epoch-indexed cache. + * Store a copy of the shared value (but then in utf-8) + * in our epoch-indexed cache. */ - value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); + Tcl_ExternalToUtfDString(NULL, pgvPtr->value, pgvPtr->numBytes, &newValue); + value = Tcl_NewStringObj(Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue)); + Tcl_DStringFree(&newValue); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); diff --git a/tests/oo.test b/tests/oo.test index 366f4d3..2662ed1 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -3311,7 +3311,7 @@ oo::class create WorkerSupport { return [uplevel 1 $script] } finally { foreach worker $workers {$worker destroy} - } + } } method run {nworkers} { set result {} diff --git a/win/tclWinSock.c b/win/tclWinSock.c index df81c46..e077186 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -367,11 +367,14 @@ InitializeHostName( if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { /* - * Convert string from native to UTF then change to lowercase. + * Convert string from WCHAR to utf-8, then change to lowercase, + * then to system encoding. */ + Tcl_DString inDs; - Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &ds)); - + Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &inDs)); + Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&inDs), -1, &ds); + Tcl_DStringFree(&inDs); } else { Tcl_DStringInit(&ds); if (TclpHasSockets(NULL) == TCL_OK) { @@ -380,20 +383,14 @@ InitializeHostName( * documents gethostname() as being always adequate. */ - Tcl_DString inDs; - - Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 256); - if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), - -1, &ds); - } - Tcl_DStringFree(&inDs); + Tcl_DStringInit(&ds); + Tcl_DStringSetLength(&ds, 256); + gethostname(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringSetLength(&ds, strlen(Tcl_DStringValue(&ds))); } } - *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); + *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = Tcl_DStringLength(&ds); *valuePtr = (char *)ckalloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); |