diff options
Diffstat (limited to 'generic/tclEnv.c')
| -rw-r--r-- | generic/tclEnv.c | 437 |
1 files changed, 202 insertions, 235 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 52d68ae..4e5854e 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -7,34 +7,18 @@ * the "env" arrays in sync with the system environment variables. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * 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.3 1999/02/02 23:01:59 stanton Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.4 1999/04/16 00:46:46 stanton Exp $ */ #include "tclInt.h" #include "tclPort.h" -/* - * The structure below is used to keep track of all of the interpereters - * for which we're managing the "env" array. It's needed so that they - * can all be updated whenever an environment variable is changed - * anywhere. - */ - -typedef struct EnvInterp { - Tcl_Interp *interp; /* Interpreter for which we're managing - * the env array. */ - struct EnvInterp *nextPtr; /* Next in list of all such interpreters, - * or zero. */ -} EnvInterp; - -static EnvInterp *firstInterpPtr = NULL; - /* First in list of all managed interpreters, - * or NULL if none. */ +TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */ static int cacheSize = 0; /* Number of env strings in environCache. */ static char **environCache = NULL; @@ -56,13 +40,12 @@ static int environSize = 0; /* Non-zero means that the environ array was static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, char *name1, char *name2, int flags)); -static int FindVariable _ANSI_ARGS_((CONST char *name, - int *lengthPtr)); 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)); + /* *---------------------------------------------------------------------- @@ -80,7 +63,7 @@ void TclUnsetEnv _ANSI_ARGS_((CONST char *name)); * 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 Tcl_SetupEnv, then additional initialization happens, + * call to TclSetupEnv, then additional initialization happens, * such as copying the environment to dynamically-allocated space * for ease of management. * @@ -92,73 +75,59 @@ TclSetupEnv(interp) Tcl_Interp *interp; /* Interpreter whose "env" array is to be * managed. */ { - EnvInterp *eiPtr; - char *p, *p2; - Tcl_DString ds; - int i, sz; - -#ifdef MAC_TCL - if (environ == NULL) { - environSize = TclMacCreateEnv(); - } -#endif + Tcl_DString envString; + char *p1, *p2; + int i; /* - * Next, initialize the DString we are going to use for copying - * the names of the environment variables. + * 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. */ - - Tcl_DStringInit(&ds); - /* - * Next, add the interpreter to the list of those that we manage. - */ - - eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp)); - eiPtr->interp = interp; - eiPtr->nextPtr = firstInterpPtr; - firstInterpPtr = eiPtr; - - /* - * Store the environment variable values into the interpreter's - * "env" array, and arrange for us to be notified on future - * writes and unsets to that array. - */ - - (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); - for (i = 0; ; i++) { - p = environ[i]; - if (p == NULL) { - break; - } - for (p2 = p; *p2 != '='; p2++) { - if (*p2 == 0) { + 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 { + Tcl_MutexLock(&envMutex); + for (i = 0; environ[i] != NULL; i++) { + p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString); + p2 = strchr(p1, '='); + if (p2 == NULL) { /* - * This condition doesn't seem like it should ever happen, - * but it does seem to happen occasionally under some + * This condition seem to happen occasionally under some * versions of Solaris; ignore the entry. */ - - goto nextEntry; + + continue; } + p2++; + p2[-1] = '\0'; + Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY); + Tcl_DStringFree(&envString); } - sz = p2 - p; - Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, p, sz); - (void) Tcl_SetVar2(interp, "env", Tcl_DStringValue(&ds), - p2+1, TCL_GLOBAL_ONLY); - nextEntry: - continue; + Tcl_MutexUnlock(&envMutex); } - Tcl_TraceVar2(interp, "env", (char *) NULL, - TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS, - EnvTraceProc, (ClientData) NULL); - /* - * Finally clean up the DString. - */ - - Tcl_DStringFree(&ds); + Tcl_TraceVar2(interp, "env", (char *) NULL, + TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, + (ClientData) NULL); } /* @@ -177,8 +146,7 @@ TclSetupEnv(interp) * None. * * Side effects: - * The environ array gets updated, as do all of the interpreters - * that we manage. + * The environ array gets updated. * *---------------------------------------------------------------------- */ @@ -186,47 +154,45 @@ TclSetupEnv(interp) void TclSetEnv(name, value) CONST char *name; /* Name of variable whose value is to be - * set. */ - CONST char *value; /* New value for variable. */ + * set (UTF-8). */ + CONST char *value; /* New value for variable (UTF-8). */ { + Tcl_DString envString; int index, length, nameLength; - char *p, *oldValue; - EnvInterp *eiPtr; - -#ifdef MAC_TCL - if (environ == NULL) { - environSize = TclMacCreateEnv(); - } -#endif + char *p, *p2, *oldValue; /* * 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. + * already exist, enlarge the array if necessary to make room. If the + * name exists, free its old entry. */ - index = FindVariable(name, &length); + Tcl_MutexLock(&envMutex); + index = TclpFindVariable(name, &length); + if (index == -1) { #ifndef USE_PUTENV - if ((length+2) > environSize) { + if ((length + 2) > environSize) { char **newEnviron; newEnviron = (char **) ckalloc((unsigned) - ((length+5) * sizeof(char *))); + ((length + 5) * sizeof(char *))); memcpy((VOID *) newEnviron, (VOID *) environ, length*sizeof(char *)); if (environSize != 0) { ckfree((char *) environ); } environ = newEnviron; - environSize = length+5; + environSize = length + 5; } index = length; - environ[index+1] = NULL; + environ[index + 1] = NULL; #endif oldValue = NULL; nameLength = strlen(name); } else { + char *env; + /* * Compare the new value to the existing value. If they're * the same then quit immediately (e.g. don't rewrite the @@ -235,47 +201,63 @@ TclSetEnv(name, value) * of the same value among the interpreters. */ - if (strcmp(value, environ[index]+length+1) == 0) { + 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 = environ[index]; nameLength = length; } /* - * Create a new entry. + * 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); p[nameLength] = '='; strcpy(p+nameLength+1, value); + p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString); + ckfree(p); + +#ifdef USE_PUTENV /* * Update the system environment. */ -#ifdef USE_PUTENV - putenv(p); + putenv(p2); + index = TclpFindVariable(name, &length); #else - environ[index] = p; -#endif - /* - * Replace the old value with the new value in the cache. + * Copy the native string to heap memory. */ - - ReplaceString(oldValue, p); + + p = (char *) ckalloc((unsigned) (strlen(p2) + 1)); + strcpy(p, p2); + environ[index] = p; +#endif /* - * Update all of the interpreters. + * 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. */ - for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) { - (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name, - (char *) value, TCL_GLOBAL_ONLY); + if (environ[index] != p) { + Tcl_DStringFree(&envString); + } else { + ReplaceString(oldValue, p); } + + Tcl_MutexUnlock(&envMutex); } /* @@ -304,8 +286,9 @@ TclSetEnv(name, value) int Tcl_PutEnv(string) CONST char *string; /* Info about environment variable in the - * form NAME=value. */ + * form NAME=value. (native) */ { + Tcl_DString nameString; int nameLength; char *name, *value; @@ -314,23 +297,24 @@ Tcl_PutEnv(string) } /* - * Separate the string into name and value parts, then 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. */ - value = strchr(string, '='); + name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString); + value = strchr(name, '='); if (value == NULL) { return 0; } - nameLength = value - string; + nameLength = value - name; if (nameLength == 0) { return 0; } - name = (char *) ckalloc((unsigned) nameLength+1); - memcpy((VOID *) name, (VOID *) string, (size_t) nameLength); - name[nameLength] = 0; + + value[0] = '\0'; TclSetEnv(name, value+1); - ckfree(name); + Tcl_DStringFree(&nameString); return 0; } @@ -356,24 +340,19 @@ Tcl_PutEnv(string) void TclUnsetEnv(name) - CONST char *name; /* Name of variable to remove. */ + CONST char *name; /* Name of variable to remove (UTF-8). */ { - EnvInterp *eiPtr; char *oldValue; int length, index; #ifdef USE_PUTENV + Tcl_DString envString; char *string; #else char **envPtr; #endif -#ifdef MAC_TCL - if (environ == NULL) { - environSize = TclMacCreateEnv(); - } -#endif - - index = FindVariable(name, &length); + Tcl_MutexLock(&envMutex); + index = TclpFindVariable(name, &length); /* * First make sure that the environment variable exists to avoid @@ -381,6 +360,7 @@ TclUnsetEnv(name) */ if (index == -1) { + Tcl_MutexUnlock(&envMutex); return; } /* @@ -399,8 +379,23 @@ TclUnsetEnv(name) memcpy((VOID *) string, (VOID *) name, (size_t) length); string[length] = '='; string[length+1] = '\0'; - putenv(string); + + Tcl_UtfToExternalDString(NULL, string, -1, &envString); ckfree(string); + string = Tcl_DStringValue(&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. + */ + + if (environ[index] != string) { + Tcl_DStringFree(&envString); + } else { + ReplaceString(oldValue, string); + } #else for (envPtr = environ+index+1; ; envPtr++) { envPtr[-1] = *envPtr; @@ -408,34 +403,25 @@ TclUnsetEnv(name) break; } } -#endif - - /* - * Replace the old value in the cache. - */ - ReplaceString(oldValue, NULL); +#endif - /* - * Update all of the interpreters. - */ - - for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) { - (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name, - TCL_GLOBAL_ONLY); - } + Tcl_MutexUnlock(&envMutex); } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * TclGetEnv -- * * Retrieve the value of an environment variable. * * Results: - * Returns a pointer to a static string in the environment, - * or NULL if the value was not found. + * 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. * * Side effects: * None. @@ -444,23 +430,36 @@ TclUnsetEnv(name) */ char * -TclGetEnv(name) - CONST char *name; /* Name of variable to find. */ +TclGetEnv(name, valuePtr) + 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; + char *result; -#ifdef MAC_TCL - if (environ == NULL) { - environSize = TclMacCreateEnv(); - } -#endif - - index = FindVariable(name, &length); - if ((index != -1) && (*(environ[index]+length) == '=')) { - return environ[index]+length+1; - } else { - return NULL; + 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 == '=') { + result++; + Tcl_DStringInit(valuePtr); + Tcl_DStringAppend(valuePtr, result, -1); + result = Tcl_DStringValue(valuePtr); + } else { + result = NULL; + } + Tcl_DStringFree(&envStr); } + Tcl_MutexUnlock(&envMutex); + return result; } /* @@ -469,9 +468,8 @@ TclGetEnv(name) * EnvTraceProc -- * * This procedure is invoked whenever an environment variable - * is modified or deleted. It propagates the change to the - * "environ" array and to any other interpreters for whom - * we're managing an "env" array. + * is read, modified or deleted. It propagates the change to the global + * "environ" array. * * Results: * Always returns NULL to indicate success. @@ -492,38 +490,24 @@ EnvTraceProc(clientData, interp, name1, name2, flags) Tcl_Interp *interp; /* Interpreter whose "env" variable is * being modified. */ char *name1; /* Better be "env". */ - char *name2; /* Name of variable being modified, or - * NULL if whole array is being deleted. */ + char *name2; /* Name of variable being modified, or NULL + * if whole array is being deleted (UTF-8). */ int flags; /* Indicates what's happening. */ { /* - * First see if the whole "env" variable is being deleted. If - * so, just forget about this interpreter. + * For array traces, let TclSetupEnv do all the work. */ - if (name2 == NULL) { - register EnvInterp *eiPtr, *prevPtr; + if (flags & TCL_TRACE_ARRAY) { + TclSetupEnv(interp); + return NULL; + } - if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) - != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) { - panic("EnvTraceProc called with confusing arguments"); - } - eiPtr = firstInterpPtr; - if (eiPtr->interp == interp) { - firstInterpPtr = eiPtr->nextPtr; - } else { - for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ; - prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) { - if (eiPtr == NULL) { - panic("EnvTraceProc couldn't find interpreter"); - } - if (eiPtr->interp == interp) { - prevPtr->nextPtr = eiPtr->nextPtr; - break; - } - } - } - ckfree((char *) eiPtr); + /* + * If name2 is NULL, then return and do nothing. + */ + + if (name2 == NULL) { return NULL; } @@ -532,9 +516,32 @@ EnvTraceProc(clientData, interp, name1, name2, flags) */ if (flags & TCL_TRACE_WRITES) { - TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY)); + char *value; + + value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); + TclSetEnv(name2, value); } + /* + * If a value is being read, call TclGetEnv to do all of the work. + */ + + if (flags & TCL_TRACE_READS) { + Tcl_DString valueString; + char *value; + + value = TclGetEnv(name2, &valueString); + if (value == NULL) { + return "no such variable"; + } + Tcl_SetVar2(interp, name1, name2, value, 0); + Tcl_DStringFree(&valueString); + } + + /* + * For unset traces, let TclUnsetEnv do all the work. + */ + if (flags & TCL_TRACE_UNSETS) { TclUnsetEnv(name2); } @@ -603,7 +610,7 @@ ReplaceString(oldStr, newStr) * We need to grow the cache in order to hold the new string. */ - newCache = (char **) ckalloc((size_t) allocatedSize); + newCache = (char **) ckalloc((unsigned) allocatedSize); (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize); if (environCache) { @@ -621,50 +628,6 @@ ReplaceString(oldStr, newStr) /* *---------------------------------------------------------------------- * - * FindVariable -- - * - * Locate the entry in environ for a given name. - * - * Results: - * The return value is the index in environ of an entry with the - * name "name", or -1 if there is no such entry. The integer at - * *lengthPtr is filled in with the length of name (if a matching - * entry is found) or the length of the environ array (if no matching - * entry is found). - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -FindVariable(name, lengthPtr) - CONST char *name; /* Name of desired environment variable. */ - int *lengthPtr; /* Used to return length of name (for - * successful searches) or number of non-NULL - * entries in environ (for unsuccessful - * searches). */ -{ - int i; - register CONST char *p1, *p2; - - for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) { - for (p2 = name; *p2 == *p1; p1++, p2++) { - /* NULL loop body. */ - } - if ((*p1 == '=') && (*p2 == '\0')) { - *lengthPtr = p2-name; - return i; - } - } - *lengthPtr = i; - return -1; -} - -/* - *---------------------------------------------------------------------- - * * TclFinalizeEnvironment -- * * This function releases any storage allocated by this module @@ -700,3 +663,7 @@ TclFinalizeEnvironment() #endif } } + + + + |