summaryrefslogtreecommitdiffstats
path: root/generic/tclEnv.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /generic/tclEnv.c
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'generic/tclEnv.c')
-rw-r--r--generic/tclEnv.c437
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
}
}
+
+
+
+