summaryrefslogtreecommitdiffstats
path: root/generic/tclEnv.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclEnv.c')
-rw-r--r--generic/tclEnv.c546
1 files changed, 316 insertions, 230 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 7108436..bcc0ff1 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -1,80 +1,79 @@
/*
* 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.
+ * 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 char **ourEnviron = NULL;/* Cache of the array that we allocate.
- * We need to track this in case another
+ 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
+ * once). Zero means that the environment
* array is in its original static state. */
#endif
+} env;
/*
- * Declarations for local procedures defined in this file:
+ * Declarations for local functions defined in this file:
*/
-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));
+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__)
+ static void TclCygwinPutenv(char *string);
+# define putenv TclCygwinPutenv
+#endif
/*
*----------------------------------------------------------------------
*
* 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. */
{
Tcl_DString envString;
@@ -82,28 +81,27 @@ TclSetupEnv(interp)
int i;
/*
- * Synchronize the values in the environ array with the contents
- * of the Tcl "env" variable. To do this:
+ * 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.
+ * 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", (char *) NULL,
+
+ Tcl_UntraceVar2(interp, "env", 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);
-
+ TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
+
+ Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
+
if (environ[0] == NULL) {
Tcl_Obj *varNamePtr;
-
- varNamePtr = Tcl_NewStringObj("env", -1);
+
+ TclNewLiteralStringObj(varNamePtr, "env");
Tcl_IncrRefCount(varNamePtr);
- TclArraySet(interp, varNamePtr, NULL);
+ TclArraySet(interp, varNamePtr, NULL);
Tcl_DecrRefCount(varNamePtr);
} else {
Tcl_MutexLock(&envMutex);
@@ -113,23 +111,23 @@ TclSetupEnv(interp)
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);
+ Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&envString);
}
Tcl_MutexUnlock(&envMutex);
}
- Tcl_TraceVar2(interp, "env", (char *) NULL,
+ 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);
}
/*
@@ -137,12 +135,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.
@@ -154,20 +152,20 @@ 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;
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);
@@ -177,40 +175,39 @@ TclSetEnv(name, value)
#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;
-
- newEnviron = (char **) ckalloc((unsigned)
- ((length + 5) * sizeof(char *)));
- memcpy((VOID *) newEnviron, (VOID *) environ,
- length*sizeof(char *));
- if ((environSize != 0) && (ourEnviron != NULL)) {
- ckfree((char *) ourEnviron);
+
+ if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
+ char **newEnviron = (char **)
+ ckalloc(((unsigned) length + 5) * sizeof(char *));
+
+ memcpy(newEnviron, environ, length * sizeof(char *));
+ if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
+ ckfree((char *) env.ourEnviron);
}
- environ = ourEnviron = newEnviron;
- environSize = length + 5;
+ 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;
@@ -222,12 +219,12 @@ TclSetEnv(name, 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.
+ * 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));
+ p = ckalloc((unsigned) nameLength + strlen(value) + 2);
strcpy(p, name);
p[nameLength] = '=';
strcpy(p+nameLength+1, value);
@@ -236,8 +233,8 @@ TclSetEnv(name, value)
/*
* Copy the native string to heap memory.
*/
-
- p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
+
+ p = ckrealloc(p, strlen(p2) + 1);
strcpy(p, p2);
Tcl_DStringFree(&envString);
@@ -250,32 +247,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);
}
}
@@ -284,44 +284,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)) {
@@ -338,11 +336,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.
@@ -354,8 +351,8 @@ 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;
@@ -365,20 +362,21 @@ TclUnsetEnv(name)
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.
*/
@@ -386,8 +384,8 @@ 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_FOR_UNSET
@@ -395,39 +393,43 @@ TclUnsetEnv(name)
* For those platforms that support putenv to unset, Linux indicates
* 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((unsigned) 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((unsigned) length+1);
+ memcpy(string, name, (size_t) length);
string[length] = '\0';
-#endif
+#endif /* WIN32 */
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
- string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
+ string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
strcpy(string, Tcl_DStringValue(&envString));
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 */
+ /*
+ * This putenv() copies instead of taking ownership.
+ */
+
ckfree(string);
-#endif
+#endif /* HAVE_PUTENV_THAT_COPIES */
}
-#else
+#else /* !USE_PUTENV_FOR_UNSET */
for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
@@ -435,7 +437,7 @@ TclUnsetEnv(name)
}
}
ReplaceString(oldValue, NULL);
-#endif
+#endif /* USE_PUTENV_FOR_UNSET */
Tcl_MutexUnlock(&envMutex);
}
@@ -449,10 +451,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.
@@ -460,23 +462,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 == '=') {
@@ -498,32 +500,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.
@@ -537,7 +538,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
/*
* If name2 is NULL, then return and do nothing.
*/
-
+
if (name2 == NULL) {
return NULL;
}
@@ -547,8 +548,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);
}
@@ -559,9 +560,8 @@ 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";
}
@@ -584,9 +584,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.
@@ -598,61 +598,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 *);
-
/*
* 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 = (char **) ckrealloc((char *) env.cache,
+ (env.cacheSize + growth) * sizeof(char *));
+ env.cache[env.cacheSize] = newStr;
+ (void) memset(env.cache+env.cacheSize+1, (int) 0,
+ (size_t) (growth-1) * sizeof(char*));
+ env.cacheSize += growth;
}
}
@@ -661,9 +654,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.
@@ -675,26 +668,119 @@ 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((char *) env.cache);
+ env.cache = NULL;
+ env.cacheSize = 0;
#ifndef USE_PUTENV
- environSize = 0;
+ env.ourEnvironSize = 0;
#endif
}
}
+#if defined(__CYGWIN__)
+
+/*
+ * When using cygwin, when an environment variable changes, we need to synch
+ * with both the cygwin environment (in case the application C code calls
+ * 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(
+ char *str)
+{
+ char *name, *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;
+ if (*value == '\0') {
+ value = NULL;
+ }
+
+ /*
+ * Set the cygwin environment variable.
+ */
+
+#undef putenv
+ if (value == NULL) {
+ unsetenv(name);
+ } else {
+ putenv(str);
+ }
+
+ /*
+ * Before changing the environment variable in Windows, if this is PATH,
+ * we need to convert the value back to a Windows style path.
+ *
+ * FIXME: The calling program may know it is running under windows, and
+ * 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) {
+ SetEnvironmentVariableA("PATH", NULL);
+ unsetenv("PATH");
+ }
+
+ SetEnvironmentVariableA(name, value);
+ } else {
+ char *buf;
+
+ /*
+ * 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 = alloca(size + 1);
+ cygwin_posix_to_win32_path_list(value, buf);
+ }
+
+ SetEnvironmentVariableA(name, buf);
+ }
+}
+#endif /* __CYGWIN__ */
+
/*
* Local Variables:
* mode: c