]>
git.zerfleddert.de Git - micropolis/blob - src/tcl/tclenv.c
4 * Tcl support for environment variables, including a setenv_tcl
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.
18 static char rcsid
[] = "$Header: /user6/ouster/tcl/RCS/tclEnv.c,v 1.7 91/09/23 11:22:21 ouster Exp $ SPRITE (Berkeley)";
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
31 typedef struct EnvInterp
{
32 Tcl_Interp
*interp
; /* Interpreter for which we're managing
34 struct EnvInterp
*nextPtr
; /* Next in list of all such interpreters,
38 static EnvInterp
*firstInterpPtr
;
39 /* First in list of all managed interpreters,
42 static 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. */
51 * Declarations for local procedures defined in this file:
54 static void EnvInit
_ANSI_ARGS_((void));
55 static char * EnvTraceProc
_ANSI_ARGS_((ClientData clientData
,
56 Tcl_Interp
*interp
, char *name1
, char *name2
,
58 static int FindVariable
_ANSI_ARGS_((char *name
, int *lengthPtr
));
60 void setenv_tcl
_ANSI_ARGS_((char *name
, char *value
));
61 int unsetenv_tcl
_ANSI_ARGS_((char *name
));
65 *----------------------------------------------------------------------
69 * This procedure is invoked for an interpreter to make environment
70 * variables accessible from that interpreter via the "env"
77 * The interpreter is added to a list of interpreters managed
78 * by us, so that its view of envariables can be kept consistent
79 * with the view in other interpreters. If this is the first
80 * call to Tcl_SetupEnv, then additional initialization happens,
81 * such as copying the environment to dynamically-allocated space
82 * for ease of management.
84 *----------------------------------------------------------------------
89 Tcl_Interp
*interp
; /* Interpreter whose "env" array is to be
96 * First, initialize our environment-related information, if
100 if (environSize
== 0) {
105 * Next, add the interpreter to the list of those that we manage.
108 eiPtr
= (EnvInterp
*) ckalloc(sizeof(EnvInterp
));
109 eiPtr
->interp
= interp
;
110 eiPtr
->nextPtr
= firstInterpPtr
;
111 firstInterpPtr
= eiPtr
;
114 * Store the environment variable values into the interpreter's
115 * "env" array, and arrange for us to be notified on future
116 * writes and unsets to that array.
119 (void) Tcl_UnsetVar2(interp
, "env", (char *) NULL
, TCL_GLOBAL_ONLY
);
127 for (p2
= p
; *p2
!= '='; p2
++) {
128 /* Empty loop body. */
131 (void) Tcl_SetVar2(interp
, "env", p
, p2
+1, TCL_GLOBAL_ONLY
);
134 Tcl_TraceVar2(interp
, "env", (char *) NULL
,
135 TCL_GLOBAL_ONLY
| TCL_TRACE_WRITES
| TCL_TRACE_UNSETS
,
136 EnvTraceProc
, (ClientData
) NULL
);
140 *----------------------------------------------------------------------
144 * Locate the entry in environ for a given name.
147 * The return value is the index in environ of an entry with the
148 * name "name", or -1 if there is no such entry. The integer at
149 * *lengthPtr is filled in with the length of name (if a matching
150 * entry is found) or the length of the environ array (if no matching
156 *----------------------------------------------------------------------
160 FindVariable(name
, lengthPtr
)
161 char *name
; /* Name of desired environment variable. */
162 int *lengthPtr
; /* Used to return length of name (for
163 * successful searches) or number of non-NULL
164 * entries in environ (for unsuccessful
168 register char *p1
, *p2
;
170 for (i
= 0, p1
= environ
[i
]; p1
!= NULL
; i
++, p1
= environ
[i
]) {
171 for (p2
= name
; *p2
== *p1
; p1
++, p2
++) {
172 /* NULL loop body. */
174 if ((*p1
== '=') && (*p2
== '\0')) {
175 *lengthPtr
= p2
-name
;
184 *----------------------------------------------------------------------
188 * Set an environment variable, replacing an existing value
189 * or creating a new variable if there doesn't exist a variable
196 * The environ array gets updated, as do all of the interpreters
199 *----------------------------------------------------------------------
203 setenv_tcl(name
, value
)
204 char *name
; /* Name of variable whose value is to be
206 char *value
; /* New value for variable. */
208 int index
, length
, nameLength
;
212 if (environSize
== 0) {
217 * Figure out where the entry is going to go. If the name doesn't
218 * already exist, enlarge the array if necessary to make room. If
219 * the name exists, free its old entry.
222 index
= FindVariable((char *)name
, &length
);
224 if ((length
+2) > environSize
) {
227 newEnviron
= (char **) ckalloc((unsigned)
228 ((length
+5) * sizeof(char *)));
229 memcpy((VOID
*) newEnviron
, (VOID
*) environ
,
230 length
*sizeof(char *));
231 ckfree((char *) environ
);
232 environ
= newEnviron
;
233 environSize
= length
+5;
236 environ
[index
+1] = NULL
;
237 nameLength
= strlen(name
);
239 ckfree(environ
[index
]);
244 * Create a new entry and enter it into the table.
247 p
= (char *) ckalloc((unsigned) (nameLength
+ strlen(value
) + 2));
255 * Update all of the interpreters.
258 for (eiPtr
= firstInterpPtr
; eiPtr
!= NULL
; eiPtr
= eiPtr
->nextPtr
) {
259 (void) Tcl_SetVar2(eiPtr
->interp
, "env", (char *)name
, p
+1, TCL_GLOBAL_ONLY
);
264 *----------------------------------------------------------------------
268 * Remove an environment variable, updating the "env" arrays
269 * in all interpreters managed by us.
275 * Interpreters are updated, as is environ.
277 *----------------------------------------------------------------------
282 char *name
; /* Name of variable to remove. */
288 if (environSize
== 0) {
293 * Update the environ array.
296 index
= FindVariable((char *)name
, &dummy
);
300 ckfree(environ
[index
]);
301 for (envPtr
= environ
+index
+1; ; envPtr
++) {
302 envPtr
[-1] = *envPtr
;
303 if (*envPtr
== NULL
) {
309 * Update all of the interpreters.
312 for (eiPtr
= firstInterpPtr
; eiPtr
!= NULL
; eiPtr
= eiPtr
->nextPtr
) {
313 (void) Tcl_UnsetVar2(eiPtr
->interp
, "env", (char *)name
, TCL_GLOBAL_ONLY
);
318 *----------------------------------------------------------------------
322 * This procedure is invoked whenever an environment variable
323 * is modified or deleted. It propagates the change to the
324 * "environ" array and to any other interpreters for whom
325 * we're managing an "env" array.
328 * Always returns NULL to indicate success.
331 * Environment variable changes get propagated. If the whole
332 * "env" array is deleted, then we stop managing things for
333 * this interpreter (usually this happens because the whole
334 * interpreter is being deleted).
336 *----------------------------------------------------------------------
341 EnvTraceProc(clientData
, interp
, name1
, name2
, flags
)
342 ClientData clientData
; /* Not used. */
343 Tcl_Interp
*interp
; /* Interpreter whose "env" variable is
345 char *name1
; /* Better be "env". */
346 char *name2
; /* Name of variable being modified, or
347 * NULL if whole array is being deleted. */
348 int flags
; /* Indicates what's happening. */
351 * First see if the whole "env" variable is being deleted. If
352 * so, just forget about this interpreter.
356 register EnvInterp
*eiPtr
, *prevPtr
;
358 if ((flags
& (TCL_TRACE_UNSETS
|TCL_TRACE_DESTROYED
))
359 != (TCL_TRACE_UNSETS
|TCL_TRACE_DESTROYED
)) {
360 panic("EnvTraceProc called with confusing arguments");
362 eiPtr
= firstInterpPtr
;
363 if (eiPtr
->interp
== interp
) {
364 firstInterpPtr
= eiPtr
->nextPtr
;
366 for (prevPtr
= eiPtr
, eiPtr
= eiPtr
->nextPtr
; ;
367 prevPtr
= eiPtr
, eiPtr
= eiPtr
->nextPtr
) {
369 panic("EnvTraceProc couldn't find interpreter");
371 if (eiPtr
->interp
== interp
) {
372 prevPtr
->nextPtr
= eiPtr
->nextPtr
;
377 ckfree((char *) eiPtr
);
382 * If a value is being set, call setenv_tcl to do all of the work.
385 if (flags
& TCL_TRACE_WRITES
) {
386 setenv_tcl(name2
, Tcl_GetVar2(interp
, "env", name2
, TCL_GLOBAL_ONLY
));
389 if (flags
& TCL_TRACE_UNSETS
) {
396 *----------------------------------------------------------------------
400 * This procedure is called to initialize our management
401 * of the environ array.
407 * Environ gets copied to malloc-ed storage, so that in
408 * the future we don't have to worry about which entries
409 * are malloc-ed and which are static.
411 *----------------------------------------------------------------------
420 if (environSize
!= 0) {
423 for (length
= 0; environ
[length
] != NULL
; length
++) {
424 /* Empty loop body. */
426 environSize
= length
+5;
427 newEnviron
= (char **) ckalloc((unsigned)
428 (environSize
* sizeof(char *)));
429 for (i
= 0; i
< length
; i
++) {
430 newEnviron
[i
] = (char *) ckalloc((unsigned) (strlen(environ
[i
]) + 1));
431 strcpy(newEnviron
[i
], environ
[i
]);
433 newEnviron
[length
] = NULL
;
434 environ
= newEnviron
;