int cmdUnsetEnv( ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { /** ** Parameter check. The name of the variable has to be specified **/ #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_START, LOC, _proc_cmdUnsetEnv, NULL); #endif if( argc < 2 || argc > 3) { if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], "variable [value]", NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Non-persist mode? **/ if (g_flags & M_NONPERSIST) { return (TCL_OK); } /** ** Unset the variable or just display what to do ... **/ if( g_flags & M_DISPLAY) { fprintf( stderr, "%s\t ", argv[ 0]); while( --argc) fprintf( stderr, "%s ", *++argv); fprintf( stderr, "\n"); } else if( g_flags & M_REMOVE && argc == 3) { int save_flags = g_flags; /** allow an optional 3rd argument to set the env.var. to on removal **/ g_flags = (g_flags & ~M_REMOVE) | M_LOAD; moduleSetenv( interp, (char *) argv[1], (char *) argv[2], 0); g_flags = save_flags; } else { moduleUnsetenv( interp, (char *) argv[1]); } /** ** Return on success **/ #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_END, LOC, _proc_cmdUnsetEnv, NULL); #endif return( TCL_OK); } /** End of 'cmdUnsetEnv' **/
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 Initialize_Tcl( Tcl_Interp **interp, int argc, char *argv[], char *environ[]) { int Result = TCL_ERROR; char * tmp; #if WITH_DEBUGGING_INIT ErrorLogger( NO_ERR_START, LOC, _proc_Initialize_Tcl, NULL); #endif /** ** Check the command syntax. Since this is already done ** Less than 3 parameters isn't valid. Invocation should be ** 'modulecmd <shell> <command>' **/ if(argc < 2) if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], " shellname", NULL)) goto unwind0; /** ** Check the first parameter to modulcmd for a known shell type ** and set the shell properties **/ if( !set_shell_properties( argv[1])) if( OK != ErrorLogger( ERR_SHELL, LOC, argv[1], NULL)) goto unwind0; /** ** Create a Tcl interpreter in order to proceed the command. Initialize ** this interpreter and set up pointers to all Tcl Module commands ** (InitializeModuleCommands) **/ #ifdef __CYGWIN__ /* ABr, 12/10/01: from Cygwin stuff */ Tcl_FindExecutable( argv[0] ) ; #endif *interp = EM_CreateInterp(); if( TCL_OK != (Result = InitializeModuleCommands( *interp))) goto unwind0; /** ** Now set up the hash-tables for shell environment modifications. ** For a description of these tables have a look at main.c, where ** they're defined. The tables have to be allocated and thereafter ** initialized. Exit from the whole program in case allocation fails. **/ if( ( ! ( setenvHashTable = (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) || ( ! ( unsetenvHashTable = (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) || ( ! ( aliasSetHashTable = (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) || ( ! ( aliasUnsetHashTable = (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) || ( ! ( markVariableHashTable = (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) || ( ! ( markAliasHashTable = (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ) { if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) goto unwind0; } Tcl_InitHashTable( setenvHashTable, TCL_STRING_KEYS); Tcl_InitHashTable( unsetenvHashTable, TCL_STRING_KEYS); Tcl_InitHashTable( aliasSetHashTable, TCL_STRING_KEYS); Tcl_InitHashTable( aliasUnsetHashTable, TCL_STRING_KEYS); Tcl_InitHashTable( markVariableHashTable, TCL_STRING_KEYS); Tcl_InitHashTable( markAliasHashTable, TCL_STRING_KEYS); #ifdef BEGINENV # if BEGINENV == 99 /** ** Check for the existence of the environment variable ** "MODULESBEGINENV". This signals that for this ** configuration that the user wants to record the initial ** environment as seen for the first time by the module ** command into the filename given in the MODULESBEGINENV ** environment variable (which can have one level of ** variable expansion). Whether it's the first time or not ** is moderated by the existence of environment variable ** _MODULESBEGINENV_ or not. ** ** The update command will use this information to reinitialize the ** environment and then reload every modulefile that has been loaded ** since as stored in the LOADEDMODULES environment variable in order. **/ if( (tmp = xgetenv( "MODULESBEGINENV")) ) { /* MODULESBEGINENV is set ... use it */ if( !getenv( "_MODULESBEGINENV_") ) { FILE* file; if( (file = fopen(tmp, "w+")) ) { int i=0; while( environ[i]) { fprintf( file, "%s\n", environ[i++]); } moduleSetenv( *interp, "_MODULESBEGINENV_", tmp, 1); fclose( file); } else if( OK != ErrorLogger( ERR_OPEN, LOC, TCL_RESULT(*interp), "append", NULL)) goto unwind0; null_free((void *) &tmp); } } # else /** ** Check for the existence of the ** environment variable "_MODULESBEGINENV_". If it is set, then ** do nothing, otherwise, Store every environment variable into ** ~/.modulesbeginenv. This will be used to store the environment ** variables exactly as it was when Modules saw it for the very first ** time. ** ** The update command will use this information to reinitialize the ** environment and then reload every modulefile that has been loaded ** since as stored in the LOADEDMODULES environment variable in order. **/ if( !getenv( "_MODULESBEGINENV_") ) { /* use .modulesbeginenv */ FILE* file; char savefile[] = "/.modulesbeginenv"; char *buffer; tmp = getenv("HOME"); if((char *) NULL == (tmp = getenv("HOME"))) if( OK != ErrorLogger( ERR_HOME, LOC, NULL)) goto unwind0; if((char *) NULL == (buffer = stringer(NULL,0,tmp,savefile,NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind0; if( file = fopen(buffer, "w+")) { int i=0; while( environ[i]) { fprintf( file, "%s\n", environ[i++]); } moduleSetenv( *interp, "_MODULESBEGINENV_", buffer, 1); fclose( file); } else if( OK != ErrorLogger( ERR_OPEN, LOC, TCL_RESULT(*interp), "append", NULL)) goto unwind0; null_free((void *) &buffer); } # endif #endif /** ** Exit to the main program **/ return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ unwind0: return( Result); /** -------- EXIT (FAILURE) -------> **/ } /** End of 'Initialize_Tcl' **/
int cmdSetEnv(ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { int force; /** Force removale of variables **/ char *var; /** name of variable **/ char *val; /** value of varibale **/ force = 0; /* initialize */ var = (char *)argv[1]; /* initialize (same as default case below) */ val = (char *)argv[2]; /* initialize (same as default case below) */ #if WITH_DEBUGGING_CALLBACK ErrorLogger(NO_ERR_START, LOC, _proc_cmdSetEnv, NULL); #endif /* WITH_DEBUGGING_CALLBACK */ /** ** Check parameters. Usage is: [-force] variable value **/ if ((argc < 3) || (argc > 4)) { if (OK != ErrorLogger(ERR_USAGE, LOC, argv[0], "[-force] variable value", NULL)) { return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } } /** ** Get the name and value of the variable from the argument array: **/ if (*argv[1] == '-') { if (!strncmp(argv[1], "-force", 6)) { force = 1; var = (char *)argv[2]; val = (char *)argv[3]; } else { if (OK != ErrorLogger(ERR_USAGE, LOC, argv[0], "[-force] variable value", NULL)) { return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } } } else { /* default case: */ force = 0; var = (char *)argv[1]; val = (char *)argv[2]; } moduleSetenv(interp, var, val, force); /** ** This has to be done after everything has been set because the ** variables may be needed later in the modulefile. **/ if (g_flags & M_DISPLAY) { fprintf(stderr, "%s\t\t ", argv[0]); while (--argc) { fprintf( stderr, "%s ", *++argv); } fprintf(stderr, "\n"); } #if WITH_DEBUGGING_CALLBACK ErrorLogger(NO_ERR_END, LOC, _proc_cmdSetEnv, NULL); #endif /* WITH_DEBUGGING_CALLBACK */ return(TCL_OK); } /** End of 'cmdSetEnv' **/
int cmdSetPath(ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { Tcl_RegExp chkexpPtr; /** Regular expression for * marker checking **/ char *oldpath, /** Old value of 'var' **/ *newpath, /** New value of 'var' **/ *sw_marker = APP_SW_MARKER, /** arbitrary default **/ *startp = NULL, *endp = NULL, /** regexp match endpts **/ *qualifiedpath, /** List of dirs which * are NOT already in path **/ **pathlist; /** List of dirs **/ const char *delim = _colon; /** path delimiter **/ int append = 1, /** append or prepend **/ numpaths, /** number of dirs in path **/ qpathlen, /** qualifiedpath length **/ arg1 = 1, /** arg start **/ x; /** loop index **/ Tcl_Obj *np_obj; /** new path Tcl Obj **/ #if WITH_DEBUGGING_CALLBACK ErrorLogger(NO_ERR_START, LOC, _proc_cmdSetPath, NULL); #endif /* WITH_DEBUGGING_CALLBACK */ /** ** Whatis mode? **/ if (g_flags & (M_WHATIS | M_HELP)) { goto success0; } /** ** Check arguments. There should be at least 3 args: ** argv[0] - prepend/append ** ... ** argv[n-1]- varname ** argv[n] - value **/ if(argc < 3) { if (OK != ErrorLogger(ERR_USAGE, LOC, argv[0], " path-variable directory", NULL)) { goto unwind0; } } /** ** Should this guy be removed from the variable(?)... If yes, then do so! **/ if (g_flags & M_REMOVE) { return (cmdRemovePath(client_data, interp, argc, argv)); /** ----> **/ } /** ** prepend or append. The default is append. **/ if (!(append = !!strncmp(argv[0], "pre", 3))) { sw_marker = PRE_SW_MARKER; } /** ** Non-persist mode? **/ if (g_flags & M_NONPERSIST) { return (TCL_OK); } /** ** Display only ... ok, let us do so! **/ if (g_flags & M_DISPLAY) { fprintf(stderr, "%s\t ", argv[0]); while (--argc) { fprintf( stderr, "%s ", *++argv); } fprintf(stderr, "\n"); goto success0; } /** ** Check for the delimiter option **/ if (*(argv[arg1]) == '-') { if (!strcmp(argv[arg1], "-d")) { delim = argv[(arg1 + 1)]; arg1 += 2; } else if (!strcmp(argv[arg1], "--delim")) { delim = argv[(arg1 + 1)]; arg1 += 2; } else if (!strncmp(argv[arg1], "--delim=", 8)) { delim = (argv[arg1] + 8); arg1++; } } /** ** Get the old value of the variable. MANPATH defaults to a configure ** generated value. ** Put a \ in front of each '.' and '+'. ** (this is an intentional memory leak) **/ oldpath = EMGetEnv(interp, argv[arg1]); _TCLCHK(interp) if(!oldpath || !*oldpath) { null_free((void *) &oldpath); oldpath = ((!strcmp(argv[arg1], "MANPATH")) ? stringer(NULL, 0, DEFAULTMANPATH, NULL) : stringer(NULL, 0, "", NULL)); } /** ** Split the new path into its components directories so each ** directory can be checked to see whether it is already in the ** existing path. **/ if (!(pathlist = SplitIntoList(interp, (char *)argv[(arg1 + 1)], &numpaths, delim))) { goto unwind0; } /** ** Some space for the list of paths which ** are not already in the existing path. **/ if((char *) NULL == (qualifiedpath = stringer(NULL, 0, argv[(arg1 + 1)], delim, NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind1; } } qpathlen = (int)(strlen(qualifiedpath) + 1); *qualifiedpath = '\0'; /** make sure null for later **/ for ((x = 0); (x < numpaths); x++) { regex_quote(pathlist[x], buffer, PATH_BUFLEN); /** ** Check to see if path is already in this path variable. ** It could be at the ** beginning ... ^path: ** middle ... :path: ** end ... :path$ ** only one ... ^path$ **/ if ((char *)NULL == (newpath = stringer(NULL, 0, "(^", buffer, delim, ")|(", delim, buffer, delim, ")|(", delim, buffer, "$)|(^", buffer, "$)", NULL))) { if (OK != ErrorLogger( ERR_STRING, LOC, NULL)) { goto unwind2; } } np_obj = Tcl_NewStringObj(newpath, (int)strlen(newpath)); chkexpPtr = Tcl_GetRegExpFromObj(interp, np_obj, TCL_REG_ADVANCED); _TCLCHK(interp) null_free((void *)&newpath); /** ** If the directory is not already in the path, ** add it to the qualified path. **/ if (!Tcl_RegExpExec(interp, chkexpPtr, oldpath, oldpath)) { if (!stringer((qualifiedpath + strlen(qualifiedpath)), (int)((unsigned long)qpathlen - strlen(qualifiedpath)), pathlist[x], delim, NULL)) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind2; } } } } /** End of loop that checks for ** already existent path **/ /** ** If all of the directories in the new path already exist, ** exit doing nothing. **/ if (! *qualifiedpath) { goto success1; } /* remove trailing delimiter */ qualifiedpath[(strlen(qualifiedpath) - 1)] = '\0'; /** ** Some space for our newly created path. ** We size at the oldpath plus the addition. **/ if (!(newpath = stringer(NULL, (int)(strlen(oldpath) + strlen(qualifiedpath) + 2), NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind2; } } *newpath = '\0'; /** ** Easy job to do, if the old path has not been set up so far ... **/ if (!strcmp(oldpath, "")) { strcpy(newpath, qualifiedpath); /** ** Otherwise we have to take care on prepending vs. appending ... ** If there is a append or prepend marker within the variable (see ** modules_def.h) the changes are made according to this markers. Other- ** wise append and prepend will be relative to the strings begin or end. **/ } else { Tcl_Obj *sw_obj = Tcl_NewStringObj(sw_marker, (int)strlen(sw_marker)); Tcl_RegExp markexpPtr = Tcl_GetRegExpFromObj(interp, sw_obj, TCL_REG_ADVANCED); _TCLCHK(interp) strcpy(newpath, oldpath); if (Tcl_RegExpExec(interp, markexpPtr, oldpath, oldpath)) { _TCLCHK(interp) Tcl_RegExpRange(markexpPtr, 0, (CONST84 char **)&startp, (CONST84 char **)&endp); /** ** Append/Prepend marker found **/ if (append) { char ch = *startp; *startp = '\0'; strcpy(newpath, oldpath); /** ** check that newpath has a value before adding delim **/ if ((strlen(newpath) > 0) && (newpath[(strlen(newpath) - 1)] != *delim)) { strcat(newpath, delim); } strcat(newpath, qualifiedpath); if (newpath[strlen(newpath)-1] != *delim) { strcat(newpath, delim); } *startp = ch; strcat(newpath, startp); } else { char ch = *endp; *endp = '\0'; strcpy(newpath, oldpath); if (newpath[strlen(newpath)-1] != *delim) { strcat(newpath, delim); } strcat(newpath, qualifiedpath); *endp = ch; strcat(newpath, endp); } } else { /** ** No marker set **/ if (append) { strcpy(newpath, oldpath); if (newpath[strlen(newpath)-1] != *delim) { strcat(newpath, delim); } strcat(newpath, qualifiedpath); } else { strcpy(newpath, qualifiedpath); if (*oldpath != *delim) { strcat(newpath, delim); } strcat(newpath, oldpath); } /* end "if (append)" */ } /** end "if (marker)" **/ } /** end "if (strcmp)" **/ /** ** Now the new value to be set resides in 'newpath'. Set it up. **/ moduleSetenv(interp, (char *)argv[arg1], newpath, 1); _TCLCHK(interp) #if WITH_DEBUGGING_CALLBACK ErrorLogger(NO_ERR_END, LOC, _proc_cmdSetPath, NULL); #endif /* WITH_DEBUGGING_CALLBACK */ /** ** Free resources **/ null_free((void *)&newpath); success1: null_free((void *)&oldpath); null_free((void *)&qualifiedpath); FreeList(pathlist, numpaths); success0: return (TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ unwind2: null_free((void *)&qualifiedpath); unwind1: FreeList(pathlist, numpaths); unwind0: null_free((void *)&oldpath); return (TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** End of 'cmdSetPath' **/