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' **/
