/*
|
/*
|
* tclEnv.c --
|
* tclEnv.c --
|
*
|
*
|
* Tcl support for environment variables, including a setenv
|
* Tcl support for environment variables, including a setenv
|
* procedure. This file contains the generic portion of the
|
* procedure. This file contains the generic portion of the
|
* environment module. It is primarily responsible for keeping
|
* environment module. It is primarily responsible for keeping
|
* the "env" arrays in sync with the system environment variables.
|
* the "env" arrays in sync with the system environment variables.
|
*
|
*
|
* Copyright (c) 1991-1994 The Regents of the University of California.
|
* Copyright (c) 1991-1994 The Regents of the University of California.
|
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
*
|
*
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*
|
*
|
* RCS: @(#) $Id: tclEnv.c,v 1.1.1.1 2002-01-16 10:25:26 markom Exp $
|
* RCS: @(#) $Id: tclEnv.c,v 1.1.1.1 2002-01-16 10:25:26 markom Exp $
|
*/
|
*/
|
|
|
#include "tclInt.h"
|
#include "tclInt.h"
|
#include "tclPort.h"
|
#include "tclPort.h"
|
|
|
/* CYGNUS LOCAL */
|
/* CYGNUS LOCAL */
|
#if defined(__CYGWIN__) && defined(__WIN32__)
|
#if defined(__CYGWIN__) && defined(__WIN32__)
|
|
|
/* Under cygwin, the environment is imported from the cygwin DLL. */
|
/* Under cygwin, the environment is imported from the cygwin DLL. */
|
|
|
extern char ***_imp____cygwin_environ;
|
extern char ***_imp____cygwin_environ;
|
|
|
#define environ (*_imp____cygwin_environ)
|
#define environ (*_imp____cygwin_environ)
|
|
|
/* We need to use a special putenv function to handle PATH. */
|
/* We need to use a special putenv function to handle PATH. */
|
#ifndef USE_PUTENV
|
#ifndef USE_PUTENV
|
#define USE_PUTENV
|
#define USE_PUTENV
|
#endif
|
#endif
|
#define putenv TclCygwin32Putenv
|
#define putenv TclCygwin32Putenv
|
|
|
#endif
|
#endif
|
/* END CYGNUS LOCAL */
|
/* END CYGNUS LOCAL */
|
|
|
/*
|
/*
|
* The structure below is used to keep track of all of the interpereters
|
* 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
|
* for which we're managing the "env" array. It's needed so that they
|
* can all be updated whenever an environment variable is changed
|
* can all be updated whenever an environment variable is changed
|
* anywhere.
|
* anywhere.
|
*/
|
*/
|
|
|
typedef struct EnvInterp {
|
typedef struct EnvInterp {
|
Tcl_Interp *interp; /* Interpreter for which we're managing
|
Tcl_Interp *interp; /* Interpreter for which we're managing
|
* the env array. */
|
* the env array. */
|
struct EnvInterp *nextPtr; /* Next in list of all such interpreters,
|
struct EnvInterp *nextPtr; /* Next in list of all such interpreters,
|
* or zero. */
|
* or zero. */
|
} EnvInterp;
|
} EnvInterp;
|
|
|
static EnvInterp *firstInterpPtr = NULL;
|
static EnvInterp *firstInterpPtr = NULL;
|
/* First in list of all managed interpreters,
|
/* First in list of all managed interpreters,
|
* or NULL if none. */
|
* or NULL if none. */
|
|
|
static int cacheSize = 0; /* Number of env strings in environCache. */
|
static int cacheSize = 0; /* Number of env strings in environCache. */
|
static char **environCache = NULL;
|
static char **environCache = NULL;
|
/* Array containing all of the environment
|
/* Array containing all of the environment
|
* strings that Tcl has allocated. */
|
* strings that Tcl has allocated. */
|
|
|
#ifndef USE_PUTENV
|
#ifndef USE_PUTENV
|
static int environSize = 0; /* Non-zero means that the environ array was
|
static int environSize = 0; /* Non-zero means that the environ array was
|
* malloced and has this many total entries
|
* malloced and has this many total entries
|
* allocated to it (not all may be in use at
|
* 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. */
|
* array is in its original static state. */
|
#endif
|
#endif
|
|
|
/*
|
/*
|
* Declarations for local procedures defined in this file:
|
* Declarations for local procedures defined in this file:
|
*/
|
*/
|
|
|
static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
|
static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
|
Tcl_Interp *interp, char *name1, char *name2,
|
Tcl_Interp *interp, char *name1, char *name2,
|
int flags));
|
int flags));
|
static int FindVariable _ANSI_ARGS_((CONST char *name,
|
static int FindVariable _ANSI_ARGS_((CONST char *name,
|
int *lengthPtr));
|
int *lengthPtr));
|
static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
|
static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
|
char *newStr));
|
char *newStr));
|
void TclSetEnv _ANSI_ARGS_((CONST char *name,
|
void TclSetEnv _ANSI_ARGS_((CONST char *name,
|
CONST char *value));
|
CONST char *value));
|
void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
|
void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
|
|
|
/* CYGNUS LOCAL */
|
/* CYGNUS LOCAL */
|
#if defined (__CYGWIN__) && defined(__WIN32__)
|
#if defined (__CYGWIN__) && defined(__WIN32__)
|
static void TclCygwin32Putenv _ANSI_ARGS_((CONST char *string));
|
static void TclCygwin32Putenv _ANSI_ARGS_((CONST char *string));
|
#endif
|
#endif
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclSetupEnv --
|
* TclSetupEnv --
|
*
|
*
|
* This procedure is invoked for an interpreter to make environment
|
* This procedure is invoked for an interpreter to make environment
|
* variables accessible from that interpreter via the "env"
|
* variables accessible from that interpreter via the "env"
|
* associative array.
|
* associative array.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The interpreter is added to a list of interpreters managed
|
* The interpreter is added to a list of interpreters managed
|
* by us, so that its view of envariables can be kept consistent
|
* by us, so that its view of envariables can be kept consistent
|
* with the view in other interpreters. If this is the first
|
* with the view in other interpreters. If this is the first
|
* call to Tcl_SetupEnv, then additional initialization happens,
|
* call to Tcl_SetupEnv, then additional initialization happens,
|
* such as copying the environment to dynamically-allocated space
|
* such as copying the environment to dynamically-allocated space
|
* for ease of management.
|
* for ease of management.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
TclSetupEnv(interp)
|
TclSetupEnv(interp)
|
Tcl_Interp *interp; /* Interpreter whose "env" array is to be
|
Tcl_Interp *interp; /* Interpreter whose "env" array is to be
|
* managed. */
|
* managed. */
|
{
|
{
|
EnvInterp *eiPtr;
|
EnvInterp *eiPtr;
|
char *p, *p2;
|
char *p, *p2;
|
Tcl_DString ds;
|
Tcl_DString ds;
|
int i, sz;
|
int i, sz;
|
|
|
#ifdef MAC_TCL
|
#ifdef MAC_TCL
|
if (environ == NULL) {
|
if (environ == NULL) {
|
environSize = TclMacCreateEnv();
|
environSize = TclMacCreateEnv();
|
}
|
}
|
#endif
|
#endif
|
|
|
/*
|
/*
|
* Next, initialize the DString we are going to use for copying
|
* Next, initialize the DString we are going to use for copying
|
* the names of the environment variables.
|
* the names of the environment variables.
|
*/
|
*/
|
|
|
Tcl_DStringInit(&ds);
|
Tcl_DStringInit(&ds);
|
|
|
/*
|
/*
|
* Next, add the interpreter to the list of those that we manage.
|
* Next, add the interpreter to the list of those that we manage.
|
*/
|
*/
|
|
|
eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
|
eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
|
eiPtr->interp = interp;
|
eiPtr->interp = interp;
|
eiPtr->nextPtr = firstInterpPtr;
|
eiPtr->nextPtr = firstInterpPtr;
|
firstInterpPtr = eiPtr;
|
firstInterpPtr = eiPtr;
|
|
|
/*
|
/*
|
* Store the environment variable values into the interpreter's
|
* Store the environment variable values into the interpreter's
|
* "env" array, and arrange for us to be notified on future
|
* "env" array, and arrange for us to be notified on future
|
* writes and unsets to that array.
|
* writes and unsets to that array.
|
*/
|
*/
|
|
|
(void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
|
(void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
|
for (i = 0; ; i++) {
|
for (i = 0; ; i++) {
|
p = environ[i];
|
p = environ[i];
|
if (p == NULL) {
|
if (p == NULL) {
|
break;
|
break;
|
}
|
}
|
for (p2 = p; *p2 != '='; p2++) {
|
for (p2 = p; *p2 != '='; p2++) {
|
if (*p2 == 0) {
|
if (*p2 == 0) {
|
/*
|
/*
|
* This condition doesn't seem like it should ever happen,
|
* This condition doesn't seem like it should ever happen,
|
* but it does seem to happen occasionally under some
|
* but it does seem to happen occasionally under some
|
* versions of Solaris; ignore the entry.
|
* versions of Solaris; ignore the entry.
|
*/
|
*/
|
|
|
goto nextEntry;
|
goto nextEntry;
|
}
|
}
|
}
|
}
|
sz = p2 - p;
|
sz = p2 - p;
|
Tcl_DStringSetLength(&ds, 0);
|
Tcl_DStringSetLength(&ds, 0);
|
Tcl_DStringAppend(&ds, p, sz);
|
Tcl_DStringAppend(&ds, p, sz);
|
(void) Tcl_SetVar2(interp, "env", Tcl_DStringValue(&ds),
|
(void) Tcl_SetVar2(interp, "env", Tcl_DStringValue(&ds),
|
p2+1, TCL_GLOBAL_ONLY);
|
p2+1, TCL_GLOBAL_ONLY);
|
nextEntry:
|
nextEntry:
|
continue;
|
continue;
|
}
|
}
|
Tcl_TraceVar2(interp, "env", (char *) NULL,
|
Tcl_TraceVar2(interp, "env", (char *) NULL,
|
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
|
TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
|
EnvTraceProc, (ClientData) NULL);
|
EnvTraceProc, (ClientData) NULL);
|
|
|
/*
|
/*
|
* Finally clean up the DString.
|
* Finally clean up the DString.
|
*/
|
*/
|
|
|
Tcl_DStringFree(&ds);
|
Tcl_DStringFree(&ds);
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclSetEnv --
|
* TclSetEnv --
|
*
|
*
|
* Set an environment variable, replacing an existing value
|
* Set an environment variable, replacing an existing value
|
* or creating a new variable if there doesn't exist a variable
|
* or creating a new variable if there doesn't exist a variable
|
* by the given name. This procedure is intended to be a
|
* by the given name. This procedure is intended to be a
|
* stand-in for the UNIX "setenv" procedure so that applications
|
* stand-in for the UNIX "setenv" procedure so that applications
|
* using that procedure will interface properly to Tcl. To make
|
* using that procedure will interface properly to Tcl. To make
|
* it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
|
* it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The environ array gets updated, as do all of the interpreters
|
* The environ array gets updated, as do all of the interpreters
|
* that we manage.
|
* that we manage.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
TclSetEnv(name, value)
|
TclSetEnv(name, value)
|
CONST char *name; /* Name of variable whose value is to be
|
CONST char *name; /* Name of variable whose value is to be
|
* set. */
|
* set. */
|
CONST char *value; /* New value for variable. */
|
CONST char *value; /* New value for variable. */
|
{
|
{
|
int index, length, nameLength;
|
int index, length, nameLength;
|
char *p, *oldValue;
|
char *p, *oldValue;
|
EnvInterp *eiPtr;
|
EnvInterp *eiPtr;
|
|
|
#ifdef MAC_TCL
|
#ifdef MAC_TCL
|
if (environ == NULL) {
|
if (environ == NULL) {
|
environSize = TclMacCreateEnv();
|
environSize = TclMacCreateEnv();
|
}
|
}
|
#endif
|
#endif
|
|
|
/*
|
/*
|
* Figure out where the entry is going to go. If the name doesn't
|
* 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
|
* already exist, enlarge the array if necessary to make room. If
|
* the name exists, free its old entry.
|
* the name exists, free its old entry.
|
*/
|
*/
|
|
|
index = FindVariable(name, &length);
|
index = FindVariable(name, &length);
|
if (index == -1) {
|
if (index == -1) {
|
#ifndef USE_PUTENV
|
#ifndef USE_PUTENV
|
if ((length+2) > environSize) {
|
if ((length+2) > environSize) {
|
char **newEnviron;
|
char **newEnviron;
|
|
|
newEnviron = (char **) ckalloc((unsigned)
|
newEnviron = (char **) ckalloc((unsigned)
|
((length+5) * sizeof(char *)));
|
((length+5) * sizeof(char *)));
|
|
|
/* CYGNUS LOCAL: Added to avoid an error from Purify,
|
/* CYGNUS LOCAL: Added to avoid an error from Purify,
|
although I don't personally see where the error would
|
although I don't personally see where the error would
|
occur--ian. */
|
occur--ian. */
|
memset((VOID *) newEnviron, 0, (length+5) * sizeof(char *));
|
memset((VOID *) newEnviron, 0, (length+5) * sizeof(char *));
|
|
|
memcpy((VOID *) newEnviron, (VOID *) environ,
|
memcpy((VOID *) newEnviron, (VOID *) environ,
|
length*sizeof(char *));
|
length*sizeof(char *));
|
if (environSize != 0) {
|
if (environSize != 0) {
|
ckfree((char *) environ);
|
ckfree((char *) environ);
|
}
|
}
|
environ = newEnviron;
|
environ = newEnviron;
|
environSize = length+5;
|
environSize = length+5;
|
}
|
}
|
index = length;
|
index = length;
|
environ[index+1] = NULL;
|
environ[index+1] = NULL;
|
#endif
|
#endif
|
oldValue = NULL;
|
oldValue = NULL;
|
nameLength = strlen(name);
|
nameLength = strlen(name);
|
} else {
|
} else {
|
/*
|
/*
|
* Compare the new value to the existing value. If they're
|
* Compare the new value to the existing value. If they're
|
* the same then quit immediately (e.g. don't rewrite the
|
* the same then quit immediately (e.g. don't rewrite the
|
* value or propagate it to other interpreters). Otherwise,
|
* value or propagate it to other interpreters). Otherwise,
|
* when there are N interpreters there will be N! propagations
|
* when there are N interpreters there will be N! propagations
|
* of the same value among the interpreters.
|
* of the same value among the interpreters.
|
*/
|
*/
|
|
|
if (strcmp(value, environ[index]+length+1) == 0) {
|
if (strcmp(value, environ[index]+length+1) == 0) {
|
return;
|
return;
|
}
|
}
|
oldValue = environ[index];
|
oldValue = environ[index];
|
nameLength = length;
|
nameLength = length;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
* Create a new entry.
|
* Create a new entry.
|
*/
|
*/
|
|
|
p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
|
p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
|
strcpy(p, name);
|
strcpy(p, name);
|
p[nameLength] = '=';
|
p[nameLength] = '=';
|
strcpy(p+nameLength+1, value);
|
strcpy(p+nameLength+1, value);
|
|
|
/*
|
/*
|
* Update the system environment.
|
* Update the system environment.
|
*/
|
*/
|
|
|
#ifdef USE_PUTENV
|
#ifdef USE_PUTENV
|
putenv(p);
|
putenv(p);
|
#else
|
#else
|
environ[index] = p;
|
environ[index] = p;
|
#endif
|
#endif
|
|
|
/*
|
/*
|
* Replace the old value with the new value in the cache.
|
* Replace the old value with the new value in the cache.
|
*/
|
*/
|
|
|
ReplaceString(oldValue, p);
|
ReplaceString(oldValue, p);
|
|
|
/*
|
/*
|
* Update all of the interpreters.
|
* Update all of the interpreters.
|
*/
|
*/
|
|
|
/* CYGNUS LOCAL: The original code was bogus. If we are being
|
/* CYGNUS LOCAL: The original code was bogus. If we are being
|
called because of a trace on the env array, then the call to
|
called because of a trace on the env array, then the call to
|
Tcl_SetVar2 would free value. We avoid that by checking
|
Tcl_SetVar2 would free value. We avoid that by checking
|
whether the value is the same before calling Tcl_SetVar2.
|
whether the value is the same before calling Tcl_SetVar2.
|
|
|
NOTE: This is not necessary in tcl8.1a2 which handles this in a
|
NOTE: This is not necessary in tcl8.1a2 which handles this in a
|
completely different, and better, way. */
|
completely different, and better, way. */
|
|
|
for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
|
for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
|
CONST char *v;
|
CONST char *v;
|
|
|
v = Tcl_GetVar2(eiPtr->interp, "env", (char *) name, TCL_GLOBAL_ONLY);
|
v = Tcl_GetVar2(eiPtr->interp, "env", (char *) name, TCL_GLOBAL_ONLY);
|
if (v == NULL || (v != value && strcmp (v, value) != 0)) {
|
if (v == NULL || (v != value && strcmp (v, value) != 0)) {
|
(void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
|
(void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
|
(char *) value, TCL_GLOBAL_ONLY);
|
(char *) value, TCL_GLOBAL_ONLY);
|
}
|
}
|
}
|
}
|
|
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_PutEnv --
|
* Tcl_PutEnv --
|
*
|
*
|
* Set an environment variable. Similar to setenv except that
|
* Set an environment variable. Similar to setenv except that
|
* the information is passed in a single string of the form
|
* the information is passed in a single string of the form
|
* NAME=value, rather than as separate name strings. This procedure
|
* NAME=value, rather than as separate name strings. This procedure
|
* is intended to be a stand-in for the UNIX "putenv" procedure
|
* is intended to be a stand-in for the UNIX "putenv" procedure
|
* so that applications using that procedure will interface
|
* so that applications using that procedure will interface
|
* properly to Tcl. To make it a stand-in, the Makefile will
|
* properly to Tcl. To make it a stand-in, the Makefile will
|
* define "Tcl_PutEnv" to "putenv".
|
* define "Tcl_PutEnv" to "putenv".
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The environ array gets updated, as do all of the interpreters
|
* The environ array gets updated, as do all of the interpreters
|
* that we manage.
|
* that we manage.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_PutEnv(string)
|
Tcl_PutEnv(string)
|
CONST char *string; /* Info about environment variable in the
|
CONST char *string; /* Info about environment variable in the
|
* form NAME=value. */
|
* form NAME=value. */
|
{
|
{
|
int nameLength;
|
int nameLength;
|
char *name, *value;
|
char *name, *value;
|
|
|
if (string == NULL) {
|
if (string == NULL) {
|
return 0;
|
return 0;
|
}
|
}
|
|
|
/*
|
/*
|
* Separate the string into name and value parts, then call
|
* Separate the string into name and value parts, then call
|
* TclSetEnv to do all of the real work.
|
* TclSetEnv to do all of the real work.
|
*/
|
*/
|
|
|
value = strchr(string, '=');
|
value = strchr(string, '=');
|
if (value == NULL) {
|
if (value == NULL) {
|
return 0;
|
return 0;
|
}
|
}
|
nameLength = value - string;
|
nameLength = value - string;
|
if (nameLength == 0) {
|
if (nameLength == 0) {
|
return 0;
|
return 0;
|
}
|
}
|
name = (char *) ckalloc((unsigned) nameLength+1);
|
name = (char *) ckalloc((unsigned) nameLength+1);
|
memcpy((VOID *) name, (VOID *) string, (size_t) nameLength);
|
memcpy((VOID *) name, (VOID *) string, (size_t) nameLength);
|
name[nameLength] = 0;
|
name[nameLength] = 0;
|
TclSetEnv(name, value+1);
|
TclSetEnv(name, value+1);
|
ckfree(name);
|
ckfree(name);
|
return 0;
|
return 0;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclUnsetEnv --
|
* TclUnsetEnv --
|
*
|
*
|
* Remove an environment variable, updating the "env" arrays
|
* Remove an environment variable, updating the "env" arrays
|
* in all interpreters managed by us. This function is intended
|
* in all interpreters managed by us. This function is intended
|
* to replace the UNIX "unsetenv" function (but to do this the
|
* to replace the UNIX "unsetenv" function (but to do this the
|
* Makefile must be modified to redefine "TclUnsetEnv" to
|
* Makefile must be modified to redefine "TclUnsetEnv" to
|
* "unsetenv".
|
* "unsetenv".
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Interpreters are updated, as is environ.
|
* Interpreters are updated, as is environ.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
TclUnsetEnv(name)
|
TclUnsetEnv(name)
|
CONST char *name; /* Name of variable to remove. */
|
CONST char *name; /* Name of variable to remove. */
|
{
|
{
|
EnvInterp *eiPtr;
|
EnvInterp *eiPtr;
|
char *oldValue;
|
char *oldValue;
|
int length, index;
|
int length, index;
|
#ifdef USE_PUTENV
|
#ifdef USE_PUTENV
|
char *string;
|
char *string;
|
#else
|
#else
|
char **envPtr;
|
char **envPtr;
|
#endif
|
#endif
|
|
|
#ifdef MAC_TCL
|
#ifdef MAC_TCL
|
if (environ == NULL) {
|
if (environ == NULL) {
|
environSize = TclMacCreateEnv();
|
environSize = TclMacCreateEnv();
|
}
|
}
|
#endif
|
#endif
|
|
|
index = FindVariable(name, &length);
|
index = FindVariable(name, &length);
|
|
|
/*
|
/*
|
* First make sure that the environment variable exists to avoid
|
* First make sure that the environment variable exists to avoid
|
* doing needless work and to avoid recursion on the unset.
|
* doing needless work and to avoid recursion on the unset.
|
*/
|
*/
|
|
|
if (index == -1) {
|
if (index == -1) {
|
return;
|
return;
|
}
|
}
|
/*
|
/*
|
* Remember the old value so we can free it if Tcl created the string.
|
* Remember the old value so we can free it if Tcl created the string.
|
*/
|
*/
|
|
|
oldValue = environ[index];
|
oldValue = environ[index];
|
|
|
/*
|
/*
|
* Update the system environment. This must be done before we
|
* Update the system environment. This must be done before we
|
* update the interpreters or we will recurse.
|
* update the interpreters or we will recurse.
|
*/
|
*/
|
|
|
#ifdef USE_PUTENV
|
#ifdef USE_PUTENV
|
string = ckalloc(length+2);
|
string = ckalloc(length+2);
|
memcpy((VOID *) string, (VOID *) name, (size_t) length);
|
memcpy((VOID *) string, (VOID *) name, (size_t) length);
|
string[length] = '=';
|
string[length] = '=';
|
string[length+1] = '\0';
|
string[length+1] = '\0';
|
putenv(string);
|
putenv(string);
|
ckfree(string);
|
ckfree(string);
|
#else
|
#else
|
for (envPtr = environ+index+1; ; envPtr++) {
|
for (envPtr = environ+index+1; ; envPtr++) {
|
envPtr[-1] = *envPtr;
|
envPtr[-1] = *envPtr;
|
if (*envPtr == NULL) {
|
if (*envPtr == NULL) {
|
break;
|
break;
|
}
|
}
|
}
|
}
|
#endif
|
#endif
|
|
|
/*
|
/*
|
* Replace the old value in the cache.
|
* Replace the old value in the cache.
|
*/
|
*/
|
|
|
ReplaceString(oldValue, NULL);
|
ReplaceString(oldValue, NULL);
|
|
|
/*
|
/*
|
* Update all of the interpreters.
|
* Update all of the interpreters.
|
*/
|
*/
|
|
|
for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
|
for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
|
(void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
|
(void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
|
TCL_GLOBAL_ONLY);
|
TCL_GLOBAL_ONLY);
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclGetEnv --
|
* TclGetEnv --
|
*
|
*
|
* Retrieve the value of an environment variable.
|
* Retrieve the value of an environment variable.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns a pointer to a static string in the environment,
|
* Returns a pointer to a static string in the environment,
|
* or NULL if the value was not found.
|
* or NULL if the value was not found.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
char *
|
char *
|
TclGetEnv(name)
|
TclGetEnv(name)
|
CONST char *name; /* Name of variable to find. */
|
CONST char *name; /* Name of variable to find. */
|
{
|
{
|
int length, index;
|
int length, index;
|
|
|
#ifdef MAC_TCL
|
#ifdef MAC_TCL
|
if (environ == NULL) {
|
if (environ == NULL) {
|
environSize = TclMacCreateEnv();
|
environSize = TclMacCreateEnv();
|
}
|
}
|
#endif
|
#endif
|
|
|
index = FindVariable(name, &length);
|
index = FindVariable(name, &length);
|
if ((index != -1) && (*(environ[index]+length) == '=')) {
|
if ((index != -1) && (*(environ[index]+length) == '=')) {
|
return environ[index]+length+1;
|
return environ[index]+length+1;
|
} else {
|
} else {
|
return NULL;
|
return NULL;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* EnvTraceProc --
|
* EnvTraceProc --
|
*
|
*
|
* This procedure is invoked whenever an environment variable
|
* This procedure is invoked whenever an environment variable
|
* is modified or deleted. It propagates the change to the
|
* is modified or deleted. It propagates the change to the
|
* "environ" array and to any other interpreters for whom
|
* "environ" array and to any other interpreters for whom
|
* we're managing an "env" array.
|
* we're managing an "env" array.
|
*
|
*
|
* Results:
|
* Results:
|
* Always returns NULL to indicate success.
|
* Always returns NULL to indicate success.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Environment variable changes get propagated. If the whole
|
* Environment variable changes get propagated. If the whole
|
* "env" array is deleted, then we stop managing things for
|
* "env" array is deleted, then we stop managing things for
|
* this interpreter (usually this happens because the whole
|
* this interpreter (usually this happens because the whole
|
* interpreter is being deleted).
|
* interpreter is being deleted).
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
/* ARGSUSED */
|
/* ARGSUSED */
|
static char *
|
static char *
|
EnvTraceProc(clientData, interp, name1, name2, flags)
|
EnvTraceProc(clientData, interp, name1, name2, flags)
|
ClientData clientData; /* Not used. */
|
ClientData clientData; /* Not used. */
|
Tcl_Interp *interp; /* Interpreter whose "env" variable is
|
Tcl_Interp *interp; /* Interpreter whose "env" variable is
|
* being modified. */
|
* being modified. */
|
char *name1; /* Better be "env". */
|
char *name1; /* Better be "env". */
|
char *name2; /* Name of variable being modified, or
|
char *name2; /* Name of variable being modified, or
|
* NULL if whole array is being deleted. */
|
* NULL if whole array is being deleted. */
|
int flags; /* Indicates what's happening. */
|
int flags; /* Indicates what's happening. */
|
{
|
{
|
/*
|
/*
|
* First see if the whole "env" variable is being deleted. If
|
* First see if the whole "env" variable is being deleted. If
|
* so, just forget about this interpreter.
|
* so, just forget about this interpreter.
|
*/
|
*/
|
|
|
if (name2 == NULL) {
|
if (name2 == NULL) {
|
register EnvInterp *eiPtr, *prevPtr;
|
register EnvInterp *eiPtr, *prevPtr;
|
|
|
if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
|
if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
|
!= (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
|
!= (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
|
panic("EnvTraceProc called with confusing arguments");
|
panic("EnvTraceProc called with confusing arguments");
|
}
|
}
|
eiPtr = firstInterpPtr;
|
eiPtr = firstInterpPtr;
|
if (eiPtr->interp == interp) {
|
if (eiPtr->interp == interp) {
|
firstInterpPtr = eiPtr->nextPtr;
|
firstInterpPtr = eiPtr->nextPtr;
|
} else {
|
} else {
|
for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
|
for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
|
prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
|
prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
|
if (eiPtr == NULL) {
|
if (eiPtr == NULL) {
|
panic("EnvTraceProc couldn't find interpreter");
|
panic("EnvTraceProc couldn't find interpreter");
|
}
|
}
|
if (eiPtr->interp == interp) {
|
if (eiPtr->interp == interp) {
|
prevPtr->nextPtr = eiPtr->nextPtr;
|
prevPtr->nextPtr = eiPtr->nextPtr;
|
break;
|
break;
|
}
|
}
|
}
|
}
|
}
|
}
|
ckfree((char *) eiPtr);
|
ckfree((char *) eiPtr);
|
return NULL;
|
return NULL;
|
}
|
}
|
|
|
/*
|
/*
|
* If a value is being set, call TclSetEnv to do all of the work.
|
* If a value is being set, call TclSetEnv to do all of the work.
|
*/
|
*/
|
|
|
if (flags & TCL_TRACE_WRITES) {
|
if (flags & TCL_TRACE_WRITES) {
|
TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
|
TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
|
}
|
}
|
|
|
if (flags & TCL_TRACE_UNSETS) {
|
if (flags & TCL_TRACE_UNSETS) {
|
TclUnsetEnv(name2);
|
TclUnsetEnv(name2);
|
}
|
}
|
return NULL;
|
return NULL;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* ReplaceString --
|
* ReplaceString --
|
*
|
*
|
* Replace one string with another in the environment variable
|
* Replace one string with another in the environment variable
|
* cache. The cache keeps track of all of the environment
|
* cache. The cache keeps track of all of the environment
|
* variables that Tcl has modified so they can be freed later.
|
* variables that Tcl has modified so they can be freed later.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* May free the old string.
|
* May free the old string.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static void
|
static void
|
ReplaceString(oldStr, newStr)
|
ReplaceString(oldStr, newStr)
|
CONST char *oldStr; /* Old environment string. */
|
CONST char *oldStr; /* Old environment string. */
|
char *newStr; /* New environment string. */
|
char *newStr; /* New environment string. */
|
{
|
{
|
int i;
|
int i;
|
char **newCache;
|
char **newCache;
|
|
|
/*
|
/*
|
* Check to see if the old value was allocated by Tcl. If so,
|
* 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
|
* 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
|
* algorithm is O(n), not O(1). This will result in n-squared behavior
|
* if lots of environment changes are being made.
|
* if lots of environment changes are being made.
|
*/
|
*/
|
|
|
for (i = 0; i < cacheSize; i++) {
|
for (i = 0; i < cacheSize; i++) {
|
if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
|
if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
|
break;
|
break;
|
}
|
}
|
}
|
}
|
if (i < cacheSize) {
|
if (i < cacheSize) {
|
/*
|
/*
|
* Replace or delete the old value.
|
* Replace or delete the old value.
|
*/
|
*/
|
|
|
if (environCache[i]) {
|
if (environCache[i]) {
|
ckfree(environCache[i]);
|
ckfree(environCache[i]);
|
}
|
}
|
|
|
if (newStr) {
|
if (newStr) {
|
environCache[i] = newStr;
|
environCache[i] = newStr;
|
} else {
|
} else {
|
for (; i < cacheSize-1; i++) {
|
for (; i < cacheSize-1; i++) {
|
environCache[i] = environCache[i+1];
|
environCache[i] = environCache[i+1];
|
}
|
}
|
environCache[cacheSize-1] = NULL;
|
environCache[cacheSize-1] = NULL;
|
}
|
}
|
} else {
|
} else {
|
int allocatedSize = (cacheSize + 5) * sizeof(char *);
|
int allocatedSize = (cacheSize + 5) * sizeof(char *);
|
|
|
/*
|
/*
|
* We need to grow the cache in order to hold the new string.
|
* We need to grow the cache in order to hold the new string.
|
*/
|
*/
|
|
|
newCache = (char **) ckalloc((size_t) allocatedSize);
|
newCache = (char **) ckalloc((size_t) allocatedSize);
|
(VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
|
(VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
|
|
|
if (environCache) {
|
if (environCache) {
|
memcpy((VOID *) newCache, (VOID *) environCache,
|
memcpy((VOID *) newCache, (VOID *) environCache,
|
(size_t) (cacheSize * sizeof(char*)));
|
(size_t) (cacheSize * sizeof(char*)));
|
ckfree((char *) environCache);
|
ckfree((char *) environCache);
|
}
|
}
|
environCache = newCache;
|
environCache = newCache;
|
environCache[cacheSize] = (char *) newStr;
|
environCache[cacheSize] = (char *) newStr;
|
environCache[cacheSize+1] = NULL;
|
environCache[cacheSize+1] = NULL;
|
cacheSize += 5;
|
cacheSize += 5;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FindVariable --
|
* FindVariable --
|
*
|
*
|
* Locate the entry in environ for a given name.
|
* Locate the entry in environ for a given name.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is the index in environ of an entry with the
|
* 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
|
* 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
|
* *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) or the length of the environ array (if no matching
|
* entry is found).
|
* entry is found).
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
static int
|
static int
|
FindVariable(name, lengthPtr)
|
FindVariable(name, lengthPtr)
|
CONST char *name; /* Name of desired environment variable. */
|
CONST char *name; /* Name of desired environment variable. */
|
int *lengthPtr; /* Used to return length of name (for
|
int *lengthPtr; /* Used to return length of name (for
|
* successful searches) or number of non-NULL
|
* successful searches) or number of non-NULL
|
* entries in environ (for unsuccessful
|
* entries in environ (for unsuccessful
|
* searches). */
|
* searches). */
|
{
|
{
|
int i;
|
int i;
|
register CONST char *p1, *p2;
|
register CONST char *p1, *p2;
|
|
|
for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
|
for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
|
for (p2 = name; *p2 == *p1; p1++, p2++) {
|
for (p2 = name; *p2 == *p1; p1++, p2++) {
|
/* NULL loop body. */
|
/* NULL loop body. */
|
}
|
}
|
if ((*p1 == '=') && (*p2 == '\0')) {
|
if ((*p1 == '=') && (*p2 == '\0')) {
|
*lengthPtr = p2-name;
|
*lengthPtr = p2-name;
|
return i;
|
return i;
|
}
|
}
|
}
|
}
|
*lengthPtr = i;
|
*lengthPtr = i;
|
return -1;
|
return -1;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclFinalizeEnvironment --
|
* TclFinalizeEnvironment --
|
*
|
*
|
* This function releases any storage allocated by this module
|
* This function releases any storage allocated by this module
|
* that isn't still in use by the global environment. Any
|
* that isn't still in use by the global environment. Any
|
* strings that are still in the environment will be leaked.
|
* strings that are still in the environment will be leaked.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* May deallocate storage.
|
* May deallocate storage.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
void
|
void
|
TclFinalizeEnvironment()
|
TclFinalizeEnvironment()
|
{
|
{
|
/*
|
/*
|
* For now we just deallocate the cache array and none of the environment
|
* For now we just deallocate the cache array and none of the environment
|
* strings. This may leak more memory that strictly necessary, since some
|
* strings. This may leak more memory that strictly necessary, since some
|
* of the strings may no longer be in the environment. However,
|
* of the strings may no longer be in the environment. However,
|
* determining which ones are ok to delete is n-squared, and is pretty
|
* determining which ones are ok to delete is n-squared, and is pretty
|
* unlikely, so we don't bother.
|
* unlikely, so we don't bother.
|
*/
|
*/
|
|
|
if (environCache) {
|
if (environCache) {
|
ckfree((char *) environCache);
|
ckfree((char *) environCache);
|
environCache = NULL;
|
environCache = NULL;
|
cacheSize = 0;
|
cacheSize = 0;
|
#ifndef USE_PUTENV
|
#ifndef USE_PUTENV
|
environSize = 0;
|
environSize = 0;
|
#endif
|
#endif
|
}
|
}
|
}
|
}
|
|
|
/* CYGNUS LOCAL */
|
/* CYGNUS LOCAL */
|
#if defined(__CYGWIN__) && defined(__WIN32__)
|
#if defined(__CYGWIN__) && defined(__WIN32__)
|
|
|
#include "windows.h"
|
#include "windows.h"
|
|
|
/* When using cygwin, when an environment variable changes, we need
|
/* When using cygwin, when an environment variable changes, we need
|
to synch with both the cygwin environment (in case the
|
to synch with both the cygwin environment (in case the
|
application C code calls fork) and the Windows environment (in case
|
application C code calls fork) and the Windows environment (in case
|
the application TCL code calls exec, which calls the Windows
|
the application TCL code calls exec, which calls the Windows
|
CreateProcess function). */
|
CreateProcess function). */
|
|
|
static void
|
static void
|
TclCygwin32Putenv(str)
|
TclCygwin32Putenv(str)
|
const char *str;
|
const char *str;
|
{
|
{
|
char *name, *value;
|
char *name, *value;
|
|
|
/* Get the name and value, so that we can change the environment
|
/* Get the name and value, so that we can change the environment
|
variable for Windows. */
|
variable for Windows. */
|
name = (char *) alloca (strlen (str) + 1);
|
name = (char *) alloca (strlen (str) + 1);
|
strcpy (name, str);
|
strcpy (name, str);
|
for (value = name; *value != '=' && *value != '\0'; ++value)
|
for (value = name; *value != '=' && *value != '\0'; ++value)
|
;
|
;
|
if (*value == '\0')
|
if (*value == '\0')
|
{
|
{
|
/* Can't happen. */
|
/* Can't happen. */
|
return;
|
return;
|
}
|
}
|
*value = '\0';
|
*value = '\0';
|
++value;
|
++value;
|
if (*value == '\0')
|
if (*value == '\0')
|
value = NULL;
|
value = NULL;
|
|
|
/* Set the cygwin environment variable. */
|
/* Set the cygwin environment variable. */
|
#undef putenv
|
#undef putenv
|
if (value == NULL)
|
if (value == NULL)
|
unsetenv (name);
|
unsetenv (name);
|
else
|
else
|
putenv(str);
|
putenv(str);
|
|
|
/* Before changing the environment variable in Windows, if this is
|
/* Before changing the environment variable in Windows, if this is
|
PATH, we need to convert the value back to a Windows style path.
|
PATH, we need to convert the value back to a Windows style path.
|
|
|
FIXME: The calling program may now it is running under windows,
|
FIXME: The calling program may now it is running under windows,
|
and may have set the path to a Windows path, or, worse, appended
|
and may have set the path to a Windows path, or, worse, appended
|
or prepended a Windows path to PATH. */
|
or prepended a Windows path to PATH. */
|
if (strcmp (name, "PATH") != 0)
|
if (strcmp (name, "PATH") != 0)
|
{
|
{
|
/* If this is Path, eliminate any PATH variable, to prevent any
|
/* If this is Path, eliminate any PATH variable, to prevent any
|
confusion. */
|
confusion. */
|
if (strcmp (name, "Path") == 0)
|
if (strcmp (name, "Path") == 0)
|
{
|
{
|
SetEnvironmentVariable ("PATH", (char *) NULL);
|
SetEnvironmentVariable ("PATH", (char *) NULL);
|
unsetenv ("PATH");
|
unsetenv ("PATH");
|
}
|
}
|
|
|
SetEnvironmentVariable (name, value);
|
SetEnvironmentVariable (name, value);
|
}
|
}
|
else
|
else
|
{
|
{
|
char *buf;
|
char *buf;
|
|
|
/* Eliminate any Path variable, to prevent any confusion. */
|
/* Eliminate any Path variable, to prevent any confusion. */
|
SetEnvironmentVariable ("Path", (char *) NULL);
|
SetEnvironmentVariable ("Path", (char *) NULL);
|
unsetenv ("Path");
|
unsetenv ("Path");
|
|
|
if (value == NULL)
|
if (value == NULL)
|
buf = NULL;
|
buf = NULL;
|
else
|
else
|
{
|
{
|
int size;
|
int size;
|
|
|
size = cygwin_posix_to_win32_path_list_buf_size (value);
|
size = cygwin_posix_to_win32_path_list_buf_size (value);
|
buf = (char *) alloca (size + 1);
|
buf = (char *) alloca (size + 1);
|
cygwin_posix_to_win32_path_list (value, buf);
|
cygwin_posix_to_win32_path_list (value, buf);
|
}
|
}
|
|
|
SetEnvironmentVariable (name, buf);
|
SetEnvironmentVariable (name, buf);
|
}
|
}
|
}
|
}
|
|
|
#endif /* __CYGWIN__ */
|
#endif /* __CYGWIN__ */
|
/* END CYGNUS LOCAL */
|
/* END CYGNUS LOCAL */
|
|
|
