int Setup_Environment( Tcl_Interp* interp) { int i, /** loop counter **/ envsize = 0; /** Total size of the environment **/ char *eq; /** Temp. val. used for location the **/ /** Equal sign. **/ char *loaded; /** The currently loaded modules **/ #if WITH_DEBUGGING_INIT ErrorLogger( NO_ERR_START, LOC, _proc_Setup_Environment, NULL); #endif /** ** Scan the whole environment value by value. ** Count its size **/ for( i = 0; environ[i]; i++) { envsize += strlen( environ[i]) + 1; /** ** Locate the equal sign and terminate the string at its position. **/ eq = environ[i]; while( *eq++ != '=' && *eq); *(eq - 1) = '\0'; /** ** Now set up a Tcl variable of the same name and value as the ** environment variable **/ if( Tcl_SetVar( interp, environ[i], eq, 0) == (char *) NULL) if( OK != ErrorLogger( ERR_SET_VAR, LOC, environ[i], NULL)) goto unwind0; /** ** Reinstall the changed environment **/ *(eq - 1) = '='; } /** for **/ /** ** Reconstruct the _LMFILES_ environment variable **/ loaded = getLMFILES( interp); if( loaded) if( !(EMSetEnv( interp, "_LMFILES_", loaded))) if( OK != ErrorLogger( ERR_SET_VAR, LOC, environ[i], NULL)) goto unwind0; return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ unwind0: return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** end of 'Setup_Environment' **/
int ModuleCmd_Update( Tcl_Interp *interp, int count, char *module_list[]) { #ifdef BEGINENV char *buf, /** Read buffer **/ *var_ptr, /** Pointer to a variables name **/ *val_ptr, /** Pointer to a variables value **/ **load_list, /** List of loaded modules **/ *tmpload, /** LOADEDMODULES contents **/ *loaded, /** Buffer for tokenization **/ *filename; /** The name of the file, where the **/ /** beginning environment resides **/ FILE *file; /** Handle to read in a file **/ int list_count = 0, maxlist = 16, /** Max. number of list entries **/ buffer_size = UPD_BUFSIZE; /** Current size of the input buffer **/ char *ptr, c; /** Read pointers and char buffer **/ # if BEGINENV == 99 if (!EMGetEnv( interp,"MODULESBEGINENV")) { ErrorLogger( ERR_BEGINENVX, LOC, NULL); return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } # endif /** ** Nothing loaded so far - we're ready! **/ if(!(tmpload = (char *) getenv("LOADEDMODULES"))) { if( OK != ErrorLogger( ERR_MODULE_PATH, LOC, NULL)) goto unwind0; else goto success0; } /** ** First I'll update the environment with whatever in _MODULESBEGINENV_ **/ filename = EMGetEnv( interp,"_MODULESBEGINENV_"); if(filename && *filename) { /** ** Read the begining environment **/ if((file = fopen( filename, "r"))) { if(!(buf = stringer(NULL, buffer_size, NULL ))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind0; while( !feof( file)) { /** ** Trigger on entries of the type ** <variable> = <value> **/ ptr = buf; while( !feof( file)) { if((ptr-buf) >= buffer_size-10) { /** 10 bytes safety **/ null_free((void *) &buf); if(!(buf = stringer(NULL, buffer_size += UPD_BUFSIZE, NULL ))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind0; } /** ** Read a character and put it into the read buffer. Check ** for the lines (CR) or a terminator character ... **/ if( '\n' == (*ptr++ = c = fgetc( file))) { *ptr++ = c = '\0'; break; } if( !c) break; } /** while **/ /** ** If there hasn't been a terminator so far, put it at the ** end of the line. Therefor we've left a safety space at the ** buffers end ;-) **/ if( c) *ptr++ = '\0'; /** ** Now let's evaluate the read line **/ if( (var_ptr = strchr( buf, '=')) ) { *var_ptr = '\0'; val_ptr = var_ptr+1; var_ptr = buf; /** ** Reset the environment to the values derivered from the ** _MODULESBEGINENV_. ** Do not change the LOADEDMODULES variable ;-) ** Do not change the TCL_LIBRARY and TK_LIBRARY also. **/ if( strncmp( var_ptr, "LOADEDMODULES", 12) && strncmp( var_ptr, "TCL_LIBRARY", 10 ) && strncmp( var_ptr, "TK_LIBRARY", 9 )) { if( !strncmp( var_ptr, "MODULEPATH", 10)) moduleSetenv( interp, var_ptr, val_ptr, 1); else EMSetEnv( interp, var_ptr, val_ptr); } } /** if( var_ptr) **/ } /** while **/ /** ** Close the _MODULESBEGINENV_ file anf free up the read buffer. **/ null_free((void *) &buf); if( EOF == fclose( file)) if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL)) goto unwind0; } else { /** if( fopen) **/ if( OK != ErrorLogger( ERR_OPEN, LOC, filename,_(em_reading),NULL)) goto unwind0; } /** if( fopen) **/ } /** if( filename) **/ null_free((void *) &filename); /** ** Allocate memory for a buffer to tokenize the list of loaded modules ** and a list buffer **/ if(!(load_list = (char**) module_malloc( maxlist*sizeof(char**)))) if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) goto unwind0; if(!(loaded = stringer(NULL, 0, tmpload, NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind1; /** ** Tokenize and build the list **/ if( *loaded) { for( load_list[ list_count++] = xstrtok( loaded, ":"); load_list[ list_count-1]; load_list[ list_count++] = xstrtok( NULL, ":") ) { /** ** Conditionally we have to double the space, we've allocated for ** the list **/ if( list_count >= maxlist) { maxlist = maxlist<<1; if(!(load_list = (char**) module_realloc( (char *) load_list, maxlist*sizeof(char**)))) if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) goto unwind1; } /** if( maxlist) **/ } /** for **/ /** ** Load all the modules in the list **/ ModuleCmd_Load( interp, 1, list_count, load_list); } /** ** Free up what has been allocated and return on success **/ null_free((void *) &loaded); null_free((void *) &load_list); success0: return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ unwind1: null_free((void *) &load_list); unwind0: null_free((void *) &filename); #else /* BEGINENV */ ErrorLogger( ERR_BEGINENV, LOC, NULL); #endif /* !BEGINENV */ return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** End of 'ModuleCmd_Update' **/
int moduleSetenv( Tcl_Interp *interp, char *variable, char *value, int force) { char *oldval; /** Old value of 'variable' **/ #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_START, LOC, _proc_moduleSetenv, NULL); #endif oldval = EMGetEnv( interp, variable); if (!oldval || !*oldval) null_free((void *)&oldval); /** ** Check to see if variable is already set correctly... **/ if( !(g_flags & (M_REMOVE|M_DISPLAY|M_SWITCH|M_NONPERSIST)) && oldval) { if( !strcmp( value, oldval)) { return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ } } /** ** If I'm in SWSTATE1, I'm removing stuff from the old modulefile, so ** I'll just mark the variables that were used with the SWSTATE1 flag and ** return. ** ** When I come back through in SWSTATE2, I'm setting the variables that ** are in the new modulefile. So, I'll keep track of these by marking ** them as touched by SWSTATE2 and then actually setting their values in ** the environment down below. ** ** Finally, in SWSTATE3, I'll check to see if the variables in the old ** modulefiles that have been marked are still marked as SWSTATE1. If ** they are still the same, then I'll just unset them and return. ** ** And, if I'm not doing any switching, then just unset the variable if ** I'm in remove mode. **/ if( g_flags & M_SWSTATE1) { set_marked_entry( markVariableHashTable, variable, M_SWSTATE1); return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ } else if( g_flags & M_SWSTATE2) { set_marked_entry( markVariableHashTable, variable, M_SWSTATE2); } else if( g_flags & M_SWSTATE3) { intptr_t marked_val; marked_val = chk_marked_entry( markVariableHashTable, variable); if( marked_val) { if( marked_val == M_SWSTATE1) return( moduleUnsetenv(interp, variable)); /** -------> **/ else return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ } } else if( (g_flags & M_REMOVE) && !force) { return( moduleUnsetenv( interp, variable)); /** -------> **/ } /** ** Keep track of our changes just in case we have to bail out and restore ** the environment. **/ if( !(g_flags & (M_NONPERSIST | M_DISPLAY | M_WHATIS | M_HELP))) { store_hash_value( setenvHashTable, variable, value); clear_hash_value( unsetenvHashTable, variable); } /** ** Store the value into the environment **/ EMSetEnv( interp, variable, value); #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_END, LOC, _proc_moduleSetenv, NULL); #endif return( TCL_OK); } /** End of 'moduleSetenv' **/
static int Remove_Path(Tcl_Interp *interp, char *variable, char *item, char *sw_marker, const char *delim) { char *oldpath, /** current path **/ *olditem; /** item from path **/ int i = 0, /** counter **/ found = 0, /** flag to indicate item was found **/ pcount = 0, /** count of items in path **/ addsep = 0, /** flag to add separator **/ marked = 0, /** flag path contains sw_marker **/ oldpathlen = 0; Tcl_DString _newpath; Tcl_DString *newpath = &_newpath; Tcl_DStringInit(newpath); /** ** Get the current value of the "PATH" environment variable **/ oldpath = (char *)EMGetEnv(interp, variable); if (!oldpath || !*oldpath) { null_free((void *)&oldpath); _TCLCHK(interp); goto success0; /** -------- EXIT (SUCCESS) -------> **/ } /* copy oldpath to not mess with the TCL value of env(PATH) */ if (!(oldpath = stringer(NULL,0, oldpath, NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind0; } } /* get length of oldpath before it gets modified by xstrtok */ oldpathlen = (int)strlen(oldpath); /* determine if sw_marker is in the path */ olditem = xstrtok(oldpath, delim); while (olditem) { if (!strcmp(olditem, sw_marker)) { marked = 1; } pcount++; olditem = xstrtok(NULL, delim); } /** pointer arithmetic on oldpath ** if olditem starts at terminating null string of oldpath, ** it means the last character in oldpath was ":", meaning ** the last element was the empty string. use <= to catch ** this case and process the last empty element */ for (olditem = oldpath; olditem <= oldpath + oldpathlen; olditem += strlen(olditem) + 1) { if (strcmp(olditem, item)) { /* not the droids we're looking for */ if (Tcl_DStringLength(newpath)) { if (!Tcl_DStringAppend(newpath, delim, 1)) if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) goto unwind1; } if (!Tcl_DStringAppend(newpath, olditem, -1)) if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) goto unwind1; } else { /* bingo! Don't add it to new path */ found++; if ((g_flags & M_SWSTATE1) && !marked) { /** ** In state1, we're actually replacing old paths with ** the markers for future appends and prepends. ** ** We only want to do this once to mark the location ** the module was formed around. **/ marked = 1; if (Tcl_DStringLength(newpath)) { if (!Tcl_DStringAppend (newpath, delim, 1)) if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) goto unwind1; } if (!Tcl_DStringAppend(newpath, sw_marker, -1)) if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) goto unwind1; } } } if (!found) { goto success1; } if (Tcl_DStringLength(newpath)) { /** ** Cache the set. Clear the variable from the unset table just ** in case it was previously unset. **/ store_hash_value(setenvHashTable, variable, Tcl_DStringValue(newpath)); clear_hash_value(unsetenvHashTable, variable); /** ** Store the new PATH value into the environment. **/ (void) EMSetEnv( interp, variable, Tcl_DStringValue(newpath)); _TCLCHK(interp); } else { /** ** In this case, I should go ahead and unset the variable ** from the environment because I'm removing the very last ** path. ** ** First I'm going to clear the variable from the ** setenvHashTable just in case its already been altered ** and had a significant value at the time. It's very ** possible that I'm removing the only two or three paths ** from this variable. If that's the case, then all the ** earlier paths were marked for output in this hashTable. ** ** Secondly, I actually mark the the environment variable ** to be unset when output. **/ clear_hash_value(setenvHashTable, variable); moduleUnsetenv(interp, variable); /** ** moduleUnsetenv doesn't unset the variable in the Tcl ** space because the $env variable might need to be ** used again in the modulefile for locating other ** paths. BUT, since this was a path-type environment ** variable, the user is expecting this to be empty ** after removing the only remaining path. So, I set ** the variable empty here. **/ (void) EMSetEnv( interp, variable, ""); _TCLCHK(interp); } /** ** Free what has been used and return on success **/ success1: null_free((void *)&oldpath); success0: Tcl_DStringFree(newpath); return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ unwind1: null_free((void *)&oldpath); unwind0: Tcl_DStringFree(newpath); return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** End of 'Remove_Path' **/