Tk
view release on metacpan or search on metacpan
pTk/mTk/tclGeneric/tclEnv.c view on Meta::CPAN
/*
* 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.
*
* 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.20.2.1 2003/05/14 17:17:46 hobbs Exp $
*/
#include "tclInt.h"
#include "tclPort.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 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 procedures 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 --
pTk/mTk/tclGeneric/tclEnv.c view on Meta::CPAN
/*
* 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 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".
*
* 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
if ((length + 2) > environSize) {
char **newEnviron;
newEnviron = (char **) ckalloc((unsigned)
((length + 5) * sizeof(char *)));
memcpy((VOID *) newEnviron, (VOID *) environ,
length*sizeof(char *));
if (environSize != 0) {
ckfree((char *) environ);
}
environ = newEnviron;
environSize = length + 5;
#if defined(__APPLE__) && defined(__DYNAMIC__)
{
char ***e = _NSGetEnviron();
*e = environ;
}
#endif
}
index = length;
environ[index + 1] = NULL;
#endif
oldValue = NULL;
nameLength = strlen(name);
} else {
CONST char *env;
/*
pTk/mTk/tclGeneric/tclEnv.c view on Meta::CPAN
* 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 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".
*
* Results:
* None.
*
* Side effects:
* 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_DString nameString;
CONST char *name;
char *value;
if (string == 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, string, -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
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
string = ckalloc((unsigned int) length+2);
memcpy((VOID *) string, (VOID *) name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
strcpy(string, Tcl_DStringValue(&envString));
Tcl_DStringFree(&envString);
putenv(string);
pTk/mTk/tclGeneric/tclEnv.c view on Meta::CPAN
*----------------------------------------------------------------------
*/
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)
;
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__ */
( run in 2.280 seconds using v1.01-cache-2.11-cpan-5a3173703d6 )