diff options
Diffstat (limited to 'generic/tclEnv.c')
| -rw-r--r-- | generic/tclEnv.c | 324 |
1 files changed, 166 insertions, 158 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 812c2e4..cd1a954 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -11,53 +11,42 @@ * * 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.28 2005/11/27 02:33:49 das Exp $ */ #include "tclInt.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 char **ourEnviron = NULL;/* 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. - */ -static int environSize = 0; /* Non-zero means that the environ array was + * 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 * array is in its original static state. */ #endif - -/* - * For MacOS X - */ - -#if defined(__APPLE__) && defined(__DYNAMIC__) -#include <crt_externs.h> -MODULE_SCOPE char **environ; -char **environ = NULL; -#endif +} env; /* * Declarations for local functions 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); -#if defined(__CYGWIN__) && defined(__WIN32__) -static void TclCygwinPutenv(CONST char *string); + 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); + +#if defined(__CYGWIN__) + static void TclCygwinPutenv(char *string); +# define putenv TclCygwinPutenv #endif /* @@ -87,67 +76,107 @@ 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; - - /* - * For MacOS X, need to get the real system environment. - */ - -#if defined(__APPLE__) && defined(__DYNAMIC__) - environ = *_NSGetEnviron(); -#endif + 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, - (ClientData) NULL); + 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; - varNamePtr = Tcl_NewStringObj("env", -1); - 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, - (ClientData) NULL); + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); } /* @@ -173,14 +202,15 @@ TclSetupEnv( void TclSetEnv( - CONST char *name, /* Name of variable whose value is to be set + const char *name, /* Name of variable whose value is to be set * (UTF-8). */ - CONST char *value) /* New value for variable (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 @@ -195,34 +225,19 @@ TclSetEnv( #ifndef USE_PUTENV /* * We need to handle the case where the environment may be changed - * outside our control. environSize is only valid if the current + * outside our control. ourEnvironSize is only valid if the current * environment is the one we allocated. [Bug 979640] */ - if ((ourEnviron != environ) || ((length + 2) > environSize)) { - char **newEnviron; + if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) { + char **newEnviron = ckalloc((length + 5) * sizeof(char *)); - newEnviron = (char **) - ckalloc((unsigned) ((length + 5) * sizeof(char *))); - memcpy((void *) newEnviron, (void *) environ, - length * sizeof(char *)); - if ((environSize != 0) && (ourEnviron != NULL)) { - ckfree((char *) ourEnviron); + memcpy(newEnviron, environ, length * sizeof(char *)); + if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { + ckfree(env.ourEnviron); } - environ = ourEnviron = newEnviron; - environSize = length + 5; - -#if defined(__APPLE__) && defined(__DYNAMIC__) - /* - * Install the new environment array where the system routines can - * see it. - */ - - { - char ***e = _NSGetEnviron(); - *e = environ; - } -#endif /* __APPLE__ && __DYNAMIC__ */ + environ = env.ourEnviron = newEnviron; + env.ourEnvironSize = length + 5; } index = length; environ[index + 1] = NULL; @@ -230,7 +245,7 @@ TclSetEnv( 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 @@ -241,7 +256,7 @@ TclSetEnv( */ 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; @@ -249,7 +264,7 @@ TclSetEnv( Tcl_DStringFree(&envString); oldValue = environ[index]; - nameLength = length; + nameLength = (unsigned) length; } /* @@ -258,18 +273,19 @@ TclSetEnv( * 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 @@ -281,7 +297,7 @@ TclSetEnv( 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 @@ -298,7 +314,7 @@ TclSetEnv( */ ckfree(p); -#endif +#endif /* HAVE_PUTENV_THAT_COPIES */ } Tcl_MutexUnlock(&envMutex); @@ -337,11 +353,11 @@ TclSetEnv( int Tcl_PutEnv( - CONST char *assignment) /* Info about environment variable in the form + const char *assignment) /* Info about environment variable in the form * NAME=value. (native) */ { Tcl_DString nameString; - CONST char *name; + const char *name; char *value; if (assignment == NULL) { @@ -386,7 +402,7 @@ Tcl_PutEnv( void TclUnsetEnv( - CONST char *name) /* Name of variable to remove (UTF-8). */ + const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; int length; @@ -396,7 +412,7 @@ TclUnsetEnv( char *string; #else char **envPtr; -#endif +#endif /* USE_PUTENV_FOR_UNSET */ Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); @@ -428,20 +444,21 @@ TclUnsetEnv( * that no = should be included, and Windows requires it. */ -#ifdef WIN32 - string = ckalloc((unsigned int) length+2); - memcpy((void *) string, (void *) name, (size_t) length); +#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 int) length+1); - memcpy((void *) string, (void *) name, (size_t) length); + 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); @@ -496,16 +513,16 @@ TclUnsetEnv( *---------------------------------------------------------------------- */ -CONST char * +const char * TclGetEnv( - CONST char *name, /* Name of environment variable to find + 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 * stored. */ { int length, index; - CONST char *result; + const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); @@ -555,8 +572,8 @@ 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 + 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. */ { @@ -582,7 +599,7 @@ EnvTraceProc( */ if (flags & TCL_TRACE_WRITES) { - CONST char *value; + const char *value; value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); TclSetEnv(name2, value); @@ -594,11 +611,11 @@ EnvTraceProc( 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); @@ -634,11 +651,10 @@ EnvTraceProc( static void ReplaceString( - CONST char *oldStr, /* Old environment string. */ + 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 @@ -647,47 +663,41 @@ ReplaceString( * 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 *); - /* * 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); + const int growth = 5; - 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; + 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; } } @@ -720,19 +730,17 @@ TclFinalizeEnvironment(void) * 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 @@ -740,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; @@ -752,7 +761,7 @@ TclCygwinPutenv( * for Windows. */ - name = (char *) alloca(strlen(str) + 1); + name = alloca(strlen(str) + 1); strcpy(name, str); for (value=name ; *value!='=' && *value!='\0' ; ++value) { /* Empty body */ @@ -761,8 +770,7 @@ TclCygwinPutenv( /* Can't happen. */ return; } - *value = '\0'; - ++value; + *(value++) = '\0'; if (*value == '\0') { value = NULL; } @@ -794,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; @@ -806,7 +814,7 @@ TclCygwinPutenv( * Eliminate any Path variable, to prevent any confusion. */ - SetEnvironmentVariable("Path", NULL); + SetEnvironmentVariableA("Path", NULL); unsetenv("Path"); if (value == NULL) { @@ -814,15 +822,15 @@ TclCygwinPutenv( } 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: |