home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclEnv.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  15KB  |  605 lines
  1. /* 
  2.  * tclEnv.c --
  3.  *
  4.  *    Tcl support for environment variables, including a setenv
  5.  *    procedure.
  6.  *
  7.  * Copyright (c) 1991-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclEnv.c 1.34 96/04/15 18:18:36
  14.  */
  15.  
  16. /*
  17.  * The putenv and setenv definitions below cause any system prototypes for
  18.  * those procedures to be ignored so that there won't be a clash when the
  19.  * versions in this file are compiled.
  20.  */
  21.  
  22. #define putenv ignore_putenv
  23. #define setenv ignore_setenv
  24. #include "tclInt.h"
  25. #include "tclPort.h"
  26. #undef putenv
  27. #undef setenv
  28.  
  29. /*
  30.  * The structure below is used to keep track of all of the interpereters
  31.  * for which we're managing the "env" array.  It's needed so that they
  32.  * can all be updated whenever an environment variable is changed
  33.  * anywhere.
  34.  */
  35.  
  36. typedef struct EnvInterp {
  37.     Tcl_Interp *interp;        /* Interpreter for which we're managing
  38.                  * the env array. */
  39.     struct EnvInterp *nextPtr;    /* Next in list of all such interpreters,
  40.                  * or zero. */
  41. } EnvInterp;
  42.  
  43. static EnvInterp *firstInterpPtr;
  44.                 /* First in list of all managed interpreters,
  45.                  * or NULL if none. */
  46.  
  47. static int environSize = 0;    /* Non-zero means that the all of the
  48.                  * environ-related information is malloc-ed
  49.                  * and the environ array itself has this
  50.                  * many total entries allocated to it (not
  51.                  * all may be in use at once).  Zero means
  52.                  * that the environment array is in its
  53.                  * original static state. */
  54.  
  55. /*
  56.  * Declarations for local procedures defined in this file:
  57.  */
  58.  
  59. static void        EnvExitProc _ANSI_ARGS_((ClientData clientData));
  60. static void        EnvInit _ANSI_ARGS_((void));
  61. static char *        EnvTraceProc _ANSI_ARGS_((ClientData clientData,
  62.                 Tcl_Interp *interp, char *name1, char *name2,
  63.                 int flags));
  64. static int        FindVariable _ANSI_ARGS_((CONST char *name,
  65.                 int *lengthPtr));
  66. void            TclSetEnv _ANSI_ARGS_((CONST char *name,
  67.                 CONST char *value));
  68. void            TclUnsetEnv _ANSI_ARGS_((CONST char *name));
  69.  
  70. /*
  71.  *----------------------------------------------------------------------
  72.  *
  73.  * TclSetupEnv --
  74.  *
  75.  *    This procedure is invoked for an interpreter to make environment
  76.  *    variables accessible from that interpreter via the "env"
  77.  *    associative array.
  78.  *
  79.  * Results:
  80.  *    None.
  81.  *
  82.  * Side effects:
  83.  *    The interpreter is added to a list of interpreters managed
  84.  *    by us, so that its view of envariables can be kept consistent
  85.  *    with the view in other interpreters.  If this is the first
  86.  *    call to Tcl_SetupEnv, then additional initialization happens,
  87.  *    such as copying the environment to dynamically-allocated space
  88.  *    for ease of management.
  89.  *
  90.  *----------------------------------------------------------------------
  91.  */
  92.  
  93. void
  94. TclSetupEnv(interp)
  95.     Tcl_Interp *interp;        /* Interpreter whose "env" array is to be
  96.                  * managed. */
  97. {
  98.     EnvInterp *eiPtr;
  99.     int i;
  100.  
  101.     /*
  102.      * First, initialize our environment-related information, if
  103.      * necessary.
  104.      */
  105.  
  106.     if (environSize == 0) {
  107.     EnvInit();
  108.     }
  109.  
  110.     /*
  111.      * Next, add the interpreter to the list of those that we manage.
  112.      */
  113.  
  114.     eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
  115.     eiPtr->interp = interp;
  116.     eiPtr->nextPtr = firstInterpPtr;
  117.     firstInterpPtr = eiPtr;
  118.  
  119.     /*
  120.      * Store the environment variable values into the interpreter's
  121.      * "env" array, and arrange for us to be notified on future
  122.      * writes and unsets to that array.
  123.      */
  124.  
  125.     (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
  126.     for (i = 0; ; i++) {
  127.     char *p, *p2;
  128.  
  129.     p = environ[i];
  130.     if (p == NULL) {
  131.         break;
  132.     }
  133.     for (p2 = p; *p2 != '='; p2++) {
  134.         /* Empty loop body. */
  135.     }
  136.     *p2 = 0;
  137.     (void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
  138.     *p2 = '=';
  139.     }
  140.     Tcl_TraceVar2(interp, "env", (char *) NULL,
  141.         TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
  142.         EnvTraceProc, (ClientData) NULL);
  143. }
  144.  
  145. /*
  146.  *----------------------------------------------------------------------
  147.  *
  148.  * FindVariable --
  149.  *
  150.  *    Locate the entry in environ for a given name.
  151.  *
  152.  * Results:
  153.  *    The return value is the index in environ of an entry with the
  154.  *    name "name", or -1 if there is no such entry.   The integer at
  155.  *    *lengthPtr is filled in with the length of name (if a matching
  156.  *    entry is found) or the length of the environ array (if no matching
  157.  *    entry is found).
  158.  *
  159.  * Side effects:
  160.  *    None.
  161.  *
  162.  *----------------------------------------------------------------------
  163.  */
  164.  
  165. static int
  166. FindVariable(name, lengthPtr)
  167.     CONST char *name;        /* Name of desired environment variable. */
  168.     int *lengthPtr;        /* Used to return length of name (for
  169.                  * successful searches) or number of non-NULL
  170.                  * entries in environ (for unsuccessful
  171.                  * searches). */
  172. {
  173.     int i;
  174.     register CONST char *p1, *p2;
  175.  
  176.     for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
  177.     for (p2 = name; *p2 == *p1; p1++, p2++) {
  178.         /* NULL loop body. */
  179.     }
  180.     if ((*p1 == '=') && (*p2 == '\0')) {
  181.         *lengthPtr = p2-name;
  182.         return i;
  183.     }
  184.     }
  185.     *lengthPtr = i;
  186.     return -1;
  187. }
  188.  
  189. /*
  190.  *----------------------------------------------------------------------
  191.  *
  192.  * TclGetEnv --
  193.  *
  194.  *    Get an environment variable or return NULL if the variable
  195.  *    doesn't exist.  This procedure is intended to be a
  196.  *    stand-in for the  UNIX "getenv" procedure so that applications
  197.  *    using that procedure will interface properly to Tcl.  To make
  198.  *    it a stand-in, the Makefile must define "TclGetEnv" to "getenv".
  199.  *
  200.  * Results:
  201.  *    ptr to value on success, NULL if error.
  202.  *
  203.  * Side effects:
  204.  *    None.
  205.  *
  206.  *----------------------------------------------------------------------
  207.  */
  208.  
  209. char *
  210. TclGetEnv(name)
  211.     char *name;            /* Name of desired environment variable. */
  212. {
  213.     int i;
  214.     size_t len;
  215.  
  216.     for (i = 0; environ[i] != NULL; i++) {
  217.     len = (size_t) ((char *) strchr(environ[i], '=') - environ[i]);
  218.     if ((len > 0 && !strncmp(name, environ[i], len))
  219.         || (*name == '\0')) {
  220.         /*
  221.          * The caller of this function should regard this
  222.          * as static memory.
  223.          */
  224.         return &environ[i][len+1];
  225.     }
  226.     }
  227.  
  228.     return NULL;
  229. }
  230.  
  231. /*
  232.  *----------------------------------------------------------------------
  233.  *
  234.  * TclSetEnv --
  235.  *
  236.  *    Set an environment variable, replacing an existing value
  237.  *    or creating a new variable if there doesn't exist a variable
  238.  *    by the given name.  This procedure is intended to be a
  239.  *    stand-in for the  UNIX "setenv" procedure so that applications
  240.  *    using that procedure will interface properly to Tcl.  To make
  241.  *    it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
  242.  *
  243.  * Results:
  244.  *    None.
  245.  *
  246.  * Side effects:
  247.  *    The environ array gets updated, as do all of the interpreters
  248.  *    that we manage.
  249.  *
  250.  *----------------------------------------------------------------------
  251.  */
  252.  
  253. void
  254. TclSetEnv(name, value)
  255.     CONST char *name;        /* Name of variable whose value is to be
  256.                  * set. */
  257.     CONST char *value;        /* New value for variable. */
  258. {
  259.     int index, length, nameLength;
  260.     char *p;
  261.     EnvInterp *eiPtr;
  262.  
  263.     if (environSize == 0) {
  264.     EnvInit();
  265.     }
  266.  
  267.     /*
  268.      * Figure out where the entry is going to go.  If the name doesn't
  269.      * already exist, enlarge the array if necessary to make room.  If
  270.      * the name exists, free its old entry.
  271.      */
  272.  
  273.     index = FindVariable(name, &length);
  274.     if (index == -1) {
  275.     if ((length+2) > environSize) {
  276.         char **newEnviron;
  277.  
  278.         newEnviron = (char **) ckalloc((unsigned)
  279.             ((length+5) * sizeof(char *)));
  280.         memcpy((VOID *) newEnviron, (VOID *) environ,
  281.             length*sizeof(char *));
  282.         ckfree((char *) environ);
  283.         environ = newEnviron;
  284.         environSize = length+5;
  285.     }
  286.     index = length;
  287.     environ[index+1] = NULL;
  288.     nameLength = strlen(name);
  289.     } else {
  290.     /*
  291.      * Compare the new value to the existing value.  If they're
  292.      * the same then quit immediately (e.g. don't rewrite the
  293.      * value or propagate it to other interpreters).  Otherwise,
  294.      * when there are N interpreters there will be N! propagations
  295.      * of the same value among the interpreters.
  296.      */
  297.  
  298.     if (strcmp(value, environ[index]+length+1) == 0) {
  299.         return;
  300.     }
  301.     ckfree(environ[index]);
  302.     nameLength = length;
  303.     }
  304.  
  305.     /*
  306.      * Create a new entry and enter it into the table.
  307.      */
  308.  
  309.     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
  310.     environ[index] = p;
  311.     strcpy(p, name);
  312.     p += nameLength;
  313.     *p = '=';
  314.     strcpy(p+1, value);
  315.  
  316.     /*
  317.      * Update all of the interpreters.
  318.      */
  319.  
  320.     for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  321.     (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
  322.         p+1, TCL_GLOBAL_ONLY);
  323.     }
  324.  
  325.     /*
  326.      * Update the system environment.
  327.      */
  328.  
  329.     TclSetSystemEnv(name, value);
  330. }
  331.  
  332. /*
  333.  *----------------------------------------------------------------------
  334.  *
  335.  * Tcl_PutEnv --
  336.  *
  337.  *    Set an environment variable.  Similar to setenv except that
  338.  *    the information is passed in a single string of the form
  339.  *    NAME=value, rather than as separate name strings.  This procedure
  340.  *    is intended to be a stand-in for the  UNIX "putenv" procedure
  341.  *    so that applications using that procedure will interface
  342.  *    properly to Tcl.  To make it a stand-in, the Makefile will
  343.  *    define "Tcl_PutEnv" to "putenv".
  344.  *
  345.  * Results:
  346.  *    None.
  347.  *
  348.  * Side effects:
  349.  *    The environ array gets updated, as do all of the interpreters
  350.  *    that we manage.
  351.  *
  352.  *----------------------------------------------------------------------
  353.  */
  354.  
  355. int
  356. Tcl_PutEnv(string)
  357.     CONST char *string;        /* Info about environment variable in the
  358.                  * form NAME=value. */
  359. {
  360.     int nameLength;
  361.     char *name, *value;
  362.  
  363.     if (string == NULL) {
  364.     return 0;
  365.     }
  366.  
  367.     /*
  368.      * Separate the string into name and value parts, then call
  369.      * TclSetEnv to do all of the real work.
  370.      */
  371.  
  372.     value = strchr(string, '=');
  373.     if (value == NULL) {
  374.     return 0;
  375.     }
  376.     nameLength = value - string;
  377.     if (nameLength == 0) {
  378.     return 0;
  379.     }
  380.     name = (char *) ckalloc((unsigned) nameLength+1);
  381.     memcpy(name, string, (size_t) nameLength);
  382.     name[nameLength] = 0;
  383.     TclSetEnv(name, value+1);
  384.     ckfree(name);
  385.     return 0;
  386. }
  387.  
  388. /*
  389.  *----------------------------------------------------------------------
  390.  *
  391.  * TclUnsetEnv --
  392.  *
  393.  *    Remove an environment variable, updating the "env" arrays
  394.  *    in all interpreters managed by us.  This function is intended
  395.  *    to replace the UNIX "unsetenv" function (but to do this the
  396.  *    Makefile must be modified to redefine "TclUnsetEnv" to
  397.  *    "unsetenv".
  398.  *
  399.  * Results:
  400.  *    None.
  401.  *
  402.  * Side effects:
  403.  *    Interpreters are updated, as is environ.
  404.  *
  405.  *----------------------------------------------------------------------
  406.  */
  407.  
  408. void
  409. TclUnsetEnv(name)
  410.     CONST char *name;            /* Name of variable to remove. */
  411. {
  412.     int index, dummy;
  413.     char **envPtr;
  414.     EnvInterp *eiPtr;
  415.  
  416.     if (environSize == 0) {
  417.     EnvInit();
  418.     }
  419.  
  420.     /*
  421.      * Update the environ array.
  422.      */
  423.  
  424.     index = FindVariable(name, &dummy);
  425.     if (index == -1) {
  426.     return;
  427.     }
  428.     ckfree(environ[index]);
  429.     for (envPtr = environ+index+1; ; envPtr++) {
  430.     envPtr[-1] = *envPtr;
  431.     if (*envPtr == NULL) {
  432.         break;
  433.        }
  434.     }
  435.  
  436.     /*
  437.      * Update all of the interpreters.
  438.      */
  439.  
  440.     for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  441.     (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
  442.         TCL_GLOBAL_ONLY);
  443.     }
  444.  
  445.     /*
  446.      * Update the system environment.
  447.      */
  448.  
  449.     TclSetSystemEnv(name, NULL);
  450. }
  451.  
  452. /*
  453.  *----------------------------------------------------------------------
  454.  *
  455.  * EnvTraceProc --
  456.  *
  457.  *    This procedure is invoked whenever an environment variable
  458.  *    is modified or deleted.  It propagates the change to the
  459.  *    "environ" array and to any other interpreters for whom
  460.  *    we're managing an "env" array.
  461.  *
  462.  * Results:
  463.  *    Always returns NULL to indicate success.
  464.  *
  465.  * Side effects:
  466.  *    Environment variable changes get propagated.  If the whole
  467.  *    "env" array is deleted, then we stop managing things for
  468.  *    this interpreter (usually this happens because the whole
  469.  *    interpreter is being deleted).
  470.  *
  471.  *----------------------------------------------------------------------
  472.  */
  473.  
  474.     /* ARGSUSED */
  475. static char *
  476. EnvTraceProc(clientData, interp, name1, name2, flags)
  477.     ClientData clientData;    /* Not used. */
  478.     Tcl_Interp *interp;        /* Interpreter whose "env" variable is
  479.                  * being modified. */
  480.     char *name1;        /* Better be "env". */
  481.     char *name2;        /* Name of variable being modified, or
  482.                  * NULL if whole array is being deleted. */
  483.     int flags;            /* Indicates what's happening. */
  484. {
  485.     /*
  486.      * First see if the whole "env" variable is being deleted.  If
  487.      * so, just forget about this interpreter.
  488.      */
  489.  
  490.     if (name2 == NULL) {
  491.     register EnvInterp *eiPtr, *prevPtr;
  492.  
  493.     if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
  494.         != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
  495.         panic("EnvTraceProc called with confusing arguments");
  496.     }
  497.     eiPtr = firstInterpPtr;
  498.     if (eiPtr->interp == interp) {
  499.         firstInterpPtr = eiPtr->nextPtr;
  500.     } else {
  501.         for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
  502.             prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
  503.         if (eiPtr == NULL) {
  504.             panic("EnvTraceProc couldn't find interpreter");
  505.         }
  506.         if (eiPtr->interp == interp) {
  507.             prevPtr->nextPtr = eiPtr->nextPtr;
  508.             break;
  509.         }
  510.         }
  511.     }
  512.     ckfree((char *) eiPtr);
  513.     return NULL;
  514.     }
  515.  
  516.     /*
  517.      * If a value is being set, call TclSetEnv to do all of the work.
  518.      */
  519.  
  520.     if (flags & TCL_TRACE_WRITES) {
  521.     TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
  522.     }
  523.  
  524.     if (flags & TCL_TRACE_UNSETS) {
  525.     TclUnsetEnv(name2);
  526.     }
  527.     return NULL;
  528. }
  529.  
  530. /*
  531.  *----------------------------------------------------------------------
  532.  *
  533.  * EnvInit --
  534.  *
  535.  *    This procedure is called to initialize our management
  536.  *    of the environ array.
  537.  *
  538.  * Results:
  539.  *    None.
  540.  *
  541.  * Side effects:
  542.  *    Environ gets copied to malloc-ed storage, so that in
  543.  *    the future we don't have to worry about which entries
  544.  *    are malloc-ed and which are static.
  545.  *
  546.  *----------------------------------------------------------------------
  547.  */
  548.  
  549. static void
  550. EnvInit()
  551. {
  552. #ifdef MAC_TCL
  553.     environSize = TclMacCreateEnv();
  554. #else
  555.     char **newEnviron;
  556.     int i, length;
  557.  
  558.     if (environSize != 0) {
  559.     return;
  560.     }
  561.     for (length = 0; environ[length] != NULL; length++) {
  562.     /* Empty loop body. */
  563.     }
  564.     environSize = length+5;
  565.     newEnviron = (char **) ckalloc((unsigned)
  566.         (environSize * sizeof(char *)));
  567.     for (i = 0; i < length; i++) {
  568.     newEnviron[i] = (char *) ckalloc((unsigned) (strlen(environ[i]) + 1));
  569.     strcpy(newEnviron[i], environ[i]);
  570.     }
  571.     newEnviron[length] = NULL;
  572.     environ = newEnviron;
  573.     Tcl_CreateExitHandler(EnvExitProc, (ClientData) NULL);
  574. #endif
  575. }
  576.  
  577. /*
  578.  *----------------------------------------------------------------------
  579.  *
  580.  * EnvExitProc --
  581.  *
  582.  *    This procedure is called just before the process exits.  It
  583.  *    frees the memory associated with environment variables.
  584.  *
  585.  * Results:
  586.  *    None.
  587.  *
  588.  * Side effects:
  589.  *    Memory is freed.
  590.  *
  591.  *----------------------------------------------------------------------
  592.  */
  593.  
  594. static void
  595. EnvExitProc(clientData)
  596.     ClientData clientData;        /* Not  used. */
  597. {
  598.     char **p;
  599.  
  600.     for (p = environ; *p != NULL; p++) {
  601.     ckfree(*p);
  602.     }
  603.     ckfree((char *) environ);
  604. }
  605.