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