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