cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclenv.c

   1 /*
   2  * tclEnv.c --
   3  *
   4  *      Tcl support for environment variables, including a setenv_tcl
   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
  18 static 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
  31 typedef 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
  38 static EnvInterp *firstInterpPtr;
  39                                 /* First in list of all managed interpreters,
  40                                  * or NULL if none. */
  41
  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. */
  49
  50 /*
  51  * Declarations for local procedures defined in this file:
  52  */
  53
  54 static void             EnvInit _ANSI_ARGS_((void));
  55 static char *           EnvTraceProc _ANSI_ARGS_((ClientData clientData,
  56                             Tcl_Interp *interp, char *name1, char *name2,
  57                             int flags));
  58 static int              FindVariable _ANSI_ARGS_((char *name, int *lengthPtr));
  59
  60 void                    setenv_tcl _ANSI_ARGS_((char *name, char *value));
  61 int                     unsetenv_tcl _ANSI_ARGS_((char *name));
  62
  63 \f
  64 /*
  65  *----------------------------------------------------------------------
  66  *
  67  * TclSetupEnv --
  68  *
  69  *      This procedure is invoked for an interpreter to make environment
  70  *      variables accessible from that interpreter via the "env"
  71  *      associative array.
  72  *
  73  * Results:
  74  *      None.
  75  *
  76  * Side effects:
  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.
  83  *
  84  *----------------------------------------------------------------------
  85  */
  86
  87 void
  88 TclSetupEnv(interp)
  89     Tcl_Interp *interp;         /* Interpreter whose "env" array is to be
  90                                  * managed. */
  91 {
  92     EnvInterp *eiPtr;
  93     int i;
  94
  95     /*
  96      * First, initialize our environment-related information, if
  97      * necessary.
  98      */
  99
 100     if (environSize == 0) {
 101         EnvInit();
 102     }
 103
 104     /*
 105      * Next, add the interpreter to the list of those that we manage.
 106      */
 107
 108     eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
 109     eiPtr->interp = interp;
 110     eiPtr->nextPtr = firstInterpPtr;
 111     firstInterpPtr = eiPtr;
 112
 113     /*
 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.
 117      */
 118
 119     (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
 120     for (i = 0; ; i++) {
 121         char *p, *p2;
 122
 123         p = environ[i];
 124         if (p == NULL) {
 125             break;
 126         }
 127         for (p2 = p; *p2 != '='; p2++) {
 128             /* Empty loop body. */
 129         }
 130         *p2 = 0;
 131         (void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
 132         *p2 = '=';
 133     }
 134     Tcl_TraceVar2(interp, "env", (char *) NULL,
 135             TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
 136             EnvTraceProc, (ClientData) NULL);
 137 }
 138 \f
 139 /*
 140  *----------------------------------------------------------------------
 141  *
 142  * FindVariable --
 143  *
 144  *      Locate the entry in environ for a given name.
 145  *
 146  * Results:
 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
 151  *      entry is found).
 152  *
 153  * Side effects:
 154  *      None.
 155  *
 156  *----------------------------------------------------------------------
 157  */
 158
 159 static int
 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
 165                                  * searches). */
 166 {
 167     int i;
 168     register char *p1, *p2;
 169
 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. */
 173         }
 174         if ((*p1 == '=') && (*p2 == '\0')) {
 175             *lengthPtr = p2-name;
 176             return i;
 177         }
 178     }
 179     *lengthPtr = i;
 180     return -1;
 181 }
 182 \f
 183 /*
 184  *----------------------------------------------------------------------
 185  *
 186  * setenv_tcl --
 187  *
 188  *      Set an environment variable, replacing an existing value
 189  *      or creating a new variable if there doesn't exist a variable
 190  *      by the given name.
 191  *
 192  * Results:
 193  *      None.
 194  *
 195  * Side effects:
 196  *      The environ array gets updated, as do all of the interpreters
 197  *      that we manage.
 198  *
 199  *----------------------------------------------------------------------
 200  */
 201
 202 void
 203 setenv_tcl(name, value)
 204     char *name;                 /* Name of variable whose value is to be
 205                                  * set. */
 206     char *value;                /* New value for variable. */
 207 {
 208     int index, length, nameLength;
 209     char *p;
 210     EnvInterp *eiPtr;
 211
 212     if (environSize == 0) {
 213         EnvInit();
 214     }
 215
 216     /*
 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.
 220      */
 221
 222     index = FindVariable((char *)name, &length);
 223     if (index == -1) {
 224         if ((length+2) > environSize) {
 225             char **newEnviron;
 226
 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;
 234         }
 235         index = length;
 236         environ[index+1] = NULL;
 237         nameLength = strlen(name);
 238     } else {
 239         ckfree(environ[index]);
 240         nameLength = length;
 241     }
 242
 243     /*
 244      * Create a new entry and enter it into the table.
 245      */
 246
 247     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
 248     environ[index] = p;
 249     strcpy(p, name);
 250     p += nameLength;
 251     *p = '=';
 252     strcpy(p+1, value);
 253
 254     /*
 255      * Update all of the interpreters.
 256      */
 257
 258     for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
 259         (void) Tcl_SetVar2(eiPtr->interp, "env", (char *)name, p+1, TCL_GLOBAL_ONLY);
 260     }
 261 }
 262 \f
 263 /*
 264  *----------------------------------------------------------------------
 265  *
 266  * unsetenv_tcl --
 267  *
 268  *      Remove an environment variable, updating the "env" arrays
 269  *      in all interpreters managed by us.
 270  *
 271  * Results:
 272  *      None.
 273  *
 274  * Side effects:
 275  *      Interpreters are updated, as is environ.
 276  *
 277  *----------------------------------------------------------------------
 278  */
 279
 280 int
 281 unsetenv_tcl(name)
 282     char *name;                 /* Name of variable to remove. */
 283 {
 284     int index, dummy;
 285     char **envPtr;
 286     EnvInterp *eiPtr;
 287
 288     if (environSize == 0) {
 289         EnvInit();
 290     }
 291
 292     /*
 293      * Update the environ array.
 294      */
 295
 296     index = FindVariable((char *)name, &dummy);
 297     if (index == -1) {
 298         return;
 299     }
 300     ckfree(environ[index]);
 301     for (envPtr = environ+index+1; ; envPtr++) {
 302         envPtr[-1] = *envPtr;
 303         if (*envPtr == NULL) {
 304             break;
 305        }
 306     }
 307
 308     /*
 309      * Update all of the interpreters.
 310      */
 311
 312     for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
 313         (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *)name, TCL_GLOBAL_ONLY);
 314     }
 315 }
 316 \f
 317 /*
 318  *----------------------------------------------------------------------
 319  *
 320  * EnvTraceProc --
 321  *
 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.
 326  *
 327  * Results:
 328  *      Always returns NULL to indicate success.
 329  *
 330  * Side effects:
 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).
 335  *
 336  *----------------------------------------------------------------------
 337  */
 338
 339         /* ARGSUSED */
 340 static char *
 341 EnvTraceProc(clientData, interp, name1, name2, flags)
 342     ClientData clientData;      /* Not used. */
 343     Tcl_Interp *interp;         /* Interpreter whose "env" variable is
 344                                  * being modified. */
 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. */
 349 {
 350     /*
 351      * First see if the whole "env" variable is being deleted.  If
 352      * so, just forget about this interpreter.
 353      */
 354
 355     if (name2 == NULL) {
 356         register EnvInterp *eiPtr, *prevPtr;
 357
 358         if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
 359                 != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
 360             panic("EnvTraceProc called with confusing arguments");
 361         }
 362         eiPtr = firstInterpPtr;
 363         if (eiPtr->interp == interp) {
 364             firstInterpPtr = eiPtr->nextPtr;
 365         } else {
 366             for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
 367                     prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
 368                 if (eiPtr == NULL) {
 369                     panic("EnvTraceProc couldn't find interpreter");
 370                 }
 371                 if (eiPtr->interp == interp) {
 372                     prevPtr->nextPtr = eiPtr->nextPtr;
 373                     break;
 374                 }
 375             }
 376         }
 377         ckfree((char *) eiPtr);
 378         return NULL;
 379     }
 380
 381     /*
 382      * If a value is being set, call setenv_tcl to do all of the work.
 383      */
 384
 385     if (flags & TCL_TRACE_WRITES) {
 386         setenv_tcl(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
 387     }
 388
 389     if (flags & TCL_TRACE_UNSETS) {
 390         unsetenv_tcl(name2);
 391     }
 392     return NULL;
 393 }
 394 \f
 395 /*
 396  *----------------------------------------------------------------------
 397  *
 398  * EnvInit --
 399  *
 400  *      This procedure is called to initialize our management
 401  *      of the environ array.
 402  *
 403  * Results:
 404  *      None.
 405  *
 406  * Side effects:
 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.
 410  *
 411  *----------------------------------------------------------------------
 412  */
 413
 414 static void
 415 EnvInit()
 416 {
 417     char **newEnviron;
 418     int i, length;
 419
 420     if (environSize != 0) {
 421         return;
 422     }
 423     for (length = 0; environ[length] != NULL; length++) {
 424         /* Empty loop body. */
 425     }
 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]);
 432     }
 433     newEnviron[length] = NULL;
 434     environ = newEnviron;
 435 }