diff options
Diffstat (limited to 'generic/tclEnv.c')
| -rw-r--r-- | generic/tclEnv.c | 665 |
1 files changed, 363 insertions, 302 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c index e0e2739..cd1a954 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -1,61 +1,52 @@ -/* +/* * tclEnv.c -- * - * Tcl support for environment variables, including a setenv - * procedure. This file contains the generic portion of the - * environment module. It is primarily responsible for keeping - * the "env" arrays in sync with the system environment variables. + * Tcl support for environment variables, including a setenv function. + * This file contains the generic portion of the environment module. It + * is primarily responsible for keeping the "env" arrays in sync with the + * system environment variables. * * 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. - * - * RCS: @(#) $Id: tclEnv.c,v 1.19 2002/10/14 22:25:10 hobbs Exp $ + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tclPort.h" -TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */ +TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ -static int cacheSize = 0; /* Number of env strings in environCache. */ -static char **environCache = NULL; - /* Array containing all of the environment +static struct { + int cacheSize; /* Number of env strings in cache. */ + char **cache; /* Array containing all of the environment * strings that Tcl has allocated. */ - #ifndef USE_PUTENV -static int environSize = 0; /* Non-zero means that the environ array was + 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. */ + 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 + * once). Zero means that the environment * array is in its original static state. */ #endif +} env; /* - * For MacOS X + * Declarations for local functions defined in this file: */ -#if defined(__APPLE__) && defined(__DYNAMIC__) -#include <crt_externs.h> -char **environ = NULL; -#endif -/* - * Declarations for local procedures defined in this file: - */ +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); +MODULE_SCOPE void TclUnsetEnv(const char *name); -static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, CONST char *name1, - CONST char *name2, int flags)); -static void ReplaceString _ANSI_ARGS_((CONST char *oldStr, - char *newStr)); -void TclSetEnv _ANSI_ARGS_((CONST char *name, - CONST char *value)); -void TclUnsetEnv _ANSI_ARGS_((CONST char *name)); - -#if defined (__CYGWIN__) && defined(__WIN32__) -static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string)); +#if defined(__CYGWIN__) + static void TclCygwinPutenv(char *string); +# define putenv TclCygwinPutenv #endif /* @@ -63,89 +54,129 @@ static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string)); * * TclSetupEnv -- * - * This procedure is invoked for an interpreter to make environment - * variables accessible from that interpreter via the "env" - * associative array. + * This function is invoked for an interpreter to make environment + * variables accessible from that interpreter via the "env" associative + * array. * * Results: * None. * * Side effects: - * The interpreter is added to a list of interpreters managed - * by us, so that its view of envariables can be kept consistent - * with the view in other interpreters. If this is the first - * call to TclSetupEnv, then additional initialization happens, - * such as copying the environment to dynamically-allocated space - * for ease of management. + * The interpreter is added to a list of interpreters managed by us, so + * that its view of envariables can be kept consistent with the view in + * other interpreters. If this is the first call to TclSetupEnv, then + * additional initialization happens, such as copying the environment to + * dynamically-allocated space for ease of management. * *---------------------------------------------------------------------- */ void -TclSetupEnv(interp) - Tcl_Interp *interp; /* Interpreter whose "env" array is to be +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; /* - * For MacOS X + * 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. */ -#if defined(__APPLE__) && defined(__DYNAMIC__) - environ = *_NSGetEnviron(); -#endif + + Tcl_UntraceVar2(interp, "env", NULL, + TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); /* - * 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. + * Find out what elements are currently in the global env array. */ - - Tcl_UntraceVar2(interp, "env", (char *) NULL, - TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | - TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, - (ClientData) NULL); - - Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); - - if (environ[0] == NULL) { - Tcl_Obj *varNamePtr; - - varNamePtr = Tcl_NewStringObj("env", -1); - Tcl_IncrRefCount(varNamePtr); - TclArraySet(interp, varNamePtr, NULL); - Tcl_DecrRefCount(varNamePtr); - } else { + + 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; + 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); } - Tcl_TraceVar2(interp, "env", (char *) NULL, + /* + * 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, - (ClientData) NULL); + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); } /* @@ -153,12 +184,12 @@ TclSetupEnv(interp) * * TclSetEnv -- * - * Set an environment variable, replacing an existing value - * or creating a new variable if there doesn't exist a variable - * by the given name. This procedure is intended to be a - * stand-in for the UNIX "setenv" procedure so that applications - * using that procedure will interface properly to Tcl. To make - * it a stand-in, the Makefile must define "TclSetEnv" to "setenv". + * Set an environment variable, replacing an existing value or creating a + * new variable if there doesn't exist a variable by the given name. This + * function is intended to be a stand-in for the UNIX "setenv" function + * so that applications using that function will interface properly to + * Tcl. To make it a stand-in, the Makefile must define "TclSetEnv" to + * "setenv". * * Results: * None. @@ -170,20 +201,21 @@ TclSetupEnv(interp) */ void -TclSetEnv(name, value) - CONST char *name; /* Name of variable whose value is to be - * set (UTF-8). */ - CONST char *value; /* New value for variable (UTF-8). */ +TclSetEnv( + const char *name, /* Name of variable whose value is to be set + * (UTF-8). */ + 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; + const char *p2; /* - * Figure out where the entry is going to go. If the name doesn't - * already exist, enlarge the array if necessary to make room. If the - * name exists, free its old entry. + * Figure out where the entry is going to go. If the name doesn't already + * exist, enlarge the array if necessary to make room. If the name exists, + * free its old entry. */ Tcl_MutexLock(&envMutex); @@ -191,43 +223,40 @@ TclSetEnv(name, value) if (index == -1) { #ifndef USE_PUTENV - if ((length + 2) > environSize) { - char **newEnviron; - - newEnviron = (char **) ckalloc((unsigned) - ((length + 5) * sizeof(char *))); - memcpy((VOID *) newEnviron, (VOID *) environ, - length*sizeof(char *)); - if (environSize != 0) { - ckfree((char *) environ); - } - environ = newEnviron; - environSize = length + 5; -#if defined(__APPLE__) && defined(__DYNAMIC__) - { - char ***e = _NSGetEnviron(); - *e = environ; + /* + * We need to handle the case where the environment may be changed + * outside our control. ourEnvironSize is only valid if the current + * environment is the one we allocated. [Bug 979640] + */ + + if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) { + char **newEnviron = ckalloc((length + 5) * sizeof(char *)); + + memcpy(newEnviron, environ, length * sizeof(char *)); + if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { + ckfree(env.ourEnviron); } -#endif + environ = env.ourEnviron = newEnviron; + env.ourEnvironSize = length + 5; } index = length; environ[index + 1] = NULL; -#endif +#endif /* USE_PUTENV */ oldValue = NULL; nameLength = strlen(name); } else { - CONST char *env; + const char *env; /* - * Compare the new value to the existing value. If they're - * the same then quit immediately (e.g. don't rewrite the - * value or propagate it to other interpreters). Otherwise, - * when there are N interpreters there will be N! propagations - * of the same value among the interpreters. + * Compare the new value to the existing value. If they're the same + * then quit immediately (e.g. don't rewrite the value or propagate it + * to other interpreters). Otherwise, when there are N interpreters + * there will be N! propagations of the same value among the + * interpreters. */ env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString); - if (strcmp(value, (env + length + 1)) == 0) { + if (strcmp(value, env + (length + 1)) == 0) { Tcl_DStringFree(&envString); Tcl_MutexUnlock(&envMutex); return; @@ -235,28 +264,28 @@ TclSetEnv(name, value) Tcl_DStringFree(&envString); oldValue = environ[index]; - nameLength = length; + nameLength = (unsigned) length; } - /* - * Create a new entry. Build a complete UTF string that contains - * a "name=value" pattern. Then convert the string to the native - * encoding, and set the environ array value. + * Create a new entry. Build a complete UTF string that contains a + * "name=value" pattern. Then convert the string to the native encoding, + * and set the environ array value. */ - p = (char *) 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 = (char *) ckrealloc(p, (unsigned) (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 @@ -268,32 +297,35 @@ TclSetEnv(name, value) index = TclpFindVariable(name, &length); #else environ[index] = p; -#endif +#endif /* USE_PUTENV */ /* - * Watch out for versions of putenv that copy the string (e.g. VC++). - * In this case we need to free the string immediately. Otherwise - * update the string in the cache. + * Watch out for versions of putenv that copy the string (e.g. VC++). In + * this case we need to free the string immediately. Otherwise update the + * string in the cache. */ if ((index != -1) && (environ[index] == p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { - /* This putenv() copies instead of taking ownership */ + /* + * This putenv() copies instead of taking ownership. + */ + ckfree(p); -#endif +#endif /* HAVE_PUTENV_THAT_COPIES */ } Tcl_MutexUnlock(&envMutex); - + if (!strcmp(name, "HOME")) { - /* - * If the user's home directory has changed, we must invalidate - * the filesystem cache, because '~' expansions will now be - * incorrect. + /* + * If the user's home directory has changed, we must invalidate the + * filesystem cache, because '~' expansions will now be incorrect. */ - Tcl_FSMountsChanged(NULL); + + Tcl_FSMountsChanged(NULL); } } @@ -302,44 +334,42 @@ TclSetEnv(name, value) * * Tcl_PutEnv -- * - * Set an environment variable. Similar to setenv except that - * the information is passed in a single string of the form - * NAME=value, rather than as separate name strings. This procedure - * is intended to be a stand-in for the UNIX "putenv" procedure - * so that applications using that procedure will interface - * properly to Tcl. To make it a stand-in, the Makefile will - * define "Tcl_PutEnv" to "putenv". + * Set an environment variable. Similar to setenv except that the + * information is passed in a single string of the form NAME=value, + * rather than as separate name strings. This function is intended to be + * a stand-in for the UNIX "putenv" function so that applications using + * that function will interface properly to Tcl. To make it a stand-in, + * the Makefile will define "Tcl_PutEnv" to "putenv". * * Results: * None. * * Side effects: - * The environ array gets updated, as do all of the interpreters - * that we manage. + * The environ array gets updated, as do all of the interpreters that we + * manage. * *---------------------------------------------------------------------- */ int -Tcl_PutEnv(string) - CONST char *string; /* Info about environment variable in the - * form NAME=value. (native) */ +Tcl_PutEnv( + const char *assignment) /* Info about environment variable in the form + * NAME=value. (native) */ { - Tcl_DString nameString; - CONST char *name; + Tcl_DString nameString; + const char *name; char *value; - if (string == NULL) { + if (assignment == NULL) { return 0; } /* - * 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. + * 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, string, -1, &nameString); + name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); value = strchr(name, '='); if ((value != NULL) && (value != name)) { @@ -356,11 +386,10 @@ Tcl_PutEnv(string) * * TclUnsetEnv -- * - * Remove an environment variable, updating the "env" arrays - * in all interpreters managed by us. This function is intended - * to replace the UNIX "unsetenv" function (but to do this the - * Makefile must be modified to redefine "TclUnsetEnv" to - * "unsetenv". + * Remove an environment variable, updating the "env" arrays in all + * interpreters managed by us. This function is intended to replace the + * UNIX "unsetenv" function (but to do this the Makefile must be modified + * to redefine "TclUnsetEnv" to "unsetenv". * * Results: * None. @@ -372,31 +401,32 @@ Tcl_PutEnv(string) */ void -TclUnsetEnv(name) - CONST char *name; /* Name of variable to remove (UTF-8). */ +TclUnsetEnv( + const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; int length; int index; -#ifdef USE_PUTENV +#ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; #else char **envPtr; -#endif +#endif /* USE_PUTENV_FOR_UNSET */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); /* - * First make sure that the environment variable exists to avoid - * doing needless work and to avoid recursion on the unset. + * First make sure that the environment variable exists to avoid doing + * needless work and to avoid recursion on the unset. */ - + if (index == -1) { Tcl_MutexUnlock(&envMutex); return; } + /* * Remember the old value so we can free it if Tcl created the string. */ @@ -404,33 +434,53 @@ TclUnsetEnv(name) oldValue = environ[index]; /* - * Update the system environment. This must be done before we - * update the interpreters or we will recurse. + * Update the system environment. This must be done before we update the + * interpreters or we will recurse. */ -#ifdef USE_PUTENV - string = ckalloc(length+2); - memcpy((VOID *) string, (VOID *) name, (size_t) length); +#ifdef USE_PUTENV_FOR_UNSET + /* + * For those platforms that support putenv to unset, Linux indicates + * that no = should be included, and Windows requires it. + */ + +#if defined(_WIN32) || defined(__CYGWIN__) + string = ckalloc(length + 2); + memcpy(string, name, (size_t) length); string[length] = '='; string[length+1] = '\0'; - +#else + string = ckalloc(length + 1); + memcpy(string, name, (size_t) length); + string[length] = '\0'; +#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); /* - * Watch out for versions of putenv that copy the string (e.g. VC++). - * In this case we need to free the string immediately. Otherwise - * update the string in the cache. + * Watch out for versions of putenv that copy the string (e.g. VC++). In + * this case we need to free the string immediately. Otherwise update the + * string in the cache. */ if (environ[index] == string) { ReplaceString(oldValue, string); +#ifdef HAVE_PUTENV_THAT_COPIES + } else { + /* + * This putenv() copies instead of taking ownership. + */ + + ckfree(string); +#endif /* HAVE_PUTENV_THAT_COPIES */ } -#else +#else /* !USE_PUTENV_FOR_UNSET */ for (envPtr = environ+index+1; ; envPtr++) { envPtr[-1] = *envPtr; if (*envPtr == NULL) { @@ -438,7 +488,7 @@ TclUnsetEnv(name) } } ReplaceString(oldValue, NULL); -#endif +#endif /* USE_PUTENV_FOR_UNSET */ Tcl_MutexUnlock(&envMutex); } @@ -452,10 +502,10 @@ TclUnsetEnv(name) * * Results: * The result is a pointer to a string specifying the value of the - * environment variable, or NULL if that environment variable does - * not exist. Storage for the result string is allocated in valuePtr; - * the caller must call Tcl_DStringFree() when the result is no - * longer needed. + * environment variable, or NULL if that environment variable does not + * exist. Storage for the result string is allocated in valuePtr; the + * caller must call Tcl_DStringFree() when the result is no longer + * needed. * * Side effects: * None. @@ -463,23 +513,23 @@ TclUnsetEnv(name) *---------------------------------------------------------------------- */ -CONST char * -TclGetEnv(name, valuePtr) - CONST char *name; /* Name of environment variable to find +const char * +TclGetEnv( + const char *name, /* Name of environment variable to find * (UTF-8). */ - Tcl_DString *valuePtr; /* Uninitialized or free DString in which - * the value of the environment variable is + Tcl_DString *valuePtr) /* Uninitialized or free DString in which the + * value of the environment variable is * stored. */ { int length, index; - CONST char *result; + const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); result = NULL; if (index != -1) { Tcl_DString envStr; - + result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr); result += length; if (*result == '=') { @@ -501,32 +551,31 @@ TclGetEnv(name, valuePtr) * * EnvTraceProc -- * - * This procedure is invoked whenever an environment variable - * is read, modified or deleted. It propagates the change to the global - * "environ" array. + * This function is invoked whenever an environment variable is read, + * modified or deleted. It propagates the change to the global "environ" + * array. * * Results: * Always returns NULL to indicate success. * * Side effects: - * Environment variable changes get propagated. If the whole - * "env" array is deleted, then we stop managing things for - * this interpreter (usually this happens because the whole - * interpreter is being deleted). + * Environment variable changes get propagated. If the whole "env" array + * is deleted, then we stop managing things for this interpreter (usually + * this happens because the whole interpreter is being deleted). * *---------------------------------------------------------------------- */ /* ARGSUSED */ static char * -EnvTraceProc(clientData, interp, name1, name2, flags) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Interpreter whose "env" variable is - * being modified. */ - CONST char *name1; /* Better be "env". */ - CONST char *name2; /* Name of variable being modified, or NULL - * if whole array is being deleted (UTF-8). */ - int flags; /* Indicates what's happening. */ +EnvTraceProc( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Interpreter whose "env" variable is being + * modified. */ + const char *name1, /* Better be "env". */ + const char *name2, /* Name of variable being modified, or NULL if + * whole array is being deleted (UTF-8). */ + int flags) /* Indicates what's happening. */ { /* * For array traces, let TclSetupEnv do all the work. @@ -540,7 +589,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags) /* * If name2 is NULL, then return and do nothing. */ - + if (name2 == NULL) { return NULL; } @@ -550,8 +599,8 @@ EnvTraceProc(clientData, interp, name1, name2, flags) */ if (flags & TCL_TRACE_WRITES) { - CONST char *value; - + const char *value; + value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); } @@ -562,11 +611,11 @@ EnvTraceProc(clientData, interp, name1, name2, flags) if (flags & TCL_TRACE_READS) { Tcl_DString valueString; - CONST char *value; + const char *value = TclGetEnv(name2, &valueString); - 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); @@ -587,9 +636,9 @@ EnvTraceProc(clientData, interp, name1, name2, flags) * * ReplaceString -- * - * Replace one string with another in the environment variable - * cache. The cache keeps track of all of the environment - * variables that Tcl has modified so they can be freed later. + * Replace one string with another in the environment variable cache. The + * cache keeps track of all of the environment variables that Tcl has + * modified so they can be freed later. * * Results: * None. @@ -601,61 +650,54 @@ EnvTraceProc(clientData, interp, name1, name2, flags) */ static void -ReplaceString(oldStr, newStr) - CONST char *oldStr; /* Old environment string. */ - char *newStr; /* New environment string. */ +ReplaceString( + const char *oldStr, /* Old environment string. */ + char *newStr) /* New environment string. */ { int i; - char **newCache; /* - * Check to see if the old value was allocated by Tcl. If so, - * it needs to be deallocated to avoid memory leaks. Note that this - * algorithm is O(n), not O(1). This will result in n-squared behavior - * if lots of environment changes are being made. + * Check to see if the old value was allocated by Tcl. If so, it needs to + * be deallocated to avoid memory leaks. Note that this algorithm is O(n), + * not O(1). This will result in n-squared behavior if lots of environment + * changes are being made. */ - for (i = 0; i < cacheSize; i++) { - if ((environCache[i] == oldStr) || (environCache[i] == NULL)) { + for (i = 0; i < env.cacheSize; i++) { + if (env.cache[i]==oldStr || env.cache[i]==NULL) { break; } } - if (i < cacheSize) { + if (i < env.cacheSize) { /* * Replace or delete the old value. */ - if (environCache[i]) { - ckfree(environCache[i]); + if (env.cache[i]) { + ckfree(env.cache[i]); } - + if (newStr) { - environCache[i] = newStr; + env.cache[i] = newStr; } else { - for (; i < cacheSize-1; i++) { - environCache[i] = environCache[i+1]; + for (; i < env.cacheSize-1; i++) { + env.cache[i] = env.cache[i+1]; } - environCache[cacheSize-1] = NULL; + env.cache[env.cacheSize-1] = NULL; } - } else { - int allocatedSize = (cacheSize + 5) * sizeof(char *); - + } else { /* * We need to grow the cache in order to hold the new string. */ - newCache = (char **) ckalloc((unsigned) allocatedSize); - (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize); - - if (environCache) { - memcpy((VOID *) newCache, (VOID *) environCache, - (size_t) (cacheSize * sizeof(char*))); - ckfree((char *) environCache); - } - environCache = newCache; - environCache[cacheSize] = newStr; - environCache[cacheSize+1] = NULL; - cacheSize += 5; + const int growth = 5; + + env.cache = ckrealloc(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 *)); + env.cacheSize += growth; } } @@ -664,9 +706,9 @@ ReplaceString(oldStr, newStr) * * TclFinalizeEnvironment -- * - * This function releases any storage allocated by this module - * that isn't still in use by the global environment. Any - * strings that are still in the environment will be leaked. + * This function releases any storage allocated by this module that isn't + * still in use by the global environment. Any strings that are still in + * the environment will be leaked. * * Results: * None. @@ -678,29 +720,27 @@ ReplaceString(oldStr, newStr) */ void -TclFinalizeEnvironment() +TclFinalizeEnvironment(void) { /* * For now we just deallocate the cache array and none of the environment - * strings. This may leak more memory that strictly necessary, since some - * of the strings may no longer be in the environment. However, + * 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. */ - if (environCache) { - ckfree((char *) environCache); - environCache = NULL; - cacheSize = 0; + if (env.cache) { + ckfree(env.cache); + env.cache = NULL; + env.cacheSize = 0; #ifndef USE_PUTENV - environSize = 0; + env.ourEnvironSize = 0; #endif } } -#if defined(__CYGWIN__) && defined(__WIN32__) - -#include <windows.h> +#if defined(__CYGWIN__) /* * When using cygwin, when an environment variable changes, we need to synch @@ -708,33 +748,40 @@ TclFinalizeEnvironment() * 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(str) - const char *str; +TclCygwinPutenv( + char *str) { char *name, *value; - /* Get the name and value, so that we can change the environment - variable for Windows. */ - name = (char *) alloca (strlen (str) + 1); - strcpy (name, str); - for (value = name; *value != '=' && *value != '\0'; ++value) - ; + /* + * Get the name and value, so that we can change the environment variable + * for Windows. + */ + + name = alloca(strlen(str) + 1); + strcpy(name, str); + for (value=name ; *value!='=' && *value!='\0' ; ++value) { + /* Empty body */ + } if (*value == '\0') { - /* Can't happen. */ - return; - } - *value = '\0'; - ++value; + /* Can't happen. */ + return; + } + *(value++) = '\0'; if (*value == '\0') { value = NULL; } - /* Set the cygwin environment variable. */ + /* + * Set the cygwin environment variable. + */ + #undef putenv if (value == NULL) { - unsetenv (name); + unsetenv(name); } else { putenv(str); } @@ -747,34 +794,48 @@ TclCygwinPutenv(str) * may have set the path to a Windows path, or, worse, appended or * prepended a Windows path to PATH. */ - if (strcmp (name, "PATH") != 0) { - /* If this is Path, eliminate any PATH variable, to prevent any - confusion. */ - if (strcmp (name, "Path") == 0) { - SetEnvironmentVariable ("PATH", (char *) NULL); - unsetenv ("PATH"); + + if (strcmp(name, "PATH") != 0) { + /* + * If this is Path, eliminate any PATH variable, to prevent any + * confusion. + */ + + if (strcmp(name, "Path") == 0) { + SetEnvironmentVariableA("PATH", NULL); + unsetenv("PATH"); } - SetEnvironmentVariable (name, value); + SetEnvironmentVariableA(name, value); } else { char *buf; - /* Eliminate any Path variable, to prevent any confusion. */ - SetEnvironmentVariable ("Path", (char *) NULL); - unsetenv ("Path"); + /* + * Eliminate any Path variable, to prevent any confusion. + */ + + SetEnvironmentVariableA("Path", NULL); + unsetenv("Path"); if (value == NULL) { buf = NULL; } else { int size; - size = cygwin_posix_to_win32_path_list_buf_size (value); - buf = (char *) alloca (size + 1); - cygwin_posix_to_win32_path_list (value, buf); + size = cygwin_conv_path_list(0, value, NULL, 0); + buf = alloca(size + 1); + cygwin_conv_path_list(0, value, buf, size); } - SetEnvironmentVariable (name, buf); + SetEnvironmentVariableA(name, buf); } } - -#endif /* __CYGWIN__ && __WIN32__ */ +#endif /* __CYGWIN__ */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |