/*
* tclEnv.c --
*
* 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.26 2005/10/05 08:03:35 hobbs Exp $
*/
#include "tclInt.h"
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
* 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
* subsystem swaps around the environ array
* like we do.
*/
static int environSize = 0; /* 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>
char **environ = NULL;
#endif
/*
* 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));
#if defined (__CYGWIN__) && defined(__WIN32__)
static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
#endif
/*
*----------------------------------------------------------------------
*
* TclSetupEnv --
*
* 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.
*
*----------------------------------------------------------------------
*/
void
TclSetupEnv(interp)
Tcl_Interp *interp; /* Interpreter whose "env" array is to be
* managed. */
{
Tcl_DString envString;
char *p1, *p2;
int i;
/*
* For MacOS X
*/
#if defined(__APPLE__) && defined(__DYNAMIC__)
environ = *_NSGetEnviron();
#endif
/*
* 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_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 seem to happen occasionally under some
* versions of Solaris; ignore the entry.
*/
continue;
}
p2++;
p2[-1] = '\0';
Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&envString);
}
Tcl_MutexUnlock(&envMutex);
}
Tcl_TraceVar2(interp, "env", (char *) NULL,
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
(ClientData) NULL);
}
/*
*----------------------------------------------------------------------
*
* 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 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.
*
* Side effects:
* The environ array gets updated.
*
*----------------------------------------------------------------------
*/
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). */
{
Tcl_DString envString;
int index, length, nameLength;
char *p, *oldValue;
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.
*/
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
if (index == -1) {
#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
* 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);
}
environ = ourEnviron = newEnviron;
environSize = length + 5;
#if defined(__APPLE__) && defined(__DYNAMIC__)
{
char ***e = _NSGetEnviron();
*e = environ;
}
#endif /* __APPLE__ && __DYNAMIC__ */
}
index = length;
environ[index + 1] = NULL;
#endif /* USE_PUTENV */
oldValue = NULL;
nameLength = strlen(name);
} else {
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.
*/
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. 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);
/*
* Copy the native string to heap memory.
*/
p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
strcpy(p, p2);
Tcl_DStringFree(&envString);
#ifdef USE_PUTENV
/*
* Update the system environment.
*/
putenv(p);
index = TclpFindVariable(name, &length);
#else
environ[index] = p;
#endif
/*
* 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.
*/
ckfree(p);
#endif
}
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.
*/
Tcl_FSMountsChanged(NULL);
}
}
/*
*----------------------------------------------------------------------
*
* 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 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.
*
*----------------------------------------------------------------------
*/
int
Tcl_PutEnv(assignment)
CONST char *assignment; /* Info about environment variable in the form
* NAME=value. (native) */
{
Tcl_DString nameString;
CONST char *name;
char *value;
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.
*/
name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
value = strchr(name, '=');
if ((value != NULL) && (value != name)) {
value[0] = '\0';
TclSetEnv(name, value+1);
}
Tcl_DStringFree(&nameString);
return 0;
}
/*
*----------------------------------------------------------------------
*
* 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".
*
* Results:
* None.
*
* Side effects:
* Interpreters are updated, as is environ.
*
*----------------------------------------------------------------------
*/
void
TclUnsetEnv(name)
CONST char *name; /* Name of variable to remove (UTF-8). */
{
char *oldValue;
int length;
int index;
#ifdef USE_PUTENV_FOR_UNSET
Tcl_DString envString;
char *string;
#else
char **envPtr;
#endif
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.
*/
if (index == -1) {
Tcl_MutexUnlock(&envMutex);
return;
}
/*
* Remember the old value so we can free it if Tcl created the string.
*/
oldValue = environ[index];
/*
* Update the system environment. This must be done before we update the
* interpreters or we will recurse.
*/
#ifdef USE_PUTENV_FOR_UNSET
/*
* 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);
string[length] = '=';
string[length+1] = '\0';
#else
string = ckalloc((unsigned int) length+1);
memcpy((VOID *) string, (VOID *) name, (size_t) length);
string[length] = '\0';
#endif
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
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.
*/
if (environ[index] == string) {
ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
/*
* This putenv() copies instead of taking ownership.
*/
ckfree(string);
#endif
}
#else
for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
if (*envPtr == NULL) {
break;
}
}
ReplaceString(oldValue, NULL);
#endif
Tcl_MutexUnlock(&envMutex);
}
/*
*---------------------------------------------------------------------------
*
* TclGetEnv --
*
* Retrieve the value of an environment variable.
*
* 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.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
CONST char *
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;
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 == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
}
/*
*----------------------------------------------------------------------
*
* EnvTraceProc --
*
* 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).
*
*----------------------------------------------------------------------
*/
/* 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. */
{
/*
* For array traces, let TclSetupEnv do all the work.
*/
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
return NULL;
}
/*
* If name2 is NULL, then return and do nothing.
*/
if (name2 == NULL) {
return NULL;
}
/*
* If a value is being set, call TclSetEnv to do all of the work.
*/
if (flags & TCL_TRACE_WRITES) {
CONST 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;
CONST 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);
}
return NULL;
}
/*
*----------------------------------------------------------------------
*
* 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.
*
* Results:
* None.
*
* Side effects:
* May free the old string.
*
*----------------------------------------------------------------------
*/
static void
ReplaceString(oldStr, newStr)
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.
*/
for (i = 0; i < cacheSize; i++) {
if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
break;
}
}
if (i < cacheSize) {
/*
* Replace or delete the old value.
*/
if (environCache[i]) {
ckfree(environCache[i]);
}
if (newStr) {
environCache[i] = newStr;
} else {
for (; i < cacheSize-1; i++) {
environCache[i] = environCache[i+1];
}
environCache[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);
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;
}
}
/*
*----------------------------------------------------------------------
*
* 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.
*
* Results:
* None.
*
* Side effects:
* May deallocate storage.
*
*----------------------------------------------------------------------
*/
void
TclFinalizeEnvironment()
{
/*
* 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,
* 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;
#ifndef USE_PUTENV
environSize = 0;
#endif
}
}
#if defined(__CYGWIN__) && defined(__WIN32__)
#include <windows.h>
/*
* 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).
*/
static void
TclCygwinPutenv(str)
const 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) {
/* 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) {
SetEnvironmentVariable("PATH", (char *) NULL);
unsetenv("PATH");
}
SetEnvironmentVariable(name, value);
} else {
char *buf;
/*
* Eliminate any Path variable, to prevent any confusion.
*/
SetEnvironmentVariable("Path", (char *) 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);
}
SetEnvironmentVariable(name, buf);
}
}
#endif /* __CYGWIN__ && __WIN32__ */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/