summaryrefslogtreecommitdiffstats
path: root/generic/tclEnv.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclEnv.c')
-rw-r--r--generic/tclEnv.c161
1 files changed, 106 insertions, 55 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 49238a2..cd1a954 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -11,8 +11,6 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclEnv.c,v 1.37 2007/12/13 15:23:16 dgp Exp $
*/
#include "tclInt.h"
@@ -45,8 +43,10 @@ static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
static void ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void TclUnsetEnv(const char *name);
-#if defined(__CYGWIN__) && defined(__WIN32__)
-static void TclCygwinPutenv(const char *string);
+
+#if defined(__CYGWIN__)
+ static void TclCygwinPutenv(char *string);
+# define putenv TclCygwinPutenv
#endif
/*
@@ -76,54 +76,104 @@ TclSetupEnv(
Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *varNamePtr;
Tcl_DString envString;
- char *p1, *p2;
- int i;
+ Tcl_HashTable namesHash;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
/*
* Synchronize the values in the environ array with the contents of the
* Tcl "env" variable. To do this:
- * 1) Remove the trace that fires when the "env" var is unset.
- * 2) Unset the "env" variable.
- * 3) If there are no environ variables, create an empty "env" array.
- * Otherwise populate the array with current values.
- * 4) Add a trace that synchronizes the "env" array.
+ * 1) Remove the trace that fires when the "env" var is updated.
+ * 2) Find the existing contents of the "env", storing in a hash table.
+ * 3) Create/update elements for each environ variable, removing
+ * elements from the hash table as we go.
+ * 4) Remove the elements for each remaining entry in the hash table,
+ * which must have existed before yet have no analog in the environ
+ * variable.
+ * 5) Add a trace that synchronizes the "env" array.
*/
Tcl_UntraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
- Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
+ /*
+ * Find out what elements are currently in the global env array.
+ */
- if (environ[0] == NULL) {
- Tcl_Obj *varNamePtr;
+ TclNewLiteralStringObj(varNamePtr, "env");
+ Tcl_IncrRefCount(varNamePtr);
+ Tcl_InitObjHashTable(&namesHash);
+ varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ TclFindArrayPtrElements(varPtr, &namesHash);
+
+ /*
+ * Go through the environment array and transfer its values into Tcl. At
+ * the same time, remove those elements we add/update from the hash table
+ * of existing elements, so that after this part processes, that table
+ * will hold just the parts to remove.
+ */
+
+ if (environ[0] != NULL) {
+ int i;
- TclNewLiteralStringObj(varNamePtr, "env");
- Tcl_IncrRefCount(varNamePtr);
- TclArraySet(interp, varNamePtr, NULL);
- Tcl_DecrRefCount(varNamePtr);
- } else {
Tcl_MutexLock(&envMutex);
for (i = 0; environ[i] != NULL; i++) {
+ Tcl_Obj *obj1, *obj2;
+ char *p1, *p2;
+
p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
p2 = strchr(p1, '=');
if (p2 == NULL) {
/*
* This condition seem to happen occasionally under some
- * versions of Solaris; ignore the entry.
+ * versions of Solaris, or when encoding accidents swallow the
+ * '='; ignore the entry.
*/
continue;
}
p2++;
p2[-1] = '\0';
- Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
+ obj1 = Tcl_NewStringObj(p1, -1);
+ obj2 = Tcl_NewStringObj(p2, -1);
Tcl_DStringFree(&envString);
+
+ Tcl_IncrRefCount(obj1);
+ Tcl_IncrRefCount(obj2);
+ Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
+ hPtr = Tcl_FindHashEntry(&namesHash, obj1);
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DecrRefCount(obj1);
+ Tcl_DecrRefCount(obj2);
}
Tcl_MutexUnlock(&envMutex);
}
+ /*
+ * Delete those elements that existed in the array but which had no
+ * counterparts in the environment array.
+ */
+
+ for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
+ hPtr=Tcl_NextHashEntry(&search)) {
+ Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
+
+ TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
+ }
+ Tcl_DeleteHashTable(&namesHash);
+ Tcl_DecrRefCount(varNamePtr);
+
+ /*
+ * Re-establish the trace.
+ */
+
Tcl_TraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
@@ -157,7 +207,8 @@ TclSetEnv(
const char *value) /* New value for variable (UTF-8). */
{
Tcl_DString envString;
- int index, length, nameLength;
+ unsigned nameLength, valueLength;
+ int index, length;
char *p, *oldValue;
const char *p2;
@@ -179,12 +230,11 @@ TclSetEnv(
*/
if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
- char **newEnviron = (char **)
- ckalloc(((unsigned) length + 5) * sizeof(char *));
+ char **newEnviron = ckalloc((length + 5) * sizeof(char *));
memcpy(newEnviron, environ, length * sizeof(char *));
if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
- ckfree((char *) env.ourEnviron);
+ ckfree(env.ourEnviron);
}
environ = env.ourEnviron = newEnviron;
env.ourEnvironSize = length + 5;
@@ -214,7 +264,7 @@ TclSetEnv(
Tcl_DStringFree(&envString);
oldValue = environ[index];
- nameLength = length;
+ nameLength = (unsigned) length;
}
/*
@@ -223,18 +273,19 @@ TclSetEnv(
* and set the environ array value.
*/
- p = ckalloc((unsigned) nameLength + strlen(value) + 2);
- strcpy(p, name);
+ valueLength = strlen(value);
+ p = ckalloc(nameLength + valueLength + 2);
+ memcpy(p, name, nameLength);
p[nameLength] = '=';
- strcpy(p+nameLength+1, value);
+ memcpy(p+nameLength+1, value, valueLength+1);
p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
/*
* Copy the native string to heap memory.
*/
- p = ckrealloc(p, strlen(p2) + 1);
- strcpy(p, p2);
+ p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
+ memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
@@ -393,20 +444,21 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
-#ifdef WIN32
- string = ckalloc((unsigned) length+2);
+#if defined(_WIN32) || defined(__CYGWIN__)
+ string = ckalloc(length + 2);
memcpy(string, name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
#else
- string = ckalloc((unsigned) length+1);
+ string = ckalloc(length + 1);
memcpy(string, name, (size_t) length);
string[length] = '\0';
-#endif /* WIN32 */
+#endif /* _WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
- string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
- strcpy(string, Tcl_DStringValue(&envString));
+ string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
+ memcpy(string, Tcl_DStringValue(&envString),
+ (unsigned) Tcl_DStringLength(&envString)+1);
Tcl_DStringFree(&envString);
putenv(string);
@@ -562,7 +614,8 @@ EnvTraceProc(
const char *value = TclGetEnv(name2, &valueString);
if (value == NULL) {
- return "no such variable";
+ Tcl_UnsetVar2(interp, name1, name2, 0);
+ return NULL;
}
Tcl_SetVar2(interp, name1, name2, value, 0);
Tcl_DStringFree(&valueString);
@@ -639,11 +692,11 @@ ReplaceString(
const int growth = 5;
- env.cache = (char **) ckrealloc((char *) env.cache,
+ env.cache = ckrealloc(env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
- (void) memset(env.cache+env.cacheSize+1, (int) 0,
- (size_t) (growth-1) * sizeof(char*));
+ (void) memset(env.cache+env.cacheSize+1, 0,
+ (size_t) (growth-1) * sizeof(char *));
env.cacheSize += growth;
}
}
@@ -678,7 +731,7 @@ TclFinalizeEnvironment(void)
*/
if (env.cache) {
- ckfree((char *) env.cache);
+ ckfree(env.cache);
env.cache = NULL;
env.cacheSize = 0;
#ifndef USE_PUTENV
@@ -687,9 +740,7 @@ TclFinalizeEnvironment(void)
}
}
-#if defined(__CYGWIN__) && defined(__WIN32__)
-
-#include <windows.h>
+#if defined(__CYGWIN__)
/*
* When using cygwin, when an environment variable changes, we need to synch
@@ -697,10 +748,11 @@ TclFinalizeEnvironment(void)
* fork) and the Windows environment (in case the application TCL code calls
* exec, which calls the Windows CreateProcess function).
*/
+DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
static void
TclCygwinPutenv(
- const char *str)
+ char *str)
{
char *name, *value;
@@ -718,8 +770,7 @@ TclCygwinPutenv(
/* Can't happen. */
return;
}
- *value = '\0';
- ++value;
+ *(value++) = '\0';
if (*value == '\0') {
value = NULL;
}
@@ -751,11 +802,11 @@ TclCygwinPutenv(
*/
if (strcmp(name, "Path") == 0) {
- SetEnvironmentVariable("PATH", NULL);
+ SetEnvironmentVariableA("PATH", NULL);
unsetenv("PATH");
}
- SetEnvironmentVariable(name, value);
+ SetEnvironmentVariableA(name, value);
} else {
char *buf;
@@ -763,7 +814,7 @@ TclCygwinPutenv(
* Eliminate any Path variable, to prevent any confusion.
*/
- SetEnvironmentVariable("Path", NULL);
+ SetEnvironmentVariableA("Path", NULL);
unsetenv("Path");
if (value == NULL) {
@@ -771,15 +822,15 @@ TclCygwinPutenv(
} else {
int size;
- size = cygwin_posix_to_win32_path_list_buf_size(value);
+ size = cygwin_conv_path_list(0, value, NULL, 0);
buf = alloca(size + 1);
- cygwin_posix_to_win32_path_list(value, buf);
+ cygwin_conv_path_list(0, value, buf, size);
}
- SetEnvironmentVariable(name, buf);
+ SetEnvironmentVariableA(name, buf);
}
}
-#endif /* __CYGWIN__ && __WIN32__ */
+#endif /* __CYGWIN__ */
/*
* Local Variables:
generated by cgit v0.12 at 2025-10-21 21:11:44 (GMT)