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