sl@0: /* 
sl@0:  * tclEnv.c --
sl@0:  *
sl@0:  *	Tcl support for environment variables, including a setenv
sl@0:  *	procedure.  This file contains the generic portion of the
sl@0:  *	environment module.  It is primarily responsible for keeping
sl@0:  *	the "env" arrays in sync with the system environment variables.
sl@0:  *
sl@0:  * Copyright (c) 1991-1994 The Regents of the University of California.
sl@0:  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
sl@0:  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclEnv.c,v 1.20.2.3 2006/10/31 22:25:08 das Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: 
sl@0: TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ */
sl@0: 
sl@0: static int cacheSize = 0;	/* Number of env strings in environCache. */
sl@0: static char **environCache = NULL;
sl@0: 				/* Array containing all of the environment
sl@0: 				 * strings that Tcl has allocated. */
sl@0: 
sl@0: #ifndef USE_PUTENV
sl@0: static char **ourEnviron = NULL;/* Cache of the array that we allocate.
sl@0: 				 * We need to track this in case another
sl@0: 				 * subsystem swaps around the environ array
sl@0: 				 * like we do.
sl@0: 				 */
sl@0: static int environSize = 0;	/* Non-zero means that the environ array was
sl@0: 				 * malloced and has this many total entries
sl@0: 				 * allocated to it (not all may be in use at
sl@0: 				 * once).  Zero means that the environment
sl@0: 				 * array is in its original static state. */
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * For MacOS X
sl@0:  */
sl@0: #if defined(__APPLE__) && defined(__DYNAMIC__)
sl@0: #include <crt_externs.h>
sl@0: __private_extern__ char **environ;
sl@0: char **environ = NULL;
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * Declarations for local procedures defined in this file:
sl@0:  */
sl@0: 
sl@0: static char *		EnvTraceProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    Tcl_Interp *interp, CONST char *name1, 
sl@0: 			    CONST char *name2, int flags));
sl@0: static void		ReplaceString _ANSI_ARGS_((CONST char *oldStr,
sl@0: 			    char *newStr));
sl@0: void			TclSetEnv _ANSI_ARGS_((CONST char *name,
sl@0: 			    CONST char *value));
sl@0: void			TclUnsetEnv _ANSI_ARGS_((CONST char *name));
sl@0: 
sl@0: #if defined (__CYGWIN__) && defined(__WIN32__)
sl@0: static void		TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclSetupEnv --
sl@0:  *
sl@0:  *	This procedure is invoked for an interpreter to make environment
sl@0:  *	variables accessible from that interpreter via the "env"
sl@0:  *	associative array.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The interpreter is added to a list of interpreters managed
sl@0:  *	by us, so that its view of envariables can be kept consistent
sl@0:  *	with the view in other interpreters.  If this is the first
sl@0:  *	call to TclSetupEnv, then additional initialization happens,
sl@0:  *	such as copying the environment to dynamically-allocated space
sl@0:  *	for ease of management.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclSetupEnv(interp)
sl@0:     Tcl_Interp *interp;		/* Interpreter whose "env" array is to be
sl@0: 				 * managed. */
sl@0: {
sl@0:     Tcl_DString envString;
sl@0:     char *p1, *p2;
sl@0:     int i;
sl@0: 
sl@0:     /*
sl@0:      * For MacOS X
sl@0:      */
sl@0: #if defined(__APPLE__) && defined(__DYNAMIC__)
sl@0:     environ = *_NSGetEnviron();
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * Synchronize the values in the environ array with the contents
sl@0:      * of the Tcl "env" variable.  To do this:
sl@0:      *    1) Remove the trace that fires when the "env" var is unset.
sl@0:      *    2) Unset the "env" variable.
sl@0:      *    3) If there are no environ variables, create an empty "env"
sl@0:      *       array.  Otherwise populate the array with current values.
sl@0:      *    4) Add a trace that synchronizes the "env" array.
sl@0:      */
sl@0:     
sl@0:     Tcl_UntraceVar2(interp, "env", (char *) NULL,
sl@0: 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
sl@0: 	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
sl@0: 	    (ClientData) NULL);
sl@0:     
sl@0:     Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 
sl@0:     
sl@0:     if (environ[0] == NULL) {
sl@0: 	Tcl_Obj *varNamePtr;
sl@0: 	
sl@0: 	varNamePtr = Tcl_NewStringObj("env", -1);
sl@0: 	Tcl_IncrRefCount(varNamePtr);
sl@0: 	TclArraySet(interp, varNamePtr, NULL);	
sl@0: 	Tcl_DecrRefCount(varNamePtr);
sl@0:     } else {
sl@0: 	Tcl_MutexLock(&envMutex);
sl@0: 	for (i = 0; environ[i] != NULL; i++) {
sl@0: 	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
sl@0: 	    p2 = strchr(p1, '=');
sl@0: 	    if (p2 == NULL) {
sl@0: 		/*
sl@0: 		 * This condition seem to happen occasionally under some
sl@0: 		 * versions of Solaris; ignore the entry.
sl@0: 		 */
sl@0: 		
sl@0: 		continue;
sl@0: 	    }
sl@0: 	    p2++;
sl@0: 	    p2[-1] = '\0';
sl@0: 	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);	
sl@0: 	    Tcl_DStringFree(&envString);
sl@0: 	}
sl@0: 	Tcl_MutexUnlock(&envMutex);
sl@0:     }
sl@0: 
sl@0:     Tcl_TraceVar2(interp, "env", (char *) NULL,
sl@0: 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
sl@0: 	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
sl@0: 	    (ClientData) NULL);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclSetEnv --
sl@0:  *
sl@0:  *	Set an environment variable, replacing an existing value
sl@0:  *	or creating a new variable if there doesn't exist a variable
sl@0:  *	by the given name.  This procedure is intended to be a
sl@0:  *	stand-in for the  UNIX "setenv" procedure so that applications
sl@0:  *	using that procedure will interface properly to Tcl.  To make
sl@0:  *	it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The environ array gets updated.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclSetEnv(name, value)
sl@0:     CONST char *name;		/* Name of variable whose value is to be
sl@0: 				 * set (UTF-8). */
sl@0:     CONST char *value;		/* New value for variable (UTF-8). */
sl@0: {
sl@0:     Tcl_DString envString;
sl@0:     int index, length, nameLength;
sl@0:     char *p, *oldValue;
sl@0:     CONST char *p2;
sl@0: 
sl@0:     /*
sl@0:      * Figure out where the entry is going to go.  If the name doesn't
sl@0:      * already exist, enlarge the array if necessary to make room.  If the
sl@0:      * name exists, free its old entry.
sl@0:      */
sl@0: 
sl@0:     Tcl_MutexLock(&envMutex);
sl@0:     index = TclpFindVariable(name, &length);
sl@0: 
sl@0:     if (index == -1) {
sl@0: #ifndef USE_PUTENV
sl@0: 	/*
sl@0: 	 * We need to handle the case where the environment may be changed
sl@0: 	 * outside our control.  environSize is only valid if the current
sl@0: 	 * environment is the one we allocated. [Bug 979640]
sl@0: 	 */
sl@0: 	if ((ourEnviron != environ) || ((length + 2) > environSize)) {
sl@0: 	    char **newEnviron;
sl@0: 
sl@0: 	    newEnviron = (char **) ckalloc((unsigned)
sl@0: 		    ((length + 5) * sizeof(char *)));
sl@0: 	    memcpy((VOID *) newEnviron, (VOID *) environ,
sl@0: 		    length*sizeof(char *));
sl@0: 	    if ((environSize != 0) && (ourEnviron != NULL)) {
sl@0: 		ckfree((char *) ourEnviron);
sl@0: 	    }
sl@0: 	    environ = ourEnviron = newEnviron;
sl@0: 	    environSize = length + 5;
sl@0: #if defined(__APPLE__) && defined(__DYNAMIC__)
sl@0: 	    {
sl@0: 	    char ***e = _NSGetEnviron();
sl@0: 	    *e = environ;
sl@0: 	    }
sl@0: #endif
sl@0: 	}
sl@0: 	index = length;
sl@0: 	environ[index + 1] = NULL;
sl@0: #endif
sl@0: 	oldValue = NULL;
sl@0: 	nameLength = strlen(name);
sl@0:     } else {
sl@0: 	CONST char *env;
sl@0: 
sl@0: 	/*
sl@0: 	 * Compare the new value to the existing value.  If they're
sl@0: 	 * the same then quit immediately (e.g. don't rewrite the
sl@0: 	 * value or propagate it to other interpreters).  Otherwise,
sl@0: 	 * when there are N interpreters there will be N! propagations
sl@0: 	 * of the same value among the interpreters.
sl@0: 	 */
sl@0: 
sl@0: 	env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
sl@0: 	if (strcmp(value, (env + length + 1)) == 0) {
sl@0: 	    Tcl_DStringFree(&envString);
sl@0: 	    Tcl_MutexUnlock(&envMutex);
sl@0: 	    return;
sl@0: 	}
sl@0: 	Tcl_DStringFree(&envString);
sl@0: 
sl@0: 	oldValue = environ[index];
sl@0: 	nameLength = length;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Create a new entry.  Build a complete UTF string that contains
sl@0:      * a "name=value" pattern.  Then convert the string to the native
sl@0:      * encoding, and set the environ array value.
sl@0:      */
sl@0: 
sl@0:     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
sl@0:     strcpy(p, name);
sl@0:     p[nameLength] = '=';
sl@0:     strcpy(p+nameLength+1, value);
sl@0:     p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
sl@0: 
sl@0:     /*
sl@0:      * Copy the native string to heap memory.
sl@0:      */
sl@0:     
sl@0:     p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
sl@0:     strcpy(p, p2);
sl@0:     Tcl_DStringFree(&envString);
sl@0: 
sl@0: #ifdef USE_PUTENV
sl@0:     /*
sl@0:      * Update the system environment.
sl@0:      */
sl@0: 
sl@0:     putenv(p);
sl@0:     index = TclpFindVariable(name, &length);
sl@0: #else
sl@0:     environ[index] = p;
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * Watch out for versions of putenv that copy the string (e.g. VC++).
sl@0:      * In this case we need to free the string immediately.  Otherwise
sl@0:      * update the string in the cache.
sl@0:      */
sl@0: 
sl@0:     if ((index != -1) && (environ[index] == p)) {
sl@0: 	ReplaceString(oldValue, p);
sl@0: #ifdef HAVE_PUTENV_THAT_COPIES
sl@0:     } else {
sl@0: 	/* This putenv() copies instead of taking ownership */
sl@0: 	ckfree(p);
sl@0: #endif
sl@0:     }
sl@0: 
sl@0:     Tcl_MutexUnlock(&envMutex);
sl@0:     
sl@0:     if (!strcmp(name, "HOME")) {
sl@0: 	/* 
sl@0: 	 * If the user's home directory has changed, we must invalidate
sl@0: 	 * the filesystem cache, because '~' expansions will now be
sl@0: 	 * incorrect.
sl@0: 	 */
sl@0:         Tcl_FSMountsChanged(NULL);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_PutEnv --
sl@0:  *
sl@0:  *	Set an environment variable.  Similar to setenv except that
sl@0:  *	the information is passed in a single string of the form
sl@0:  *	NAME=value, rather than as separate name strings.  This procedure
sl@0:  *	is intended to be a stand-in for the  UNIX "putenv" procedure
sl@0:  *	so that applications using that procedure will interface
sl@0:  *	properly to Tcl.  To make it a stand-in, the Makefile will
sl@0:  *	define "Tcl_PutEnv" to "putenv".
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The environ array gets updated, as do all of the interpreters
sl@0:  *	that we manage.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C int
sl@0: Tcl_PutEnv(string)
sl@0:     CONST char *string;		/* Info about environment variable in the
sl@0: 				 * form NAME=value. (native) */
sl@0: {
sl@0:     Tcl_DString nameString;   
sl@0:     CONST char *name;
sl@0:     char *value;
sl@0: 
sl@0:     if (string == NULL) {
sl@0: 	return 0;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * First convert the native string to UTF.  Then separate the
sl@0:      * string into name and value parts, and call TclSetEnv to do
sl@0:      * all of the real work.
sl@0:      */
sl@0: 
sl@0:     name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
sl@0:     value = strchr(name, '=');
sl@0: 
sl@0:     if ((value != NULL) && (value != name)) {
sl@0: 	value[0] = '\0';
sl@0: 	TclSetEnv(name, value+1);
sl@0:     }
sl@0: 
sl@0:     Tcl_DStringFree(&nameString);
sl@0:     return 0;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclUnsetEnv --
sl@0:  *
sl@0:  *	Remove an environment variable, updating the "env" arrays
sl@0:  *	in all interpreters managed by us.  This function is intended
sl@0:  *	to replace the UNIX "unsetenv" function (but to do this the
sl@0:  *	Makefile must be modified to redefine "TclUnsetEnv" to
sl@0:  *	"unsetenv".
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Interpreters are updated, as is environ.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclUnsetEnv(name)
sl@0:     CONST char *name;		/* Name of variable to remove (UTF-8). */
sl@0: {
sl@0:     char *oldValue;
sl@0:     int length;
sl@0:     int index;
sl@0: #ifdef USE_PUTENV_FOR_UNSET
sl@0:     Tcl_DString envString;
sl@0:     char *string;
sl@0: #else
sl@0:     char **envPtr;
sl@0: #endif
sl@0: 
sl@0:     Tcl_MutexLock(&envMutex);
sl@0:     index = TclpFindVariable(name, &length);
sl@0: 
sl@0:     /*
sl@0:      * First make sure that the environment variable exists to avoid
sl@0:      * doing needless work and to avoid recursion on the unset.
sl@0:      */
sl@0: 
sl@0:     if (index == -1) {
sl@0: 	Tcl_MutexUnlock(&envMutex);
sl@0: 	return;
sl@0:     }
sl@0:     /*
sl@0:      * Remember the old value so we can free it if Tcl created the string.
sl@0:      */
sl@0: 
sl@0:     oldValue = environ[index];
sl@0: 
sl@0:     /*
sl@0:      * Update the system environment.  This must be done before we 
sl@0:      * update the interpreters or we will recurse.
sl@0:      */
sl@0: 
sl@0: #ifdef USE_PUTENV_FOR_UNSET
sl@0:     /*
sl@0:      * For those platforms that support putenv to unset, Linux indicates
sl@0:      * that no = should be included, and Windows requires it.
sl@0:      */
sl@0: #ifdef WIN32
sl@0:     string = ckalloc((unsigned int) length+2);
sl@0:     memcpy((VOID *) string, (VOID *) name, (size_t) length);
sl@0:     string[length] = '=';
sl@0:     string[length+1] = '\0';
sl@0: #else
sl@0:     string = ckalloc((unsigned int) length+1);
sl@0:     memcpy((VOID *) string, (VOID *) name, (size_t) length);
sl@0:     string[length] = '\0';
sl@0: #endif
sl@0: 
sl@0:     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
sl@0:     string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
sl@0:     strcpy(string, Tcl_DStringValue(&envString));
sl@0:     Tcl_DStringFree(&envString);
sl@0: 
sl@0:     putenv(string);
sl@0: 
sl@0:     /*
sl@0:      * Watch out for versions of putenv that copy the string (e.g. VC++).
sl@0:      * In this case we need to free the string immediately.  Otherwise
sl@0:      * update the string in the cache.
sl@0:      */
sl@0: 
sl@0:     if (environ[index] == string) {
sl@0: 	ReplaceString(oldValue, string);
sl@0: #ifdef HAVE_PUTENV_THAT_COPIES
sl@0:     } else {
sl@0: 	/* This putenv() copies instead of taking ownership */
sl@0: 	ckfree(string);
sl@0: #endif
sl@0:     }
sl@0: #else
sl@0:     for (envPtr = environ+index+1; ; envPtr++) {
sl@0: 	envPtr[-1] = *envPtr;
sl@0: 	if (*envPtr == NULL) {
sl@0: 	    break;
sl@0: 	}
sl@0:     }
sl@0:     ReplaceString(oldValue, NULL);
sl@0: #endif
sl@0: 
sl@0:     Tcl_MutexUnlock(&envMutex);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclGetEnv --
sl@0:  *
sl@0:  *	Retrieve the value of an environment variable.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The result is a pointer to a string specifying the value of the
sl@0:  *	environment variable, or NULL if that environment variable does
sl@0:  *	not exist.  Storage for the result string is allocated in valuePtr;
sl@0:  *	the caller must call Tcl_DStringFree() when the result is no
sl@0:  *	longer needed.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: CONST char *
sl@0: TclGetEnv(name, valuePtr)
sl@0:     CONST char *name;		/* Name of environment variable to find
sl@0: 				 * (UTF-8). */
sl@0:     Tcl_DString *valuePtr;	/* Uninitialized or free DString in which
sl@0: 				 * the value of the environment variable is
sl@0: 				 * stored. */
sl@0: {
sl@0:     int length, index;
sl@0:     CONST char *result;
sl@0: 
sl@0:     Tcl_MutexLock(&envMutex);
sl@0:     index = TclpFindVariable(name, &length);
sl@0:     result = NULL;
sl@0:     if (index != -1) {
sl@0: 	Tcl_DString envStr;
sl@0: 	
sl@0: 	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
sl@0: 	result += length;
sl@0: 	if (*result == '=') {
sl@0: 	    result++;
sl@0: 	    Tcl_DStringInit(valuePtr);
sl@0: 	    Tcl_DStringAppend(valuePtr, result, -1);
sl@0: 	    result = Tcl_DStringValue(valuePtr);
sl@0: 	} else {
sl@0: 	    result = NULL;
sl@0: 	}
sl@0: 	Tcl_DStringFree(&envStr);
sl@0:     }
sl@0:     Tcl_MutexUnlock(&envMutex);
sl@0:     return result;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * EnvTraceProc --
sl@0:  *
sl@0:  *	This procedure is invoked whenever an environment variable
sl@0:  *	is read, modified or deleted.  It propagates the change to the global
sl@0:  *	"environ" array.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Always returns NULL to indicate success.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Environment variable changes get propagated.  If the whole
sl@0:  *	"env" array is deleted, then we stop managing things for
sl@0:  *	this interpreter (usually this happens because the whole
sl@0:  *	interpreter is being deleted).
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: 	/* ARGSUSED */
sl@0: static char *
sl@0: EnvTraceProc(clientData, interp, name1, name2, flags)
sl@0:     ClientData clientData;	/* Not used. */
sl@0:     Tcl_Interp *interp;		/* Interpreter whose "env" variable is
sl@0: 				 * being modified. */
sl@0:     CONST char *name1;		/* Better be "env". */
sl@0:     CONST char *name2;		/* Name of variable being modified, or NULL
sl@0: 				 * if whole array is being deleted (UTF-8). */
sl@0:     int flags;			/* Indicates what's happening. */
sl@0: {
sl@0:     /*
sl@0:      * For array traces, let TclSetupEnv do all the work.
sl@0:      */
sl@0: 
sl@0:     if (flags & TCL_TRACE_ARRAY) {
sl@0: 	TclSetupEnv(interp);
sl@0: 	return NULL;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If name2 is NULL, then return and do nothing.
sl@0:      */
sl@0:      
sl@0:     if (name2 == NULL) {
sl@0: 	return NULL;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If a value is being set, call TclSetEnv to do all of the work.
sl@0:      */
sl@0: 
sl@0:     if (flags & TCL_TRACE_WRITES) {
sl@0: 	CONST char *value;
sl@0: 	
sl@0: 	value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
sl@0: 	TclSetEnv(name2, value);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If a value is being read, call TclGetEnv to do all of the work.
sl@0:      */
sl@0: 
sl@0:     if (flags & TCL_TRACE_READS) {
sl@0: 	Tcl_DString valueString;
sl@0: 	CONST char *value;
sl@0: 
sl@0: 	value = TclGetEnv(name2, &valueString);
sl@0: 	if (value == NULL) {
sl@0: 	    return "no such variable";
sl@0: 	}
sl@0: 	Tcl_SetVar2(interp, name1, name2, value, 0);
sl@0: 	Tcl_DStringFree(&valueString);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * For unset traces, let TclUnsetEnv do all the work.
sl@0:      */
sl@0: 
sl@0:     if (flags & TCL_TRACE_UNSETS) {
sl@0: 	TclUnsetEnv(name2);
sl@0:     }
sl@0:     return NULL;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * ReplaceString --
sl@0:  *
sl@0:  *	Replace one string with another in the environment variable
sl@0:  *	cache.  The cache keeps track of all of the environment
sl@0:  *	variables that Tcl has modified so they can be freed later.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May free the old string.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: ReplaceString(oldStr, newStr)
sl@0:     CONST char *oldStr;		/* Old environment string. */
sl@0:     char *newStr;		/* New environment string. */
sl@0: {
sl@0:     int i;
sl@0:     char **newCache;
sl@0: 
sl@0:     /*
sl@0:      * Check to see if the old value was allocated by Tcl.  If so,
sl@0:      * it needs to be deallocated to avoid memory leaks.  Note that this
sl@0:      * algorithm is O(n), not O(1).  This will result in n-squared behavior
sl@0:      * if lots of environment changes are being made.
sl@0:      */
sl@0: 
sl@0:     for (i = 0; i < cacheSize; i++) {
sl@0: 	if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
sl@0: 	    break;
sl@0: 	}
sl@0:     }
sl@0:     if (i < cacheSize) {
sl@0: 	/*
sl@0: 	 * Replace or delete the old value.
sl@0: 	 */
sl@0: 
sl@0: 	if (environCache[i]) {
sl@0: 	    ckfree(environCache[i]);
sl@0: 	}
sl@0: 
sl@0: 	if (newStr) {
sl@0: 	    environCache[i] = newStr;
sl@0: 	} else {
sl@0: 	    for (; i < cacheSize-1; i++) {
sl@0: 		environCache[i] = environCache[i+1];
sl@0: 	    }
sl@0: 	    environCache[cacheSize-1] = NULL;
sl@0: 	}
sl@0:     } else {
sl@0:         int allocatedSize = (cacheSize + 5) * sizeof(char *);
sl@0: 
sl@0: 	/*
sl@0: 	 * We need to grow the cache in order to hold the new string.
sl@0: 	 */
sl@0: 
sl@0: 	newCache = (char **) ckalloc((unsigned) allocatedSize);
sl@0:         (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
sl@0: 
sl@0: 	if (environCache) {
sl@0: 	    memcpy((VOID *) newCache, (VOID *) environCache,
sl@0: 		    (size_t) (cacheSize * sizeof(char*)));
sl@0: 	    ckfree((char *) environCache);
sl@0: 	}
sl@0: 	environCache = newCache;
sl@0: 	environCache[cacheSize] = newStr;
sl@0: 	environCache[cacheSize+1] = NULL;
sl@0: 	cacheSize += 5;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclFinalizeEnvironment --
sl@0:  *
sl@0:  *	This function releases any storage allocated by this module
sl@0:  *	that isn't still in use by the global environment.  Any
sl@0:  *	strings that are still in the environment will be leaked.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May deallocate storage.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclFinalizeEnvironment()
sl@0: {
sl@0:     /*
sl@0:      * For now we just deallocate the cache array and none of the environment
sl@0:      * strings.  This may leak more memory that strictly necessary, since some
sl@0:      * of the strings may no longer be in the environment.  However,
sl@0:      * determining which ones are ok to delete is n-squared, and is pretty
sl@0:      * unlikely, so we don't bother.
sl@0:      */
sl@0: 
sl@0:     if (environCache) {
sl@0: 	ckfree((char *) environCache);
sl@0: 	environCache = NULL;
sl@0: 	cacheSize    = 0;
sl@0: #ifndef USE_PUTENV
sl@0: 	environSize  = 0;
sl@0: #endif
sl@0:     }
sl@0: }
sl@0: 
sl@0: #if defined(__CYGWIN__) && defined(__WIN32__)
sl@0: 
sl@0: #include <windows.h>
sl@0: 
sl@0: /*
sl@0:  * When using cygwin, when an environment variable changes, we need to synch
sl@0:  * with both the cygwin environment (in case the application C code calls
sl@0:  * fork) and the Windows environment (in case the application TCL code calls
sl@0:  * exec, which calls the Windows CreateProcess function).
sl@0:  */
sl@0: 
sl@0: static void
sl@0: TclCygwinPutenv(str)
sl@0:     const char *str;
sl@0: {
sl@0:     char *name, *value;
sl@0: 
sl@0:     /* Get the name and value, so that we can change the environment
sl@0:        variable for Windows.  */
sl@0:     name = (char *) alloca (strlen (str) + 1);
sl@0:     strcpy (name, str);
sl@0:     for (value = name; *value != '=' && *value != '\0'; ++value)
sl@0: 	;
sl@0:     if (*value == '\0') {
sl@0: 	    /* Can't happen.  */
sl@0: 	    return;
sl@0: 	}
sl@0:     *value = '\0';
sl@0:     ++value;
sl@0:     if (*value == '\0') {
sl@0: 	value = NULL;
sl@0:     }
sl@0: 
sl@0:     /* Set the cygwin environment variable.  */
sl@0: #undef putenv
sl@0:     if (value == NULL) {
sl@0: 	unsetenv (name);
sl@0:     } else {
sl@0: 	putenv(str);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Before changing the environment variable in Windows, if this is PATH,
sl@0:      * we need to convert the value back to a Windows style path.
sl@0:      *
sl@0:      * FIXME: The calling program may know it is running under windows, and
sl@0:      * may have set the path to a Windows path, or, worse, appended or
sl@0:      * prepended a Windows path to PATH.
sl@0:      */
sl@0:     if (strcmp (name, "PATH") != 0) {
sl@0: 	/* If this is Path, eliminate any PATH variable, to prevent any
sl@0: 	   confusion.  */
sl@0: 	if (strcmp (name, "Path") == 0) {
sl@0: 	    SetEnvironmentVariable ("PATH", (char *) NULL);
sl@0: 	    unsetenv ("PATH");
sl@0: 	}
sl@0: 
sl@0: 	SetEnvironmentVariable (name, value);
sl@0:     } else {
sl@0: 	char *buf;
sl@0: 
sl@0: 	    /* Eliminate any Path variable, to prevent any confusion.  */
sl@0: 	SetEnvironmentVariable ("Path", (char *) NULL);
sl@0: 	unsetenv ("Path");
sl@0: 
sl@0: 	if (value == NULL) {
sl@0: 	    buf = NULL;
sl@0: 	} else {
sl@0: 	    int size;
sl@0: 
sl@0: 	    size = cygwin_posix_to_win32_path_list_buf_size (value);
sl@0: 	    buf = (char *) alloca (size + 1);
sl@0: 	    cygwin_posix_to_win32_path_list (value, buf);
sl@0: 	}
sl@0: 
sl@0: 	SetEnvironmentVariable (name, buf);
sl@0:     }
sl@0: }
sl@0: 
sl@0: #endif /* __CYGWIN__ && __WIN32__ */