os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclEnv.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclEnv.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,806 @@
1.4 +/*
1.5 + * tclEnv.c --
1.6 + *
1.7 + * Tcl support for environment variables, including a setenv
1.8 + * procedure. This file contains the generic portion of the
1.9 + * environment module. It is primarily responsible for keeping
1.10 + * the "env" arrays in sync with the system environment variables.
1.11 + *
1.12 + * Copyright (c) 1991-1994 The Regents of the University of California.
1.13 + * Copyright (c) 1994-1998 Sun Microsystems, Inc.
1.14 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.15 + *
1.16 + * See the file "license.terms" for information on usage and redistribution
1.17 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.18 + *
1.19 + * RCS: @(#) $Id: tclEnv.c,v 1.20.2.3 2006/10/31 22:25:08 das Exp $
1.20 + */
1.21 +
1.22 +#include "tclInt.h"
1.23 +#include "tclPort.h"
1.24 +
1.25 +TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */
1.26 +
1.27 +static int cacheSize = 0; /* Number of env strings in environCache. */
1.28 +static char **environCache = NULL;
1.29 + /* Array containing all of the environment
1.30 + * strings that Tcl has allocated. */
1.31 +
1.32 +#ifndef USE_PUTENV
1.33 +static char **ourEnviron = NULL;/* Cache of the array that we allocate.
1.34 + * We need to track this in case another
1.35 + * subsystem swaps around the environ array
1.36 + * like we do.
1.37 + */
1.38 +static int environSize = 0; /* Non-zero means that the environ array was
1.39 + * malloced and has this many total entries
1.40 + * allocated to it (not all may be in use at
1.41 + * once). Zero means that the environment
1.42 + * array is in its original static state. */
1.43 +#endif
1.44 +
1.45 +/*
1.46 + * For MacOS X
1.47 + */
1.48 +#if defined(__APPLE__) && defined(__DYNAMIC__)
1.49 +#include <crt_externs.h>
1.50 +__private_extern__ char **environ;
1.51 +char **environ = NULL;
1.52 +#endif
1.53 +
1.54 +/*
1.55 + * Declarations for local procedures defined in this file:
1.56 + */
1.57 +
1.58 +static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
1.59 + Tcl_Interp *interp, CONST char *name1,
1.60 + CONST char *name2, int flags));
1.61 +static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
1.62 + char *newStr));
1.63 +void TclSetEnv _ANSI_ARGS_((CONST char *name,
1.64 + CONST char *value));
1.65 +void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
1.66 +
1.67 +#if defined (__CYGWIN__) && defined(__WIN32__)
1.68 +static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string));
1.69 +#endif
1.70 +
1.71 +/*
1.72 + *----------------------------------------------------------------------
1.73 + *
1.74 + * TclSetupEnv --
1.75 + *
1.76 + * This procedure is invoked for an interpreter to make environment
1.77 + * variables accessible from that interpreter via the "env"
1.78 + * associative array.
1.79 + *
1.80 + * Results:
1.81 + * None.
1.82 + *
1.83 + * Side effects:
1.84 + * The interpreter is added to a list of interpreters managed
1.85 + * by us, so that its view of envariables can be kept consistent
1.86 + * with the view in other interpreters. If this is the first
1.87 + * call to TclSetupEnv, then additional initialization happens,
1.88 + * such as copying the environment to dynamically-allocated space
1.89 + * for ease of management.
1.90 + *
1.91 + *----------------------------------------------------------------------
1.92 + */
1.93 +
1.94 +void
1.95 +TclSetupEnv(interp)
1.96 + Tcl_Interp *interp; /* Interpreter whose "env" array is to be
1.97 + * managed. */
1.98 +{
1.99 + Tcl_DString envString;
1.100 + char *p1, *p2;
1.101 + int i;
1.102 +
1.103 + /*
1.104 + * For MacOS X
1.105 + */
1.106 +#if defined(__APPLE__) && defined(__DYNAMIC__)
1.107 + environ = *_NSGetEnviron();
1.108 +#endif
1.109 +
1.110 + /*
1.111 + * Synchronize the values in the environ array with the contents
1.112 + * of the Tcl "env" variable. To do this:
1.113 + * 1) Remove the trace that fires when the "env" var is unset.
1.114 + * 2) Unset the "env" variable.
1.115 + * 3) If there are no environ variables, create an empty "env"
1.116 + * array. Otherwise populate the array with current values.
1.117 + * 4) Add a trace that synchronizes the "env" array.
1.118 + */
1.119 +
1.120 + Tcl_UntraceVar2(interp, "env", (char *) NULL,
1.121 + TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
1.122 + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
1.123 + (ClientData) NULL);
1.124 +
1.125 + Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
1.126 +
1.127 + if (environ[0] == NULL) {
1.128 + Tcl_Obj *varNamePtr;
1.129 +
1.130 + varNamePtr = Tcl_NewStringObj("env", -1);
1.131 + Tcl_IncrRefCount(varNamePtr);
1.132 + TclArraySet(interp, varNamePtr, NULL);
1.133 + Tcl_DecrRefCount(varNamePtr);
1.134 + } else {
1.135 + Tcl_MutexLock(&envMutex);
1.136 + for (i = 0; environ[i] != NULL; i++) {
1.137 + p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
1.138 + p2 = strchr(p1, '=');
1.139 + if (p2 == NULL) {
1.140 + /*
1.141 + * This condition seem to happen occasionally under some
1.142 + * versions of Solaris; ignore the entry.
1.143 + */
1.144 +
1.145 + continue;
1.146 + }
1.147 + p2++;
1.148 + p2[-1] = '\0';
1.149 + Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
1.150 + Tcl_DStringFree(&envString);
1.151 + }
1.152 + Tcl_MutexUnlock(&envMutex);
1.153 + }
1.154 +
1.155 + Tcl_TraceVar2(interp, "env", (char *) NULL,
1.156 + TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
1.157 + TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc,
1.158 + (ClientData) NULL);
1.159 +}
1.160 +
1.161 +/*
1.162 + *----------------------------------------------------------------------
1.163 + *
1.164 + * TclSetEnv --
1.165 + *
1.166 + * Set an environment variable, replacing an existing value
1.167 + * or creating a new variable if there doesn't exist a variable
1.168 + * by the given name. This procedure is intended to be a
1.169 + * stand-in for the UNIX "setenv" procedure so that applications
1.170 + * using that procedure will interface properly to Tcl. To make
1.171 + * it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
1.172 + *
1.173 + * Results:
1.174 + * None.
1.175 + *
1.176 + * Side effects:
1.177 + * The environ array gets updated.
1.178 + *
1.179 + *----------------------------------------------------------------------
1.180 + */
1.181 +
1.182 +void
1.183 +TclSetEnv(name, value)
1.184 + CONST char *name; /* Name of variable whose value is to be
1.185 + * set (UTF-8). */
1.186 + CONST char *value; /* New value for variable (UTF-8). */
1.187 +{
1.188 + Tcl_DString envString;
1.189 + int index, length, nameLength;
1.190 + char *p, *oldValue;
1.191 + CONST char *p2;
1.192 +
1.193 + /*
1.194 + * Figure out where the entry is going to go. If the name doesn't
1.195 + * already exist, enlarge the array if necessary to make room. If the
1.196 + * name exists, free its old entry.
1.197 + */
1.198 +
1.199 + Tcl_MutexLock(&envMutex);
1.200 + index = TclpFindVariable(name, &length);
1.201 +
1.202 + if (index == -1) {
1.203 +#ifndef USE_PUTENV
1.204 + /*
1.205 + * We need to handle the case where the environment may be changed
1.206 + * outside our control. environSize is only valid if the current
1.207 + * environment is the one we allocated. [Bug 979640]
1.208 + */
1.209 + if ((ourEnviron != environ) || ((length + 2) > environSize)) {
1.210 + char **newEnviron;
1.211 +
1.212 + newEnviron = (char **) ckalloc((unsigned)
1.213 + ((length + 5) * sizeof(char *)));
1.214 + memcpy((VOID *) newEnviron, (VOID *) environ,
1.215 + length*sizeof(char *));
1.216 + if ((environSize != 0) && (ourEnviron != NULL)) {
1.217 + ckfree((char *) ourEnviron);
1.218 + }
1.219 + environ = ourEnviron = newEnviron;
1.220 + environSize = length + 5;
1.221 +#if defined(__APPLE__) && defined(__DYNAMIC__)
1.222 + {
1.223 + char ***e = _NSGetEnviron();
1.224 + *e = environ;
1.225 + }
1.226 +#endif
1.227 + }
1.228 + index = length;
1.229 + environ[index + 1] = NULL;
1.230 +#endif
1.231 + oldValue = NULL;
1.232 + nameLength = strlen(name);
1.233 + } else {
1.234 + CONST char *env;
1.235 +
1.236 + /*
1.237 + * Compare the new value to the existing value. If they're
1.238 + * the same then quit immediately (e.g. don't rewrite the
1.239 + * value or propagate it to other interpreters). Otherwise,
1.240 + * when there are N interpreters there will be N! propagations
1.241 + * of the same value among the interpreters.
1.242 + */
1.243 +
1.244 + env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
1.245 + if (strcmp(value, (env + length + 1)) == 0) {
1.246 + Tcl_DStringFree(&envString);
1.247 + Tcl_MutexUnlock(&envMutex);
1.248 + return;
1.249 + }
1.250 + Tcl_DStringFree(&envString);
1.251 +
1.252 + oldValue = environ[index];
1.253 + nameLength = length;
1.254 + }
1.255 +
1.256 + /*
1.257 + * Create a new entry. Build a complete UTF string that contains
1.258 + * a "name=value" pattern. Then convert the string to the native
1.259 + * encoding, and set the environ array value.
1.260 + */
1.261 +
1.262 + p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
1.263 + strcpy(p, name);
1.264 + p[nameLength] = '=';
1.265 + strcpy(p+nameLength+1, value);
1.266 + p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
1.267 +
1.268 + /*
1.269 + * Copy the native string to heap memory.
1.270 + */
1.271 +
1.272 + p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
1.273 + strcpy(p, p2);
1.274 + Tcl_DStringFree(&envString);
1.275 +
1.276 +#ifdef USE_PUTENV
1.277 + /*
1.278 + * Update the system environment.
1.279 + */
1.280 +
1.281 + putenv(p);
1.282 + index = TclpFindVariable(name, &length);
1.283 +#else
1.284 + environ[index] = p;
1.285 +#endif
1.286 +
1.287 + /*
1.288 + * Watch out for versions of putenv that copy the string (e.g. VC++).
1.289 + * In this case we need to free the string immediately. Otherwise
1.290 + * update the string in the cache.
1.291 + */
1.292 +
1.293 + if ((index != -1) && (environ[index] == p)) {
1.294 + ReplaceString(oldValue, p);
1.295 +#ifdef HAVE_PUTENV_THAT_COPIES
1.296 + } else {
1.297 + /* This putenv() copies instead of taking ownership */
1.298 + ckfree(p);
1.299 +#endif
1.300 + }
1.301 +
1.302 + Tcl_MutexUnlock(&envMutex);
1.303 +
1.304 + if (!strcmp(name, "HOME")) {
1.305 + /*
1.306 + * If the user's home directory has changed, we must invalidate
1.307 + * the filesystem cache, because '~' expansions will now be
1.308 + * incorrect.
1.309 + */
1.310 + Tcl_FSMountsChanged(NULL);
1.311 + }
1.312 +}
1.313 +
1.314 +/*
1.315 + *----------------------------------------------------------------------
1.316 + *
1.317 + * Tcl_PutEnv --
1.318 + *
1.319 + * Set an environment variable. Similar to setenv except that
1.320 + * the information is passed in a single string of the form
1.321 + * NAME=value, rather than as separate name strings. This procedure
1.322 + * is intended to be a stand-in for the UNIX "putenv" procedure
1.323 + * so that applications using that procedure will interface
1.324 + * properly to Tcl. To make it a stand-in, the Makefile will
1.325 + * define "Tcl_PutEnv" to "putenv".
1.326 + *
1.327 + * Results:
1.328 + * None.
1.329 + *
1.330 + * Side effects:
1.331 + * The environ array gets updated, as do all of the interpreters
1.332 + * that we manage.
1.333 + *
1.334 + *----------------------------------------------------------------------
1.335 + */
1.336 +
1.337 +EXPORT_C int
1.338 +Tcl_PutEnv(string)
1.339 + CONST char *string; /* Info about environment variable in the
1.340 + * form NAME=value. (native) */
1.341 +{
1.342 + Tcl_DString nameString;
1.343 + CONST char *name;
1.344 + char *value;
1.345 +
1.346 + if (string == NULL) {
1.347 + return 0;
1.348 + }
1.349 +
1.350 + /*
1.351 + * First convert the native string to UTF. Then separate the
1.352 + * string into name and value parts, and call TclSetEnv to do
1.353 + * all of the real work.
1.354 + */
1.355 +
1.356 + name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
1.357 + value = strchr(name, '=');
1.358 +
1.359 + if ((value != NULL) && (value != name)) {
1.360 + value[0] = '\0';
1.361 + TclSetEnv(name, value+1);
1.362 + }
1.363 +
1.364 + Tcl_DStringFree(&nameString);
1.365 + return 0;
1.366 +}
1.367 +
1.368 +/*
1.369 + *----------------------------------------------------------------------
1.370 + *
1.371 + * TclUnsetEnv --
1.372 + *
1.373 + * Remove an environment variable, updating the "env" arrays
1.374 + * in all interpreters managed by us. This function is intended
1.375 + * to replace the UNIX "unsetenv" function (but to do this the
1.376 + * Makefile must be modified to redefine "TclUnsetEnv" to
1.377 + * "unsetenv".
1.378 + *
1.379 + * Results:
1.380 + * None.
1.381 + *
1.382 + * Side effects:
1.383 + * Interpreters are updated, as is environ.
1.384 + *
1.385 + *----------------------------------------------------------------------
1.386 + */
1.387 +
1.388 +void
1.389 +TclUnsetEnv(name)
1.390 + CONST char *name; /* Name of variable to remove (UTF-8). */
1.391 +{
1.392 + char *oldValue;
1.393 + int length;
1.394 + int index;
1.395 +#ifdef USE_PUTENV_FOR_UNSET
1.396 + Tcl_DString envString;
1.397 + char *string;
1.398 +#else
1.399 + char **envPtr;
1.400 +#endif
1.401 +
1.402 + Tcl_MutexLock(&envMutex);
1.403 + index = TclpFindVariable(name, &length);
1.404 +
1.405 + /*
1.406 + * First make sure that the environment variable exists to avoid
1.407 + * doing needless work and to avoid recursion on the unset.
1.408 + */
1.409 +
1.410 + if (index == -1) {
1.411 + Tcl_MutexUnlock(&envMutex);
1.412 + return;
1.413 + }
1.414 + /*
1.415 + * Remember the old value so we can free it if Tcl created the string.
1.416 + */
1.417 +
1.418 + oldValue = environ[index];
1.419 +
1.420 + /*
1.421 + * Update the system environment. This must be done before we
1.422 + * update the interpreters or we will recurse.
1.423 + */
1.424 +
1.425 +#ifdef USE_PUTENV_FOR_UNSET
1.426 + /*
1.427 + * For those platforms that support putenv to unset, Linux indicates
1.428 + * that no = should be included, and Windows requires it.
1.429 + */
1.430 +#ifdef WIN32
1.431 + string = ckalloc((unsigned int) length+2);
1.432 + memcpy((VOID *) string, (VOID *) name, (size_t) length);
1.433 + string[length] = '=';
1.434 + string[length+1] = '\0';
1.435 +#else
1.436 + string = ckalloc((unsigned int) length+1);
1.437 + memcpy((VOID *) string, (VOID *) name, (size_t) length);
1.438 + string[length] = '\0';
1.439 +#endif
1.440 +
1.441 + Tcl_UtfToExternalDString(NULL, string, -1, &envString);
1.442 + string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
1.443 + strcpy(string, Tcl_DStringValue(&envString));
1.444 + Tcl_DStringFree(&envString);
1.445 +
1.446 + putenv(string);
1.447 +
1.448 + /*
1.449 + * Watch out for versions of putenv that copy the string (e.g. VC++).
1.450 + * In this case we need to free the string immediately. Otherwise
1.451 + * update the string in the cache.
1.452 + */
1.453 +
1.454 + if (environ[index] == string) {
1.455 + ReplaceString(oldValue, string);
1.456 +#ifdef HAVE_PUTENV_THAT_COPIES
1.457 + } else {
1.458 + /* This putenv() copies instead of taking ownership */
1.459 + ckfree(string);
1.460 +#endif
1.461 + }
1.462 +#else
1.463 + for (envPtr = environ+index+1; ; envPtr++) {
1.464 + envPtr[-1] = *envPtr;
1.465 + if (*envPtr == NULL) {
1.466 + break;
1.467 + }
1.468 + }
1.469 + ReplaceString(oldValue, NULL);
1.470 +#endif
1.471 +
1.472 + Tcl_MutexUnlock(&envMutex);
1.473 +}
1.474 +
1.475 +/*
1.476 + *---------------------------------------------------------------------------
1.477 + *
1.478 + * TclGetEnv --
1.479 + *
1.480 + * Retrieve the value of an environment variable.
1.481 + *
1.482 + * Results:
1.483 + * The result is a pointer to a string specifying the value of the
1.484 + * environment variable, or NULL if that environment variable does
1.485 + * not exist. Storage for the result string is allocated in valuePtr;
1.486 + * the caller must call Tcl_DStringFree() when the result is no
1.487 + * longer needed.
1.488 + *
1.489 + * Side effects:
1.490 + * None.
1.491 + *
1.492 + *----------------------------------------------------------------------
1.493 + */
1.494 +
1.495 +CONST char *
1.496 +TclGetEnv(name, valuePtr)
1.497 + CONST char *name; /* Name of environment variable to find
1.498 + * (UTF-8). */
1.499 + Tcl_DString *valuePtr; /* Uninitialized or free DString in which
1.500 + * the value of the environment variable is
1.501 + * stored. */
1.502 +{
1.503 + int length, index;
1.504 + CONST char *result;
1.505 +
1.506 + Tcl_MutexLock(&envMutex);
1.507 + index = TclpFindVariable(name, &length);
1.508 + result = NULL;
1.509 + if (index != -1) {
1.510 + Tcl_DString envStr;
1.511 +
1.512 + result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
1.513 + result += length;
1.514 + if (*result == '=') {
1.515 + result++;
1.516 + Tcl_DStringInit(valuePtr);
1.517 + Tcl_DStringAppend(valuePtr, result, -1);
1.518 + result = Tcl_DStringValue(valuePtr);
1.519 + } else {
1.520 + result = NULL;
1.521 + }
1.522 + Tcl_DStringFree(&envStr);
1.523 + }
1.524 + Tcl_MutexUnlock(&envMutex);
1.525 + return result;
1.526 +}
1.527 +
1.528 +/*
1.529 + *----------------------------------------------------------------------
1.530 + *
1.531 + * EnvTraceProc --
1.532 + *
1.533 + * This procedure is invoked whenever an environment variable
1.534 + * is read, modified or deleted. It propagates the change to the global
1.535 + * "environ" array.
1.536 + *
1.537 + * Results:
1.538 + * Always returns NULL to indicate success.
1.539 + *
1.540 + * Side effects:
1.541 + * Environment variable changes get propagated. If the whole
1.542 + * "env" array is deleted, then we stop managing things for
1.543 + * this interpreter (usually this happens because the whole
1.544 + * interpreter is being deleted).
1.545 + *
1.546 + *----------------------------------------------------------------------
1.547 + */
1.548 +
1.549 + /* ARGSUSED */
1.550 +static char *
1.551 +EnvTraceProc(clientData, interp, name1, name2, flags)
1.552 + ClientData clientData; /* Not used. */
1.553 + Tcl_Interp *interp; /* Interpreter whose "env" variable is
1.554 + * being modified. */
1.555 + CONST char *name1; /* Better be "env". */
1.556 + CONST char *name2; /* Name of variable being modified, or NULL
1.557 + * if whole array is being deleted (UTF-8). */
1.558 + int flags; /* Indicates what's happening. */
1.559 +{
1.560 + /*
1.561 + * For array traces, let TclSetupEnv do all the work.
1.562 + */
1.563 +
1.564 + if (flags & TCL_TRACE_ARRAY) {
1.565 + TclSetupEnv(interp);
1.566 + return NULL;
1.567 + }
1.568 +
1.569 + /*
1.570 + * If name2 is NULL, then return and do nothing.
1.571 + */
1.572 +
1.573 + if (name2 == NULL) {
1.574 + return NULL;
1.575 + }
1.576 +
1.577 + /*
1.578 + * If a value is being set, call TclSetEnv to do all of the work.
1.579 + */
1.580 +
1.581 + if (flags & TCL_TRACE_WRITES) {
1.582 + CONST char *value;
1.583 +
1.584 + value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
1.585 + TclSetEnv(name2, value);
1.586 + }
1.587 +
1.588 + /*
1.589 + * If a value is being read, call TclGetEnv to do all of the work.
1.590 + */
1.591 +
1.592 + if (flags & TCL_TRACE_READS) {
1.593 + Tcl_DString valueString;
1.594 + CONST char *value;
1.595 +
1.596 + value = TclGetEnv(name2, &valueString);
1.597 + if (value == NULL) {
1.598 + return "no such variable";
1.599 + }
1.600 + Tcl_SetVar2(interp, name1, name2, value, 0);
1.601 + Tcl_DStringFree(&valueString);
1.602 + }
1.603 +
1.604 + /*
1.605 + * For unset traces, let TclUnsetEnv do all the work.
1.606 + */
1.607 +
1.608 + if (flags & TCL_TRACE_UNSETS) {
1.609 + TclUnsetEnv(name2);
1.610 + }
1.611 + return NULL;
1.612 +}
1.613 +
1.614 +/*
1.615 + *----------------------------------------------------------------------
1.616 + *
1.617 + * ReplaceString --
1.618 + *
1.619 + * Replace one string with another in the environment variable
1.620 + * cache. The cache keeps track of all of the environment
1.621 + * variables that Tcl has modified so they can be freed later.
1.622 + *
1.623 + * Results:
1.624 + * None.
1.625 + *
1.626 + * Side effects:
1.627 + * May free the old string.
1.628 + *
1.629 + *----------------------------------------------------------------------
1.630 + */
1.631 +
1.632 +static void
1.633 +ReplaceString(oldStr, newStr)
1.634 + CONST char *oldStr; /* Old environment string. */
1.635 + char *newStr; /* New environment string. */
1.636 +{
1.637 + int i;
1.638 + char **newCache;
1.639 +
1.640 + /*
1.641 + * Check to see if the old value was allocated by Tcl. If so,
1.642 + * it needs to be deallocated to avoid memory leaks. Note that this
1.643 + * algorithm is O(n), not O(1). This will result in n-squared behavior
1.644 + * if lots of environment changes are being made.
1.645 + */
1.646 +
1.647 + for (i = 0; i < cacheSize; i++) {
1.648 + if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
1.649 + break;
1.650 + }
1.651 + }
1.652 + if (i < cacheSize) {
1.653 + /*
1.654 + * Replace or delete the old value.
1.655 + */
1.656 +
1.657 + if (environCache[i]) {
1.658 + ckfree(environCache[i]);
1.659 + }
1.660 +
1.661 + if (newStr) {
1.662 + environCache[i] = newStr;
1.663 + } else {
1.664 + for (; i < cacheSize-1; i++) {
1.665 + environCache[i] = environCache[i+1];
1.666 + }
1.667 + environCache[cacheSize-1] = NULL;
1.668 + }
1.669 + } else {
1.670 + int allocatedSize = (cacheSize + 5) * sizeof(char *);
1.671 +
1.672 + /*
1.673 + * We need to grow the cache in order to hold the new string.
1.674 + */
1.675 +
1.676 + newCache = (char **) ckalloc((unsigned) allocatedSize);
1.677 + (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
1.678 +
1.679 + if (environCache) {
1.680 + memcpy((VOID *) newCache, (VOID *) environCache,
1.681 + (size_t) (cacheSize * sizeof(char*)));
1.682 + ckfree((char *) environCache);
1.683 + }
1.684 + environCache = newCache;
1.685 + environCache[cacheSize] = newStr;
1.686 + environCache[cacheSize+1] = NULL;
1.687 + cacheSize += 5;
1.688 + }
1.689 +}
1.690 +
1.691 +/*
1.692 + *----------------------------------------------------------------------
1.693 + *
1.694 + * TclFinalizeEnvironment --
1.695 + *
1.696 + * This function releases any storage allocated by this module
1.697 + * that isn't still in use by the global environment. Any
1.698 + * strings that are still in the environment will be leaked.
1.699 + *
1.700 + * Results:
1.701 + * None.
1.702 + *
1.703 + * Side effects:
1.704 + * May deallocate storage.
1.705 + *
1.706 + *----------------------------------------------------------------------
1.707 + */
1.708 +
1.709 +void
1.710 +TclFinalizeEnvironment()
1.711 +{
1.712 + /*
1.713 + * For now we just deallocate the cache array and none of the environment
1.714 + * strings. This may leak more memory that strictly necessary, since some
1.715 + * of the strings may no longer be in the environment. However,
1.716 + * determining which ones are ok to delete is n-squared, and is pretty
1.717 + * unlikely, so we don't bother.
1.718 + */
1.719 +
1.720 + if (environCache) {
1.721 + ckfree((char *) environCache);
1.722 + environCache = NULL;
1.723 + cacheSize = 0;
1.724 +#ifndef USE_PUTENV
1.725 + environSize = 0;
1.726 +#endif
1.727 + }
1.728 +}
1.729 +
1.730 +#if defined(__CYGWIN__) && defined(__WIN32__)
1.731 +
1.732 +#include <windows.h>
1.733 +
1.734 +/*
1.735 + * When using cygwin, when an environment variable changes, we need to synch
1.736 + * with both the cygwin environment (in case the application C code calls
1.737 + * fork) and the Windows environment (in case the application TCL code calls
1.738 + * exec, which calls the Windows CreateProcess function).
1.739 + */
1.740 +
1.741 +static void
1.742 +TclCygwinPutenv(str)
1.743 + const char *str;
1.744 +{
1.745 + char *name, *value;
1.746 +
1.747 + /* Get the name and value, so that we can change the environment
1.748 + variable for Windows. */
1.749 + name = (char *) alloca (strlen (str) + 1);
1.750 + strcpy (name, str);
1.751 + for (value = name; *value != '=' && *value != '\0'; ++value)
1.752 + ;
1.753 + if (*value == '\0') {
1.754 + /* Can't happen. */
1.755 + return;
1.756 + }
1.757 + *value = '\0';
1.758 + ++value;
1.759 + if (*value == '\0') {
1.760 + value = NULL;
1.761 + }
1.762 +
1.763 + /* Set the cygwin environment variable. */
1.764 +#undef putenv
1.765 + if (value == NULL) {
1.766 + unsetenv (name);
1.767 + } else {
1.768 + putenv(str);
1.769 + }
1.770 +
1.771 + /*
1.772 + * Before changing the environment variable in Windows, if this is PATH,
1.773 + * we need to convert the value back to a Windows style path.
1.774 + *
1.775 + * FIXME: The calling program may know it is running under windows, and
1.776 + * may have set the path to a Windows path, or, worse, appended or
1.777 + * prepended a Windows path to PATH.
1.778 + */
1.779 + if (strcmp (name, "PATH") != 0) {
1.780 + /* If this is Path, eliminate any PATH variable, to prevent any
1.781 + confusion. */
1.782 + if (strcmp (name, "Path") == 0) {
1.783 + SetEnvironmentVariable ("PATH", (char *) NULL);
1.784 + unsetenv ("PATH");
1.785 + }
1.786 +
1.787 + SetEnvironmentVariable (name, value);
1.788 + } else {
1.789 + char *buf;
1.790 +
1.791 + /* Eliminate any Path variable, to prevent any confusion. */
1.792 + SetEnvironmentVariable ("Path", (char *) NULL);
1.793 + unsetenv ("Path");
1.794 +
1.795 + if (value == NULL) {
1.796 + buf = NULL;
1.797 + } else {
1.798 + int size;
1.799 +
1.800 + size = cygwin_posix_to_win32_path_list_buf_size (value);
1.801 + buf = (char *) alloca (size + 1);
1.802 + cygwin_posix_to_win32_path_list (value, buf);
1.803 + }
1.804 +
1.805 + SetEnvironmentVariable (name, buf);
1.806 + }
1.807 +}
1.808 +
1.809 +#endif /* __CYGWIN__ && __WIN32__ */