]>
cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclenv.c
656ca53fde5302b39ba69fe2d3fdba0bd25d6343
4 * Tcl support for environment variables, including a setenv
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
));
61 int setenv
_ANSI_ARGS_((const char *name
, const char *value
, int replace
));
62 int unsetenv
_ANSI_ARGS_((const char *name
));
64 void setenv
_ANSI_ARGS_((char *name
, char *value
));
65 void unsetenv
_ANSI_ARGS_((char *name
));
70 *----------------------------------------------------------------------
74 * This procedure is invoked for an interpreter to make environment
75 * variables accessible from that interpreter via the "env"
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.
89 *----------------------------------------------------------------------
94 Tcl_Interp
*interp
; /* Interpreter whose "env" array is to be
101 * First, initialize our environment-related information, if
105 if (environSize
== 0) {
110 * Next, add the interpreter to the list of those that we manage.
113 eiPtr
= (EnvInterp
*) ckalloc(sizeof(EnvInterp
));
114 eiPtr
->interp
= interp
;
115 eiPtr
->nextPtr
= firstInterpPtr
;
116 firstInterpPtr
= eiPtr
;
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.
124 (void) Tcl_UnsetVar2(interp
, "env", (char *) NULL
, TCL_GLOBAL_ONLY
);
132 for (p2
= p
; *p2
!= '='; p2
++) {
133 /* Empty loop body. */
136 (void) Tcl_SetVar2(interp
, "env", p
, p2
+1, TCL_GLOBAL_ONLY
);
139 Tcl_TraceVar2(interp
, "env", (char *) NULL
,
140 TCL_GLOBAL_ONLY
| TCL_TRACE_WRITES
| TCL_TRACE_UNSETS
,
141 EnvTraceProc
, (ClientData
) NULL
);
145 *----------------------------------------------------------------------
149 * Locate the entry in environ for a given name.
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
161 *----------------------------------------------------------------------
165 FindVariable(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
173 register char *p1
, *p2
;
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. */
179 if ((*p1
== '=') && (*p2
== '\0')) {
180 *lengthPtr
= p2
-name
;
189 *----------------------------------------------------------------------
193 * Set an environment variable, replacing an existing value
194 * or creating a new variable if there doesn't exist a variable
201 * The environ array gets updated, as do all of the interpreters
204 *----------------------------------------------------------------------
209 setenv(name
, value
, replace
)
210 const char *name
; /* Name of variable whose value is to be
212 const char *value
; /* New value for variable. */
217 char *name
; /* Name of variable whose value is to be
219 char *value
; /* New value for variable. */
222 int index
, length
, nameLength
;
226 if (environSize
== 0) {
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.
236 index
= FindVariable((char *)name
, &length
);
238 if ((length
+2) > environSize
) {
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;
250 environ
[index
+1] = NULL
;
251 nameLength
= strlen(name
);
253 ckfree(environ
[index
]);
258 * Create a new entry and enter it into the table.
261 p
= (char *) ckalloc((unsigned) (nameLength
+ strlen(value
) + 2));
269 * Update all of the interpreters.
272 for (eiPtr
= firstInterpPtr
; eiPtr
!= NULL
; eiPtr
= eiPtr
->nextPtr
) {
273 (void) Tcl_SetVar2(eiPtr
->interp
, "env", (char *)name
, p
+1, TCL_GLOBAL_ONLY
);
283 *----------------------------------------------------------------------
287 * Remove an environment variable, updating the "env" arrays
288 * in all interpreters managed by us.
294 * Interpreters are updated, as is environ.
296 *----------------------------------------------------------------------
302 const char *name
; /* Name of variable to remove. */
304 char *name
; /* Name of variable to remove. */
311 if (environSize
== 0) {
316 * Update the environ array.
319 index
= FindVariable((char *)name
, &dummy
);
323 ckfree(environ
[index
]);
324 for (envPtr
= environ
+index
+1; ; envPtr
++) {
325 envPtr
[-1] = *envPtr
;
326 if (*envPtr
== NULL
) {
332 * Update all of the interpreters.
335 for (eiPtr
= firstInterpPtr
; eiPtr
!= NULL
; eiPtr
= eiPtr
->nextPtr
) {
336 (void) Tcl_UnsetVar2(eiPtr
->interp
, "env", (char *)name
, TCL_GLOBAL_ONLY
);
341 *----------------------------------------------------------------------
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.
351 * Always returns NULL to indicate success.
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).
359 *----------------------------------------------------------------------
364 EnvTraceProc(clientData
, interp
, name1
, name2
, flags
)
365 ClientData clientData
; /* Not used. */
366 Tcl_Interp
*interp
; /* Interpreter whose "env" variable is
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. */
374 * First see if the whole "env" variable is being deleted. If
375 * so, just forget about this interpreter.
379 register EnvInterp
*eiPtr
, *prevPtr
;
381 if ((flags
& (TCL_TRACE_UNSETS
|TCL_TRACE_DESTROYED
))
382 != (TCL_TRACE_UNSETS
|TCL_TRACE_DESTROYED
)) {
383 panic("EnvTraceProc called with confusing arguments");
385 eiPtr
= firstInterpPtr
;
386 if (eiPtr
->interp
== interp
) {
387 firstInterpPtr
= eiPtr
->nextPtr
;
389 for (prevPtr
= eiPtr
, eiPtr
= eiPtr
->nextPtr
; ;
390 prevPtr
= eiPtr
, eiPtr
= eiPtr
->nextPtr
) {
392 panic("EnvTraceProc couldn't find interpreter");
394 if (eiPtr
->interp
== interp
) {
395 prevPtr
->nextPtr
= eiPtr
->nextPtr
;
400 ckfree((char *) eiPtr
);
405 * If a value is being set, call setenv to do all of the work.
408 if (flags
& TCL_TRACE_WRITES
) {
409 setenv(name2
, Tcl_GetVar2(interp
, "env", name2
, TCL_GLOBAL_ONLY
), 0);
412 if (flags
& TCL_TRACE_UNSETS
) {
419 *----------------------------------------------------------------------
423 * This procedure is called to initialize our management
424 * of the environ array.
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.
434 *----------------------------------------------------------------------
443 if (environSize
!= 0) {
446 for (length
= 0; environ
[length
] != NULL
; length
++) {
447 /* Empty loop body. */
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
]);
456 newEnviron
[length
] = NULL
;
457 environ
= newEnviron
;