summaryrefslogtreecommitdiffstats
path: root/generic/tclEnv.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclEnv.c')
-rw-r--r--generic/tclEnv.c314
1 files changed, 86 insertions, 228 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index ef5cfb7..caa80f1 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -6,8 +6,8 @@
* is primarily responsible for keeping the "env" arrays in sync with the
* system environment variables.
*
- * Copyright © 1991-1994 The Regents of the University of California.
- * Copyright © 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,40 +17,16 @@
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
-#if defined(_WIN32)
-# define tenviron _wenviron
-# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
- (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr)))
-# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
- (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr)))
-# define techar WCHAR
-# ifdef USE_PUTENV
-# define putenv(env) _wputenv((const wchar_t *)env)
-# endif
-#else
-# define tenviron environ
-# define tenviron2utfdstr(str, dsPtr) \
- Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr)
-# define utf2tenvirondstr(str, dsPtr) \
- Tcl_UtfToExternalDString(NULL, str, -1, dsPtr)
-# define techar char
-#endif
-
-
-/* MODULE_SCOPE */
-size_t TclEnvEpoch = 0; /* Epoch of the tcl environment
- * (if changed with tcl-env). */
-
static struct {
- Tcl_Size cacheSize; /* Number of env strings in cache. */
+ int cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
- techar **ourEnviron; /* Cache of the array that we allocate. We
+ char **ourEnviron; /* Cache of the array that we allocate. We
* need to track this in case another
* subsystem swaps around the environ array
* like we do. */
- Tcl_Size ourEnvironSize; /* Non-zero means that the environ array was
+ int ourEnvironSize; /* Non-zero means that the environ array was
* malloced and has this many total entries
* allocated to it (not all may be in use at
* once). Zero means that the environment
@@ -58,13 +34,11 @@ static struct {
#endif
} env;
-#define tNTL sizeof(techar)
-
/*
* Declarations for local functions defined in this file:
*/
-static char * EnvTraceProc(void *clientData, Tcl_Interp *interp,
+static char * EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags);
static void ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void TclSetEnv(const char *name, const char *value);
@@ -97,74 +71,38 @@ TclSetupEnv(
Tcl_Interp *interp) /* Interpreter whose "env" array is to be
* managed. */
{
- Var *varPtr, *arrayPtr;
- Tcl_Obj *varNamePtr;
Tcl_DString envString;
- Tcl_HashTable namesHash;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
+ char *p1, *p2;
+ int i;
/*
* 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 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.
+ * 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.
*/
Tcl_UntraceVar2(interp, "env", NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
- /*
- * Find out what elements are currently in the global env array.
- */
-
- 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);
-
-#if defined(_WIN32)
- if (tenviron == NULL) {
- /*
- * When we are started from main(), the _wenviron array could
- * be NULL and will be initialized by the first _wgetenv() call.
- */
-
- (void) _wgetenv(L"WINDIR");
- }
-#endif
+ Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
- /*
- * 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 (tenviron[0] != NULL) {
- int i;
+ if (environ[0] == NULL) {
+ Tcl_Obj *varNamePtr;
+ TclNewLiteralStringObj(varNamePtr, "env");
+ Tcl_IncrRefCount(varNamePtr);
+ TclArraySet(interp, varNamePtr, NULL);
+ Tcl_DecrRefCount(varNamePtr);
+ } else {
Tcl_MutexLock(&envMutex);
- for (i = 0; tenviron[i] != NULL; i++) {
- Tcl_Obj *obj1, *obj2;
- const char *p1;
- char *p2;
-
- p1 = tenviron2utfdstr(tenviron[i], &envString);
- if (p1 == NULL) {
- /* Ignore what cannot be decoded (should not happen) */
- continue;
- }
- p2 = (char *)strchr(p1, '=');
+ for (i = 0; environ[i] != NULL; i++) {
+ p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
+ p2 = strchr(p1, '=');
if (p2 == NULL) {
/*
* This condition seem to happen occasionally under some
@@ -172,58 +110,16 @@ TclSetupEnv(
* '='; ignore the entry.
*/
- Tcl_DStringFree(&envString);
continue;
}
p2++;
p2[-1] = '\0';
-#if defined(_WIN32)
- /*
- * Enforce PATH and COMSPEC to be all uppercase. This eliminates
- * additional trace logic otherwise required in init.tcl.
- */
-
- if (strcasecmp(p1, "PATH") == 0) {
- p1 = "PATH";
- } else if (strcasecmp(p1, "COMSPEC") == 0) {
- p1 = "COMSPEC";
- }
-#endif
- obj1 = Tcl_NewStringObj(p1, -1);
- obj2 = Tcl_NewStringObj(p2, -1);
+ Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
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_Obj *)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);
@@ -257,10 +153,9 @@ TclSetEnv(
const char *value) /* New value for variable (UTF-8). */
{
Tcl_DString envString;
- Tcl_Size nameLength, valueLength;
- Tcl_Size index, length;
+ int index, length, nameLength;
char *p, *oldValue;
- const techar *p2;
+ const char *p2;
/*
* Figure out where the entry is going to go. If the name doesn't already
@@ -271,7 +166,7 @@ TclSetEnv(
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
- if (index == TCL_INDEX_NONE) {
+ if (index == -1) {
#ifndef USE_PUTENV
/*
* We need to handle the case where the environment may be changed
@@ -279,23 +174,24 @@ TclSetEnv(
* environment is the one we allocated. [Bug 979640]
*/
- if ((env.ourEnviron != tenviron) || (length+2 > env.ourEnvironSize)) {
- techar **newEnviron = (techar **)ckalloc((length + 5) * sizeof(techar *));
+ if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
+ char **newEnviron = (char **)
+ ckalloc(((unsigned) length + 5) * sizeof(char *));
- memcpy(newEnviron, tenviron, length * sizeof(techar *));
+ memcpy(newEnviron, environ, length * sizeof(char *));
if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
- ckfree(env.ourEnviron);
+ ckfree((char *) env.ourEnviron);
}
- tenviron = (env.ourEnviron = newEnviron);
+ environ = env.ourEnviron = newEnviron;
env.ourEnvironSize = length + 5;
}
index = length;
- tenviron[index + 1] = NULL;
+ environ[index + 1] = NULL;
#endif /* USE_PUTENV */
oldValue = NULL;
nameLength = strlen(name);
} else {
- const char *oldEnv;
+ const char *env;
/*
* Compare the new value to the existing value. If they're the same
@@ -305,15 +201,15 @@ TclSetEnv(
* interpreters.
*/
- oldEnv = tenviron2utfdstr(tenviron[index], &envString);
- if (oldEnv == NULL || strcmp(value, oldEnv + (length + 1)) == 0) {
- Tcl_DStringFree(&envString); /* OK even if oldEnv is NULL */
+ env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
+ if (strcmp(value, env + (length + 1)) == 0) {
+ Tcl_DStringFree(&envString);
Tcl_MutexUnlock(&envMutex);
return;
}
Tcl_DStringFree(&envString);
- oldValue = (char *)tenviron[index];
+ oldValue = environ[index];
nameLength = length;
}
@@ -323,25 +219,18 @@ TclSetEnv(
* and set the environ array value.
*/
- valueLength = strlen(value);
- p = (char *)ckalloc(nameLength + valueLength + 2);
- memcpy(p, name, nameLength);
+ p = ckalloc((unsigned) nameLength + strlen(value) + 2);
+ strcpy(p, name);
p[nameLength] = '=';
- memcpy(p+nameLength+1, value, valueLength+1);
- p2 = utf2tenvirondstr(p, &envString);
- if (p2 == NULL) {
- /* No way to signal error from here :-( but should not happen */
- ckfree(p);
- Tcl_MutexUnlock(&envMutex);
- return;
- }
+ strcpy(p+nameLength+1, value);
+ p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
/*
* Copy the native string to heap memory.
*/
- p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + tNTL);
- memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL);
+ p = ckrealloc(p, strlen(p2) + 1);
+ strcpy(p, p2);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
@@ -352,7 +241,7 @@ TclSetEnv(
putenv(p);
index = TclpFindVariable(name, &length);
#else
- tenviron[index] = (techar *)p;
+ environ[index] = p;
#endif /* USE_PUTENV */
/*
@@ -361,7 +250,7 @@ TclSetEnv(
* string in the cache.
*/
- if ((index != TCL_INDEX_NONE) && (tenviron[index] == (techar *)p)) {
+ if ((index != -1) && (environ[index] == p)) {
ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
@@ -421,28 +310,17 @@ Tcl_PutEnv(
}
/*
- * First convert the native string to Utf. Then separate the string into
+ * First convert the native string to UTF. Then separate the string into
* name and value parts, and call TclSetEnv to do all of the real work.
*/
- name = Tcl_ExternalToUtfDString(NULL, assignment, TCL_INDEX_NONE, &nameString);
- value = (char *)strchr(name, '=');
+ name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
+ value = strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
-#if defined(_WIN32)
- if (tenviron == NULL) {
- /*
- * When we are started from main(), the _wenviron array could
- * be NULL and will be initialized by the first _wgetenv() call.
- */
-
- (void) _wgetenv(L"WINDIR");
- }
-#endif
TclSetEnv(name, value+1);
}
- TclEnvEpoch++;
Tcl_DStringFree(&nameString);
return 0;
@@ -472,7 +350,8 @@ TclUnsetEnv(
const char *name) /* Name of variable to remove (UTF-8). */
{
char *oldValue;
- Tcl_Size length, index;
+ int length;
+ int index;
#ifdef USE_PUTENV_FOR_UNSET
Tcl_DString envString;
char *string;
@@ -497,7 +376,7 @@ TclUnsetEnv(
* Remember the old value so we can free it if Tcl created the string.
*/
- oldValue = (char *)tenviron[index];
+ oldValue = environ[index];
/*
* Update the system environment. This must be done before we update the
@@ -510,25 +389,20 @@ TclUnsetEnv(
* that no = should be included, and Windows requires it.
*/
-#if defined(_WIN32)
- string = (char *)ckalloc(length + 2);
- memcpy(string, name, length);
+#if defined(__WIN32__)
+ string = ckalloc((unsigned) length+2);
+ memcpy(string, name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
#else
- string = (char *)ckalloc(length + 1);
- memcpy(string, name, length);
+ string = ckalloc((unsigned) length+1);
+ memcpy(string, name, (size_t) length);
string[length] = '\0';
-#endif /* _WIN32 */
+#endif /* WIN32 */
- if (utf2tenvirondstr(string, &envString) == NULL) {
- /* Should not happen except memory alloc fail. */
- Tcl_MutexUnlock(&envMutex);
- return;
- }
- string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL);
- memcpy(string, Tcl_DStringValue(&envString),
- Tcl_DStringLength(&envString) + tNTL);
+ Tcl_UtfToExternalDString(NULL, string, -1, &envString);
+ string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
+ strcpy(string, Tcl_DStringValue(&envString));
Tcl_DStringFree(&envString);
putenv(string);
@@ -539,7 +413,7 @@ TclUnsetEnv(
* string in the cache.
*/
- if (tenviron[index] == (techar *)string) {
+ if (environ[index] == string) {
ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
@@ -551,7 +425,7 @@ TclUnsetEnv(
#endif /* HAVE_PUTENV_THAT_COPIES */
}
#else /* !USE_PUTENV_FOR_UNSET */
- for (envPtr = (char **)(tenviron+index+1); ; envPtr++) {
+ for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
break;
@@ -591,7 +465,7 @@ TclGetEnv(
* value of the environment variable is
* stored. */
{
- Tcl_Size length, index;
+ int length, index;
const char *result;
Tcl_MutexLock(&envMutex);
@@ -600,19 +474,17 @@ TclGetEnv(
if (index != -1) {
Tcl_DString envStr;
- result = tenviron2utfdstr(tenviron[index], &envStr);
- if (result) {
- result += length;
- if (*result == '=') {
- result++;
- Tcl_DStringInit(valuePtr);
- Tcl_DStringAppend(valuePtr, result, -1);
- result = Tcl_DStringValue(valuePtr);
- } else {
- result = NULL;
- }
- Tcl_DStringFree(&envStr);
+ result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
+ result += length;
+ if (*result == '=') {
+ result++;
+ Tcl_DStringInit(valuePtr);
+ Tcl_DStringAppend(valuePtr, result, -1);
+ result = Tcl_DStringValue(valuePtr);
+ } else {
+ result = NULL;
}
+ Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
@@ -628,8 +500,7 @@ TclGetEnv(
* array.
*
* Results:
- * Returns NULL to indicate success, or an error-message if the array
- * element being handled doesn't exist.
+ * Always returns NULL to indicate success.
*
* Side effects:
* Environment variable changes get propagated. If the whole "env" array
@@ -639,9 +510,10 @@ TclGetEnv(
*----------------------------------------------------------------------
*/
+ /* ARGSUSED */
static char *
EnvTraceProc(
- TCL_UNUSED(void *),
+ ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Interpreter whose "env" variable is being
* modified. */
const char *name1, /* Better be "env". */
@@ -655,7 +527,6 @@ EnvTraceProc(
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
- TclEnvEpoch++;
return NULL;
}
@@ -676,7 +547,6 @@ EnvTraceProc(
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
- TclEnvEpoch++;
}
/*
@@ -688,7 +558,7 @@ EnvTraceProc(
const char *value = TclGetEnv(name2, &valueString);
if (value == NULL) {
- return (char *) "no such variable";
+ return "no such variable";
}
Tcl_SetVar2(interp, name1, name2, value, 0);
Tcl_DStringFree(&valueString);
@@ -700,7 +570,6 @@ EnvTraceProc(
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
- TclEnvEpoch++;
}
return NULL;
}
@@ -728,7 +597,7 @@ ReplaceString(
const char *oldStr, /* Old environment string. */
char *newStr) /* New environment string. */
{
- Tcl_Size i;
+ int i;
/*
* Check to see if the old value was allocated by Tcl. If so, it needs to
@@ -766,11 +635,11 @@ ReplaceString(
const int growth = 5;
- env.cache = (char **)ckrealloc(env.cache,
+ env.cache = (char **) ckrealloc((char *) env.cache,
(env.cacheSize + growth) * sizeof(char *));
env.cache[env.cacheSize] = newStr;
- (void) memset(env.cache+env.cacheSize+1, 0,
- (size_t) (growth-1) * sizeof(char *));
+ (void) memset(env.cache+env.cacheSize+1, (int) 0,
+ (size_t) (growth-1) * sizeof(char*));
env.cacheSize += growth;
}
}
@@ -801,25 +670,14 @@ TclFinalizeEnvironment(void)
* strings. This may leak more memory that strictly necessary, since some
* of the strings may no longer be in the environment. However,
* determining which ones are ok to delete is n-squared, and is pretty
- * unlikely, so we don't bother. However, in the case of DPURIFY, just
- * free all strings in the cache.
+ * unlikely, so we don't bother.
*/
if (env.cache) {
-#ifdef PURIFY
- Tcl_Size i;
- for (i = 0; i < env.cacheSize; i++) {
- ckfree(env.cache[i]);
- }
-#endif
- ckfree(env.cache);
+ ckfree((char *) env.cache);
env.cache = NULL;
env.cacheSize = 0;
#ifndef USE_PUTENV
- if ((env.ourEnviron != NULL)) {
- ckfree(env.ourEnviron);
- env.ourEnviron = NULL;
- }
env.ourEnvironSize = 0;
#endif
}
generated by cgit v0.12 at 2025-12-20 12:58:38 (GMT)