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