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' **/
int cmdModule( ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { int return_val = -1, i; int store_flags = g_flags; char *store_curmodule = NULL; char *save_module_command = NULL; int match = 0; /** ** These skip the arguments past the shell and command. **/ int num_modulefiles = argc - 2; char **modulefile_list = (char **) argv + 2; #if 0 int x=0; # define _XD fprintf(stderr,":%d:",++x), #else # define _XD #endif #define _MTCH _XD match = #define _ISERR ((match == -1) && (*TCL_RESULT(interp))) #define _TCLCHK(a) {if(_ISERR) ErrorLogger(ERR_EXEC,LOC,TCL_RESULT(a),NULL);} #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_START, LOC, _proc_cmdModule, NULL); #endif /** ** Help or whatis mode? **/ if( g_flags & (M_HELP | M_WHATIS)) return( TCL_OK); /** ** Parameter check **/ if( argc < 2) { (void) ErrorLogger( ERR_USAGE, LOC, "module", " command ", " [arguments ...] ", NULL); (void) ModuleCmd_Help( interp, 0, modulefile_list); return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Non-persist mode? **/ if (g_flags & M_NONPERSIST) { return (TCL_OK); } /** ** Display whatis mode? **/ if( g_flags & M_DISPLAY) { fprintf( stderr, "%s\t\t ", argv[ 0]); for( i=1; i<argc; i++) fprintf( stderr, "%s ", argv[ i]); fprintf( stderr, "\n"); return( TCL_OK); } /** ** For recursion. This can be called multiple times. **/ save_module_command = module_command; module_command = strdup( argv[1]); if( g_current_module) store_curmodule = g_current_module; /** ** If the command is '-', we want to just start ** interpreting Tcl from stdin. **/ if(_XD !strcmp( module_command, "-")) { return_val = Execute_TclFile( interp, _fil_stdin); /** ** Evaluate the module command and call the according subroutine ** --- module LOAD|ADD **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, addRE)) { _TCLCHK(interp); return_val = ModuleCmd_Load( interp, 1,num_modulefiles,modulefile_list); /** ** We always say the load succeeded. ModuleCmd_Load will ** output any necessary error messages. **/ return_val = TCL_OK; /** ** --- module UNLOAD **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, rmRE)) { _TCLCHK(interp); ModuleCmd_Load( interp, 0, num_modulefiles, modulefile_list); return_val = TCL_OK; /** ** --- module SWITCH **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, swRE)) { _TCLCHK(interp); return_val = ModuleCmd_Switch( interp, num_modulefiles,modulefile_list); /** ** --- module DISPLAY **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, dispRE)) { _TCLCHK(interp); return_val = ModuleCmd_Display( interp,num_modulefiles,modulefile_list); /** ** --- module LIST **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, listRE)) { _TCLCHK(interp); if (! (sw_format & SW_SET) ) { /* default format options */ sw_format |= (SW_HUMAN | SW_TERSE ); sw_format &= ~(SW_PARSE | SW_LONG ); } /* use SW_LIST to indicate LIST & not AVAIL */ sw_format |= SW_LIST; return_val = ModuleCmd_List( interp, num_modulefiles, modulefile_list); /** ** --- module AVAIL **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,availRE)) { _TCLCHK(interp); if (! (sw_format & SW_SET) ) { /* default format options */ sw_format |= (SW_HUMAN | SW_TERSE); sw_format &= ~(SW_PARSE | SW_LONG ); } /* use SW_LIST to indicate LIST & not AVAIL */ sw_format &= ~SW_LIST; return_val = ModuleCmd_Avail( interp, num_modulefiles, modulefile_list); /** ** --- module WHATIS and APROPOS **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,whatisRE)) { _TCLCHK(interp); return_val = ModuleCmd_Whatis(interp, num_modulefiles, modulefile_list); } else if(_MTCH Tcl_RegExpMatch(interp,module_command,aproposRE)) { _TCLCHK(interp); return_val = ModuleCmd_Apropos(interp, num_modulefiles,modulefile_list); /** ** --- module CLEAR **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,clearRE)) { _TCLCHK(interp); return_val = ModuleCmd_Clear( interp, num_modulefiles, modulefile_list); /** ** --- module UPDATE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,updateRE)) { _TCLCHK(interp); return_val = ModuleCmd_Update(interp, num_modulefiles, modulefile_list); /** ** --- module PURGE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,purgeRE)) { _TCLCHK(interp); return_val = ModuleCmd_Purge( interp, num_modulefiles, modulefile_list); /** ** --- module INIT **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,initRE)) { _TCLCHK(interp); if( Tcl_RegExpMatch(interp,module_command, "^inita|^ia")){/* initadd */ _TCLCHK(interp); g_flags |= M_LOAD; return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list); g_flags &= ~M_LOAD; } if( Tcl_RegExpMatch(interp,module_command, "^initr|^iw")){ /* initrm */ _TCLCHK(interp); g_flags |= M_REMOVE; return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list); g_flags &= ~M_REMOVE; } if( Tcl_RegExpMatch(interp,module_command, "^initl|^il")){/* initlist*/ _TCLCHK(interp); g_flags |= M_DISPLAY; return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list); g_flags &= ~M_DISPLAY; } if(Tcl_RegExpMatch(interp,module_command, "^inits|^is")){/* initswitch*/ _TCLCHK(interp); g_flags |= M_SWITCH; return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list); g_flags &= ~M_SWITCH; } if(Tcl_RegExpMatch(interp,module_command, "^initc|^ic")){/* initclear*/ _TCLCHK(interp); g_flags |= M_CLEAR; return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list); g_flags &= ~M_CLEAR; } if(Tcl_RegExpMatch(interp,module_command,"^initp|^ip")){/*initprepend*/ _TCLCHK(interp); g_flags |= (M_PREPEND | M_LOAD); return_val = ModuleCmd_Init(interp,num_modulefiles,modulefile_list); g_flags &= ~(M_PREPEND | M_LOAD); } /** ** --- module USE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, useRE)) { _TCLCHK(interp); return_val = ModuleCmd_Use( interp, num_modulefiles, modulefile_list); /** ** --- module UNUSE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, unuseRE)) { _TCLCHK(interp); return_val = ModuleCmd_UnUse( interp, num_modulefiles, modulefile_list); /** ** --- module REFRESH **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, refreshRE)) { _TCLCHK(interp); return_val = ModuleCmd_Refresh( interp, num_modulefiles, modulefile_list); /** ** --- module HELP **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, helpRE)) { _TCLCHK(interp); return_val = ModuleCmd_Help( interp, num_modulefiles, modulefile_list); } /** ** Tracing **/ if( CheckTracingList(interp, module_command, num_modulefiles, modulefile_list)) Module_Tracing( return_val, argc, (char **) argv); /** ** Evaluate the subcommands return value in order to get rid of unrecog- ** nized commands **/ if( return_val < 0) if( OK != ErrorLogger( ERR_COMMAND, LOC, module_command, NULL)) return (TCL_ERROR); /** ** Clean up from recursion **/ g_flags = store_flags; if( store_curmodule) g_current_module = store_curmodule; module_command = save_module_command; /** ** Return on success **/ #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_END, LOC, _proc_cmdModule, NULL); #endif return( return_val); } /** End of 'cmdModule' **/
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' **/