1/* 2 * tclEnv.c -- 3 * 4 * Tcl support for environment variables, including a setenv 5 * procedure. This file contains the generic portion of the 6 * environment module. It is primarily responsible for keeping 7 * the "env" arrays in sync with the system environment variables. 8 * 9 * Copyright (c) 1991-1994 The Regents of the University of California. 10 * Copyright (c) 1994-1998 Sun Microsystems, Inc. 11 * 12 * See the file "license.terms" for information on usage and redistribution 13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 * 15 * RCS: @(#) $Id: tclEnv.c,v 1.20.2.4 2007/08/07 05:04:48 das Exp $ 16 */ 17 18#include "tclInt.h" 19#include "tclPort.h" 20 21TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */ 22 23static int cacheSize = 0; /* Number of env strings in environCache. */ 24static char **environCache = NULL; 25 /* Array containing all of the environment 26 * strings that Tcl has allocated. */ 27 28#ifndef USE_PUTENV 29static char **ourEnviron = NULL;/* Cache of the array that we allocate. 30 * We need to track this in case another 31 * subsystem swaps around the environ array 32 * like we do. 33 */ 34static int environSize = 0; /* Non-zero means that the environ array was 35 * malloced and has this many total entries 36 * allocated to it (not all may be in use at 37 * once). Zero means that the environment 38 * array is in its original static state. */ 39#endif 40 41/* 42 * Declarations for local procedures defined in this file: 43 */ 44 45static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData, 46 Tcl_Interp *interp, CONST char *name1, 47 CONST char *name2, int flags)); 48static void ReplaceString _ANSI_ARGS_((CONST char *oldStr, 49 char *newStr)); 50void TclSetEnv _ANSI_ARGS_((CONST char *name, 51 CONST char *value)); 52void TclUnsetEnv _ANSI_ARGS_((CONST char *name)); 53 54#if defined (__CYGWIN__) && defined(__WIN32__) 55static void TclCygwinPutenv _ANSI_ARGS_((CONST char *string)); 56#endif 57 58/* 59 *---------------------------------------------------------------------- 60 * 61 * TclSetupEnv -- 62 * 63 * This procedure is invoked for an interpreter to make environment 64 * variables accessible from that interpreter via the "env" 65 * associative array. 66 * 67 * Results: 68 * None. 69 * 70 * Side effects: 71 * The interpreter is added to a list of interpreters managed 72 * by us, so that its view of envariables can be kept consistent 73 * with the view in other interpreters. If this is the first 74 * call to TclSetupEnv, then additional initialization happens, 75 * such as copying the environment to dynamically-allocated space 76 * for ease of management. 77 * 78 *---------------------------------------------------------------------- 79 */ 80 81void 82TclSetupEnv(interp) 83 Tcl_Interp *interp; /* Interpreter whose "env" array is to be 84 * managed. */ 85{ 86 Tcl_DString envString; 87 char *p1, *p2; 88 int i; 89 90 /* 91 * Synchronize the values in the environ array with the contents 92 * of the Tcl "env" variable. To do this: 93 * 1) Remove the trace that fires when the "env" var is unset. 94 * 2) Unset the "env" variable. 95 * 3) If there are no environ variables, create an empty "env" 96 * array. Otherwise populate the array with current values. 97 * 4) Add a trace that synchronizes the "env" array. 98 */ 99 100 Tcl_UntraceVar2(interp, "env", (char *) NULL, 101 TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 102 TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, 103 (ClientData) NULL); 104 105 Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 106 107 if (environ[0] == NULL) { 108 Tcl_Obj *varNamePtr; 109 110 varNamePtr = Tcl_NewStringObj("env", -1); 111 Tcl_IncrRefCount(varNamePtr); 112 TclArraySet(interp, varNamePtr, NULL); 113 Tcl_DecrRefCount(varNamePtr); 114 } else { 115 Tcl_MutexLock(&envMutex); 116 for (i = 0; environ[i] != NULL; i++) { 117 p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString); 118 p2 = strchr(p1, '='); 119 if (p2 == NULL) { 120 /* 121 * This condition seem to happen occasionally under some 122 * versions of Solaris; ignore the entry. 123 */ 124 125 continue; 126 } 127 p2++; 128 p2[-1] = '\0'; 129 Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY); 130 Tcl_DStringFree(&envString); 131 } 132 Tcl_MutexUnlock(&envMutex); 133 } 134 135 Tcl_TraceVar2(interp, "env", (char *) NULL, 136 TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 137 TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, 138 (ClientData) NULL); 139} 140 141/* 142 *---------------------------------------------------------------------- 143 * 144 * TclSetEnv -- 145 * 146 * Set an environment variable, replacing an existing value 147 * or creating a new variable if there doesn't exist a variable 148 * by the given name. This procedure is intended to be a 149 * stand-in for the UNIX "setenv" procedure so that applications 150 * using that procedure will interface properly to Tcl. To make 151 * it a stand-in, the Makefile must define "TclSetEnv" to "setenv". 152 * 153 * Results: 154 * None. 155 * 156 * Side effects: 157 * The environ array gets updated. 158 * 159 *---------------------------------------------------------------------- 160 */ 161 162void 163TclSetEnv(name, value) 164 CONST char *name; /* Name of variable whose value is to be 165 * set (UTF-8). */ 166 CONST char *value; /* New value for variable (UTF-8). */ 167{ 168 Tcl_DString envString; 169 int index, length, nameLength; 170 char *p, *oldValue; 171 CONST char *p2; 172 173 /* 174 * Figure out where the entry is going to go. If the name doesn't 175 * already exist, enlarge the array if necessary to make room. If the 176 * name exists, free its old entry. 177 */ 178 179 Tcl_MutexLock(&envMutex); 180 index = TclpFindVariable(name, &length); 181 182 if (index == -1) { 183#ifndef USE_PUTENV 184 /* 185 * We need to handle the case where the environment may be changed 186 * outside our control. environSize is only valid if the current 187 * environment is the one we allocated. [Bug 979640] 188 */ 189 if ((ourEnviron != environ) || ((length + 2) > environSize)) { 190 char **newEnviron; 191 192 newEnviron = (char **) ckalloc((unsigned) 193 ((length + 5) * sizeof(char *))); 194 memcpy((VOID *) newEnviron, (VOID *) environ, 195 length*sizeof(char *)); 196 if ((environSize != 0) && (ourEnviron != NULL)) { 197 ckfree((char *) ourEnviron); 198 } 199 environ = ourEnviron = newEnviron; 200 environSize = length + 5; 201 } 202 index = length; 203 environ[index + 1] = NULL; 204#endif 205 oldValue = NULL; 206 nameLength = strlen(name); 207 } else { 208 CONST char *env; 209 210 /* 211 * Compare the new value to the existing value. If they're 212 * the same then quit immediately (e.g. don't rewrite the 213 * value or propagate it to other interpreters). Otherwise, 214 * when there are N interpreters there will be N! propagations 215 * of the same value among the interpreters. 216 */ 217 218 env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString); 219 if (strcmp(value, (env + length + 1)) == 0) { 220 Tcl_DStringFree(&envString); 221 Tcl_MutexUnlock(&envMutex); 222 return; 223 } 224 Tcl_DStringFree(&envString); 225 226 oldValue = environ[index]; 227 nameLength = length; 228 } 229 230 /* 231 * Create a new entry. Build a complete UTF string that contains 232 * a "name=value" pattern. Then convert the string to the native 233 * encoding, and set the environ array value. 234 */ 235 236 p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2)); 237 strcpy(p, name); 238 p[nameLength] = '='; 239 strcpy(p+nameLength+1, value); 240 p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString); 241 242 /* 243 * Copy the native string to heap memory. 244 */ 245 246 p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1)); 247 strcpy(p, p2); 248 Tcl_DStringFree(&envString); 249 250#ifdef USE_PUTENV 251 /* 252 * Update the system environment. 253 */ 254 255 putenv(p); 256 index = TclpFindVariable(name, &length); 257#else 258 environ[index] = p; 259#endif 260 261 /* 262 * Watch out for versions of putenv that copy the string (e.g. VC++). 263 * In this case we need to free the string immediately. Otherwise 264 * update the string in the cache. 265 */ 266 267 if ((index != -1) && (environ[index] == p)) { 268 ReplaceString(oldValue, p); 269#ifdef HAVE_PUTENV_THAT_COPIES 270 } else { 271 /* This putenv() copies instead of taking ownership */ 272 ckfree(p); 273#endif 274 } 275 276 Tcl_MutexUnlock(&envMutex); 277 278 if (!strcmp(name, "HOME")) { 279 /* 280 * If the user's home directory has changed, we must invalidate 281 * the filesystem cache, because '~' expansions will now be 282 * incorrect. 283 */ 284 Tcl_FSMountsChanged(NULL); 285 } 286} 287 288/* 289 *---------------------------------------------------------------------- 290 * 291 * Tcl_PutEnv -- 292 * 293 * Set an environment variable. Similar to setenv except that 294 * the information is passed in a single string of the form 295 * NAME=value, rather than as separate name strings. This procedure 296 * is intended to be a stand-in for the UNIX "putenv" procedure 297 * so that applications using that procedure will interface 298 * properly to Tcl. To make it a stand-in, the Makefile will 299 * define "Tcl_PutEnv" to "putenv". 300 * 301 * Results: 302 * None. 303 * 304 * Side effects: 305 * The environ array gets updated, as do all of the interpreters 306 * that we manage. 307 * 308 *---------------------------------------------------------------------- 309 */ 310 311int 312Tcl_PutEnv(string) 313 CONST char *string; /* Info about environment variable in the 314 * form NAME=value. (native) */ 315{ 316 Tcl_DString nameString; 317 CONST char *name; 318 char *value; 319 320 if (string == NULL) { 321 return 0; 322 } 323 324 /* 325 * First convert the native string to UTF. Then separate the 326 * string into name and value parts, and call TclSetEnv to do 327 * all of the real work. 328 */ 329 330 name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString); 331 value = strchr(name, '='); 332 333 if ((value != NULL) && (value != name)) { 334 value[0] = '\0'; 335 TclSetEnv(name, value+1); 336 } 337 338 Tcl_DStringFree(&nameString); 339 return 0; 340} 341 342/* 343 *---------------------------------------------------------------------- 344 * 345 * TclUnsetEnv -- 346 * 347 * Remove an environment variable, updating the "env" arrays 348 * in all interpreters managed by us. This function is intended 349 * to replace the UNIX "unsetenv" function (but to do this the 350 * Makefile must be modified to redefine "TclUnsetEnv" to 351 * "unsetenv". 352 * 353 * Results: 354 * None. 355 * 356 * Side effects: 357 * Interpreters are updated, as is environ. 358 * 359 *---------------------------------------------------------------------- 360 */ 361 362void 363TclUnsetEnv(name) 364 CONST char *name; /* Name of variable to remove (UTF-8). */ 365{ 366 char *oldValue; 367 int length; 368 int index; 369#ifdef USE_PUTENV_FOR_UNSET 370 Tcl_DString envString; 371 char *string; 372#else 373 char **envPtr; 374#endif 375 376 Tcl_MutexLock(&envMutex); 377 index = TclpFindVariable(name, &length); 378 379 /* 380 * First make sure that the environment variable exists to avoid 381 * doing needless work and to avoid recursion on the unset. 382 */ 383 384 if (index == -1) { 385 Tcl_MutexUnlock(&envMutex); 386 return; 387 } 388 /* 389 * Remember the old value so we can free it if Tcl created the string. 390 */ 391 392 oldValue = environ[index]; 393 394 /* 395 * Update the system environment. This must be done before we 396 * update the interpreters or we will recurse. 397 */ 398 399#ifdef USE_PUTENV_FOR_UNSET 400 /* 401 * For those platforms that support putenv to unset, Linux indicates 402 * that no = should be included, and Windows requires it. 403 */ 404#ifdef WIN32 405 string = ckalloc((unsigned int) length+2); 406 memcpy((VOID *) string, (VOID *) name, (size_t) length); 407 string[length] = '='; 408 string[length+1] = '\0'; 409#else 410 string = ckalloc((unsigned int) length+1); 411 memcpy((VOID *) string, (VOID *) name, (size_t) length); 412 string[length] = '\0'; 413#endif 414 415 Tcl_UtfToExternalDString(NULL, string, -1, &envString); 416 string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1)); 417 strcpy(string, Tcl_DStringValue(&envString)); 418 Tcl_DStringFree(&envString); 419 420 putenv(string); 421 422 /* 423 * Watch out for versions of putenv that copy the string (e.g. VC++). 424 * In this case we need to free the string immediately. Otherwise 425 * update the string in the cache. 426 */ 427 428 if (environ[index] == string) { 429 ReplaceString(oldValue, string); 430#ifdef HAVE_PUTENV_THAT_COPIES 431 } else { 432 /* This putenv() copies instead of taking ownership */ 433 ckfree(string); 434#endif 435 } 436#else 437 for (envPtr = environ+index+1; ; envPtr++) { 438 envPtr[-1] = *envPtr; 439 if (*envPtr == NULL) { 440 break; 441 } 442 } 443 ReplaceString(oldValue, NULL); 444#endif 445 446 Tcl_MutexUnlock(&envMutex); 447} 448 449/* 450 *--------------------------------------------------------------------------- 451 * 452 * TclGetEnv -- 453 * 454 * Retrieve the value of an environment variable. 455 * 456 * Results: 457 * The result is a pointer to a string specifying the value of the 458 * environment variable, or NULL if that environment variable does 459 * not exist. Storage for the result string is allocated in valuePtr; 460 * the caller must call Tcl_DStringFree() when the result is no 461 * longer needed. 462 * 463 * Side effects: 464 * None. 465 * 466 *---------------------------------------------------------------------- 467 */ 468 469CONST char * 470TclGetEnv(name, valuePtr) 471 CONST char *name; /* Name of environment variable to find 472 * (UTF-8). */ 473 Tcl_DString *valuePtr; /* Uninitialized or free DString in which 474 * the value of the environment variable is 475 * stored. */ 476{ 477 int length, index; 478 CONST char *result; 479 480 Tcl_MutexLock(&envMutex); 481 index = TclpFindVariable(name, &length); 482 result = NULL; 483 if (index != -1) { 484 Tcl_DString envStr; 485 486 result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr); 487 result += length; 488 if (*result == '=') { 489 result++; 490 Tcl_DStringInit(valuePtr); 491 Tcl_DStringAppend(valuePtr, result, -1); 492 result = Tcl_DStringValue(valuePtr); 493 } else { 494 result = NULL; 495 } 496 Tcl_DStringFree(&envStr); 497 } 498 Tcl_MutexUnlock(&envMutex); 499 return result; 500} 501 502/* 503 *---------------------------------------------------------------------- 504 * 505 * EnvTraceProc -- 506 * 507 * This procedure is invoked whenever an environment variable 508 * is read, modified or deleted. It propagates the change to the global 509 * "environ" array. 510 * 511 * Results: 512 * Always returns NULL to indicate success. 513 * 514 * Side effects: 515 * Environment variable changes get propagated. If the whole 516 * "env" array is deleted, then we stop managing things for 517 * this interpreter (usually this happens because the whole 518 * interpreter is being deleted). 519 * 520 *---------------------------------------------------------------------- 521 */ 522 523 /* ARGSUSED */ 524static char * 525EnvTraceProc(clientData, interp, name1, name2, flags) 526 ClientData clientData; /* Not used. */ 527 Tcl_Interp *interp; /* Interpreter whose "env" variable is 528 * being modified. */ 529 CONST char *name1; /* Better be "env". */ 530 CONST char *name2; /* Name of variable being modified, or NULL 531 * if whole array is being deleted (UTF-8). */ 532 int flags; /* Indicates what's happening. */ 533{ 534 /* 535 * For array traces, let TclSetupEnv do all the work. 536 */ 537 538 if (flags & TCL_TRACE_ARRAY) { 539 TclSetupEnv(interp); 540 return NULL; 541 } 542 543 /* 544 * If name2 is NULL, then return and do nothing. 545 */ 546 547 if (name2 == NULL) { 548 return NULL; 549 } 550 551 /* 552 * If a value is being set, call TclSetEnv to do all of the work. 553 */ 554 555 if (flags & TCL_TRACE_WRITES) { 556 CONST char *value; 557 558 value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY); 559 TclSetEnv(name2, value); 560 } 561 562 /* 563 * If a value is being read, call TclGetEnv to do all of the work. 564 */ 565 566 if (flags & TCL_TRACE_READS) { 567 Tcl_DString valueString; 568 CONST char *value; 569 570 value = TclGetEnv(name2, &valueString); 571 if (value == NULL) { 572 return "no such variable"; 573 } 574 Tcl_SetVar2(interp, name1, name2, value, 0); 575 Tcl_DStringFree(&valueString); 576 } 577 578 /* 579 * For unset traces, let TclUnsetEnv do all the work. 580 */ 581 582 if (flags & TCL_TRACE_UNSETS) { 583 TclUnsetEnv(name2); 584 } 585 return NULL; 586} 587 588/* 589 *---------------------------------------------------------------------- 590 * 591 * ReplaceString -- 592 * 593 * Replace one string with another in the environment variable 594 * cache. The cache keeps track of all of the environment 595 * variables that Tcl has modified so they can be freed later. 596 * 597 * Results: 598 * None. 599 * 600 * Side effects: 601 * May free the old string. 602 * 603 *---------------------------------------------------------------------- 604 */ 605 606static void 607ReplaceString(oldStr, newStr) 608 CONST char *oldStr; /* Old environment string. */ 609 char *newStr; /* New environment string. */ 610{ 611 int i; 612 char **newCache; 613 614 /* 615 * Check to see if the old value was allocated by Tcl. If so, 616 * it needs to be deallocated to avoid memory leaks. Note that this 617 * algorithm is O(n), not O(1). This will result in n-squared behavior 618 * if lots of environment changes are being made. 619 */ 620 621 for (i = 0; i < cacheSize; i++) { 622 if ((environCache[i] == oldStr) || (environCache[i] == NULL)) { 623 break; 624 } 625 } 626 if (i < cacheSize) { 627 /* 628 * Replace or delete the old value. 629 */ 630 631 if (environCache[i]) { 632 ckfree(environCache[i]); 633 } 634 635 if (newStr) { 636 environCache[i] = newStr; 637 } else { 638 for (; i < cacheSize-1; i++) { 639 environCache[i] = environCache[i+1]; 640 } 641 environCache[cacheSize-1] = NULL; 642 } 643 } else { 644 int allocatedSize = (cacheSize + 5) * sizeof(char *); 645 646 /* 647 * We need to grow the cache in order to hold the new string. 648 */ 649 650 newCache = (char **) ckalloc((unsigned) allocatedSize); 651 (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize); 652 653 if (environCache) { 654 memcpy((VOID *) newCache, (VOID *) environCache, 655 (size_t) (cacheSize * sizeof(char*))); 656 ckfree((char *) environCache); 657 } 658 environCache = newCache; 659 environCache[cacheSize] = newStr; 660 environCache[cacheSize+1] = NULL; 661 cacheSize += 5; 662 } 663} 664 665/* 666 *---------------------------------------------------------------------- 667 * 668 * TclFinalizeEnvironment -- 669 * 670 * This function releases any storage allocated by this module 671 * that isn't still in use by the global environment. Any 672 * strings that are still in the environment will be leaked. 673 * 674 * Results: 675 * None. 676 * 677 * Side effects: 678 * May deallocate storage. 679 * 680 *---------------------------------------------------------------------- 681 */ 682 683void 684TclFinalizeEnvironment() 685{ 686 /* 687 * For now we just deallocate the cache array and none of the environment 688 * strings. This may leak more memory that strictly necessary, since some 689 * of the strings may no longer be in the environment. However, 690 * determining which ones are ok to delete is n-squared, and is pretty 691 * unlikely, so we don't bother. 692 */ 693 694 if (environCache) { 695 ckfree((char *) environCache); 696 environCache = NULL; 697 cacheSize = 0; 698#ifndef USE_PUTENV 699 environSize = 0; 700#endif 701 } 702} 703 704#if defined(__CYGWIN__) && defined(__WIN32__) 705 706#include <windows.h> 707 708/* 709 * When using cygwin, when an environment variable changes, we need to synch 710 * with both the cygwin environment (in case the application C code calls 711 * fork) and the Windows environment (in case the application TCL code calls 712 * exec, which calls the Windows CreateProcess function). 713 */ 714 715static void 716TclCygwinPutenv(str) 717 const char *str; 718{ 719 char *name, *value; 720 721 /* Get the name and value, so that we can change the environment 722 variable for Windows. */ 723 name = (char *) alloca (strlen (str) + 1); 724 strcpy (name, str); 725 for (value = name; *value != '=' && *value != '\0'; ++value) 726 ; 727 if (*value == '\0') { 728 /* Can't happen. */ 729 return; 730 } 731 *value = '\0'; 732 ++value; 733 if (*value == '\0') { 734 value = NULL; 735 } 736 737 /* Set the cygwin environment variable. */ 738#undef putenv 739 if (value == NULL) { 740 unsetenv (name); 741 } else { 742 putenv(str); 743 } 744 745 /* 746 * Before changing the environment variable in Windows, if this is PATH, 747 * we need to convert the value back to a Windows style path. 748 * 749 * FIXME: The calling program may know it is running under windows, and 750 * may have set the path to a Windows path, or, worse, appended or 751 * prepended a Windows path to PATH. 752 */ 753 if (strcmp (name, "PATH") != 0) { 754 /* If this is Path, eliminate any PATH variable, to prevent any 755 confusion. */ 756 if (strcmp (name, "Path") == 0) { 757 SetEnvironmentVariable ("PATH", (char *) NULL); 758 unsetenv ("PATH"); 759 } 760 761 SetEnvironmentVariable (name, value); 762 } else { 763 char *buf; 764 765 /* Eliminate any Path variable, to prevent any confusion. */ 766 SetEnvironmentVariable ("Path", (char *) NULL); 767 unsetenv ("Path"); 768 769 if (value == NULL) { 770 buf = NULL; 771 } else { 772 int size; 773 774 size = cygwin_posix_to_win32_path_list_buf_size (value); 775 buf = (char *) alloca (size + 1); 776 cygwin_posix_to_win32_path_list (value, buf); 777 } 778 779 SetEnvironmentVariable (name, buf); 780 } 781} 782 783#endif /* __CYGWIN__ && __WIN32__ */ 784