]> git.zerfleddert.de Git - micropolis/blame - src/tcl/tclenv.c
disable image translation until a case is found where it is really needed
[micropolis] / src / tcl / tclenv.c
CommitLineData
6a5fa4e0
MG
1/*
2 * tclEnv.c --
3 *
4 * Tcl support for environment variables, including a setenv
5 * procedure.
6 *
7 * Copyright 1991 Regents of the University of California
8 * Permission to use, copy, modify, and distribute this
9 * software and its documentation for any purpose and without
10 * fee is hereby granted, provided that this copyright
11 * notice appears in all copies. The University of California
12 * makes no representations about the suitability of this
13 * software for any purpose. It is provided "as is" without
14 * express or implied warranty.
15 */
16
17#ifndef lint
18static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclEnv.c,v 1.7 91/09/23 11:22:21 ouster Exp $ SPRITE (Berkeley)";
19#endif /* not lint */
20
21#include "tclint.h"
22#include "tclunix.h"
23
24/*
25 * The structure below is used to keep track of all of the interpereters
26 * for which we're managing the "env" array. It's needed so that they
27 * can all be updated whenever an environment variable is changed
28 * anywhere.
29 */
30
31typedef struct EnvInterp {
32 Tcl_Interp *interp; /* Interpreter for which we're managing
33 * the env array. */
34 struct EnvInterp *nextPtr; /* Next in list of all such interpreters,
35 * or zero. */
36} EnvInterp;
37
38static EnvInterp *firstInterpPtr;
39 /* First in list of all managed interpreters,
40 * or NULL if none. */
41
42static int environSize = 0; /* Non-zero means that the all of the
43 * environ-related information is malloc-ed
44 * and the environ array itself has this
45 * many total entries allocated to it (not
46 * all may be in use at once). Zero means
47 * that the environment array is in its
48 * original static state. */
49
50/*
51 * Declarations for local procedures defined in this file:
52 */
53
54static void EnvInit _ANSI_ARGS_((void));
55static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
56 Tcl_Interp *interp, char *name1, char *name2,
57 int flags));
58static int FindVariable _ANSI_ARGS_((char *name, int *lengthPtr));
59
60#ifdef IS_LINUX
61int setenv _ANSI_ARGS_((const char *name, const char *value, int replace));
62int unsetenv _ANSI_ARGS_((const char *name));
63#else
64void setenv _ANSI_ARGS_((char *name, char *value));
65void unsetenv _ANSI_ARGS_((char *name));
66#endif
67
68\f
69/*
70 *----------------------------------------------------------------------
71 *
72 * TclSetupEnv --
73 *
74 * This procedure is invoked for an interpreter to make environment
75 * variables accessible from that interpreter via the "env"
76 * associative array.
77 *
78 * Results:
79 * None.
80 *
81 * Side effects:
82 * The interpreter is added to a list of interpreters managed
83 * by us, so that its view of envariables can be kept consistent
84 * with the view in other interpreters. If this is the first
85 * call to Tcl_SetupEnv, then additional initialization happens,
86 * such as copying the environment to dynamically-allocated space
87 * for ease of management.
88 *
89 *----------------------------------------------------------------------
90 */
91
92void
93TclSetupEnv(interp)
94 Tcl_Interp *interp; /* Interpreter whose "env" array is to be
95 * managed. */
96{
97 EnvInterp *eiPtr;
98 int i;
99
100 /*
101 * First, initialize our environment-related information, if
102 * necessary.
103 */
104
105 if (environSize == 0) {
106 EnvInit();
107 }
108
109 /*
110 * Next, add the interpreter to the list of those that we manage.
111 */
112
113 eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
114 eiPtr->interp = interp;
115 eiPtr->nextPtr = firstInterpPtr;
116 firstInterpPtr = eiPtr;
117
118 /*
119 * Store the environment variable values into the interpreter's
120 * "env" array, and arrange for us to be notified on future
121 * writes and unsets to that array.
122 */
123
124 (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
125 for (i = 0; ; i++) {
126 char *p, *p2;
127
128 p = environ[i];
129 if (p == NULL) {
130 break;
131 }
132 for (p2 = p; *p2 != '='; p2++) {
133 /* Empty loop body. */
134 }
135 *p2 = 0;
136 (void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
137 *p2 = '=';
138 }
139 Tcl_TraceVar2(interp, "env", (char *) NULL,
140 TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
141 EnvTraceProc, (ClientData) NULL);
142}
143\f
144/*
145 *----------------------------------------------------------------------
146 *
147 * FindVariable --
148 *
149 * Locate the entry in environ for a given name.
150 *
151 * Results:
152 * The return value is the index in environ of an entry with the
153 * name "name", or -1 if there is no such entry. The integer at
154 * *lengthPtr is filled in with the length of name (if a matching
155 * entry is found) or the length of the environ array (if no matching
156 * entry is found).
157 *
158 * Side effects:
159 * None.
160 *
161 *----------------------------------------------------------------------
162 */
163
164static int
165FindVariable(name, lengthPtr)
166 char *name; /* Name of desired environment variable. */
167 int *lengthPtr; /* Used to return length of name (for
168 * successful searches) or number of non-NULL
169 * entries in environ (for unsuccessful
170 * searches). */
171{
172 int i;
173 register char *p1, *p2;
174
175 for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
176 for (p2 = name; *p2 == *p1; p1++, p2++) {
177 /* NULL loop body. */
178 }
179 if ((*p1 == '=') && (*p2 == '\0')) {
180 *lengthPtr = p2-name;
181 return i;
182 }
183 }
184 *lengthPtr = i;
185 return -1;
186}
187\f
188/*
189 *----------------------------------------------------------------------
190 *
191 * setenv --
192 *
193 * Set an environment variable, replacing an existing value
194 * or creating a new variable if there doesn't exist a variable
195 * by the given name.
196 *
197 * Results:
198 * None.
199 *
200 * Side effects:
201 * The environ array gets updated, as do all of the interpreters
202 * that we manage.
203 *
204 *----------------------------------------------------------------------
205 */
206
207#ifdef IS_LINUX
208int
209setenv(name, value, replace)
210 const char *name; /* Name of variable whose value is to be
211 * set. */
212 const char *value; /* New value for variable. */
213 int replace;
214#else
215void
216setenv(name, value)
217 char *name; /* Name of variable whose value is to be
218 * set. */
219 char *value; /* New value for variable. */
220#endif
221{
222 int index, length, nameLength;
223 char *p;
224 EnvInterp *eiPtr;
225
226 if (environSize == 0) {
227 EnvInit();
228 }
229
230 /*
231 * Figure out where the entry is going to go. If the name doesn't
232 * already exist, enlarge the array if necessary to make room. If
233 * the name exists, free its old entry.
234 */
235
236 index = FindVariable((char *)name, &length);
237 if (index == -1) {
238 if ((length+2) > environSize) {
239 char **newEnviron;
240
241 newEnviron = (char **) ckalloc((unsigned)
242 ((length+5) * sizeof(char *)));
243 memcpy((VOID *) newEnviron, (VOID *) environ,
244 length*sizeof(char *));
245 ckfree((char *) environ);
246 environ = newEnviron;
247 environSize = length+5;
248 }
249 index = length;
250 environ[index+1] = NULL;
251 nameLength = strlen(name);
252 } else {
253 ckfree(environ[index]);
254 nameLength = length;
255 }
256
257 /*
258 * Create a new entry and enter it into the table.
259 */
260
261 p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
262 environ[index] = p;
263 strcpy(p, name);
264 p += nameLength;
265 *p = '=';
266 strcpy(p+1, value);
267
268 /*
269 * Update all of the interpreters.
270 */
271
272 for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
273 (void) Tcl_SetVar2(eiPtr->interp, "env", (char *)name, p+1, TCL_GLOBAL_ONLY);
274 }
275
276#ifdef IS_LINUX
277 return 0;
278#endif
279
280}
281\f
282/*
283 *----------------------------------------------------------------------
284 *
285 * unsetenv --
286 *
287 * Remove an environment variable, updating the "env" arrays
288 * in all interpreters managed by us.
289 *
290 * Results:
291 * None.
292 *
293 * Side effects:
294 * Interpreters are updated, as is environ.
295 *
296 *----------------------------------------------------------------------
297 */
298
299int
300unsetenv(name)
301#ifdef IS_LINUX
302 const char *name; /* Name of variable to remove. */
303#else
304 char *name; /* Name of variable to remove. */
305#endif
306{
307 int index, dummy;
308 char **envPtr;
309 EnvInterp *eiPtr;
310
311 if (environSize == 0) {
312 EnvInit();
313 }
314
315 /*
316 * Update the environ array.
317 */
318
319 index = FindVariable((char *)name, &dummy);
320 if (index == -1) {
321 return;
322 }
323 ckfree(environ[index]);
324 for (envPtr = environ+index+1; ; envPtr++) {
325 envPtr[-1] = *envPtr;
326 if (*envPtr == NULL) {
327 break;
328 }
329 }
330
331 /*
332 * Update all of the interpreters.
333 */
334
335 for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
336 (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *)name, TCL_GLOBAL_ONLY);
337 }
338}
339\f
340/*
341 *----------------------------------------------------------------------
342 *
343 * EnvTraceProc --
344 *
345 * This procedure is invoked whenever an environment variable
346 * is modified or deleted. It propagates the change to the
347 * "environ" array and to any other interpreters for whom
348 * we're managing an "env" array.
349 *
350 * Results:
351 * Always returns NULL to indicate success.
352 *
353 * Side effects:
354 * Environment variable changes get propagated. If the whole
355 * "env" array is deleted, then we stop managing things for
356 * this interpreter (usually this happens because the whole
357 * interpreter is being deleted).
358 *
359 *----------------------------------------------------------------------
360 */
361
362 /* ARGSUSED */
363static char *
364EnvTraceProc(clientData, interp, name1, name2, flags)
365 ClientData clientData; /* Not used. */
366 Tcl_Interp *interp; /* Interpreter whose "env" variable is
367 * being modified. */
368 char *name1; /* Better be "env". */
369 char *name2; /* Name of variable being modified, or
370 * NULL if whole array is being deleted. */
371 int flags; /* Indicates what's happening. */
372{
373 /*
374 * First see if the whole "env" variable is being deleted. If
375 * so, just forget about this interpreter.
376 */
377
378 if (name2 == NULL) {
379 register EnvInterp *eiPtr, *prevPtr;
380
381 if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
382 != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
383 panic("EnvTraceProc called with confusing arguments");
384 }
385 eiPtr = firstInterpPtr;
386 if (eiPtr->interp == interp) {
387 firstInterpPtr = eiPtr->nextPtr;
388 } else {
389 for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
390 prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
391 if (eiPtr == NULL) {
392 panic("EnvTraceProc couldn't find interpreter");
393 }
394 if (eiPtr->interp == interp) {
395 prevPtr->nextPtr = eiPtr->nextPtr;
396 break;
397 }
398 }
399 }
400 ckfree((char *) eiPtr);
401 return NULL;
402 }
403
404 /*
405 * If a value is being set, call setenv to do all of the work.
406 */
407
408 if (flags & TCL_TRACE_WRITES) {
409 setenv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY), 0);
410 }
411
412 if (flags & TCL_TRACE_UNSETS) {
413 unsetenv(name2);
414 }
415 return NULL;
416}
417\f
418/*
419 *----------------------------------------------------------------------
420 *
421 * EnvInit --
422 *
423 * This procedure is called to initialize our management
424 * of the environ array.
425 *
426 * Results:
427 * None.
428 *
429 * Side effects:
430 * Environ gets copied to malloc-ed storage, so that in
431 * the future we don't have to worry about which entries
432 * are malloc-ed and which are static.
433 *
434 *----------------------------------------------------------------------
435 */
436
437static void
438EnvInit()
439{
440 char **newEnviron;
441 int i, length;
442
443 if (environSize != 0) {
444 return;
445 }
446 for (length = 0; environ[length] != NULL; length++) {
447 /* Empty loop body. */
448 }
449 environSize = length+5;
450 newEnviron = (char **) ckalloc((unsigned)
451 (environSize * sizeof(char *)));
452 for (i = 0; i < length; i++) {
453 newEnviron[i] = (char *) ckalloc((unsigned) (strlen(environ[i]) + 1));
454 strcpy(newEnviron[i], environ[i]);
455 }
456 newEnviron[length] = NULL;
457 environ = newEnviron;
458}
Impressum, Datenschutz