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