/***** ** ** Module Header ******************************************************* ** ** ** ** Modules Revision 3.0 ** ** Providing a flexible user environment ** ** ** ** File: cmdModule.c ** ** First Edition: 91/10/23 ** ** ** ** Authors: John Furlan, jlf@behere.com ** ** Jens Hamisch, jens@Strawberry.COM ** ** ** ** Description: The actual module command from the Tcl level. This ** ** routines calls other ModuleCmd routines to carry out ** ** the subcommand requested. ** ** ** ** Exports: cmdModule ** ** Read_Modulefile ** ** Execute_TclFile ** ** CallModuleProcedure ** ** ** ** Notes: ** ** ** ** ************************************************************************ ** ****/ /** ** Copyright *********************************************************** ** ** ** ** Copyright 1991-1994 by John L. Furlan. ** ** see LICENSE.GPL, which must be provided, for details ** ** ** ** ************************************************************************ **/ static char Id[] = "@(#)$Id: cmdModule.c,v 1.4 2001/07/11 20:11:02 rkowen Exp $"; static void *UseId[] = { &UseId, Id }; /** ************************************************************************ **/ /** HEADERS **/ /** ************************************************************************ **/ #include "modules_def.h" /** ************************************************************************ **/ /** LOCAL DATATYPES **/ /** ************************************************************************ **/ /** not applicable **/ /** ************************************************************************ **/ /** CONSTANTS **/ /** ************************************************************************ **/ /** not applicable **/ /** ************************************************************************ **/ /** MACROS **/ /** ************************************************************************ **/ /** not applicable **/ /** ************************************************************************ **/ /** LOCAL DATA **/ /** ************************************************************************ **/ char _fil_stdin[] = "stdin"; char _fil_stdout[] = "stdout"; char _fil_stderr[] = "stderr"; char _fil_devnull[] = "/dev/null"; int linenum = 0; static char module_name[] = "cmdModule.c"; /** File name of this module **/ #if WITH_DEBUGGING_CALLBACK static char _proc_cmdModule[] = "cmdModule"; #endif #if WITH_DEBUGGING_UTIL static char _proc_Read_Modulefile[] = "Read_Modulefile"; #endif #if WITH_DEBUGGING_UTIL_1 static char _proc_Execute_TclFile[] = "Execute_TclFile"; static char _proc_CallModuleProcedure[] = "CallModuleProcedure"; #endif char *module_command; /** ************************************************************************ **/ /** PROTOTYPES **/ /** ************************************************************************ **/ /** not applicable **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: cmdModule ** ** ** ** Description: Evaluation of the module command line and callup of ** ** the according subroutine ** ** ** ** First Edition: 91/10/23 ** ** ** ** Parameters: ClientData client_data ** ** Tcl_Interp *interp According Tcl interp.** ** int argc Number of arguments ** ** char *argv[] Argument array ** ** ** ** Result: int TCL_OK Successfull completion ** ** TCL_ERROR Any error ** ** ** ** Attached Globals: g_flags These are set up accordingly before ** ** this function is called in order to ** ** control everything ** ** g_current_module The module which is handled ** ** by the current command ** ** ** ** ************************************************************************ ** ++++*/ int cmdModule( ClientData client_data, Tcl_Interp *interp, int argc, char *argv[]) { int return_val = -1, i; int store_flags = g_flags; char *store_curmodule = NULL; char *save_module_command = NULL; #ifdef FORCE_PATH char *base_path = NULL; char *sacred_path = NULL; #endif int match = 0; /** ** These skip the arguments past the shell and command. **/ int num_modulefiles = argc - 2; char **modulefile_list = 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) && (*interp->result)) #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, argv[0], " subcommand ", " [arguments ...] ", NULL); (void) ModuleCmd_Help( interp, 0, modulefile_list); return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Display whatis mode? **/ if( g_flags & M_DISPLAY) { fprintf( stderr, "%s\t\t ", argv[ 0]); for( i=1; iresult, NULL); return_val = ModuleCmd_Load( interp, 1,num_modulefiles,modulefile_list); #ifdef FORCE_PATH if( return_val) { /** ** return_val now indicates whether ANY modulefile was loaded ** Only if any modulefile was loaded do we need to worry ** about forcing paths. **/ if( base_path = (char *) getenv( "MODULES_PATH_BASE") || base_path = (char *) getenv( "BASE_PATH")) { ForceBasePath( interp, "PATH", base_path); } else { ForceBasePath( interp, "PATH", FORCE_PATH); } if( sacred_path = (char *) getenv( "MODULES_PATH_SACRED") || sacred_path = (char *) getenv( "SACRED_PATH")) { ForceSacredPath( interp, "PATH", sacred_path); } else { ForceSacredPath( interp, "PATH", FORCE_PATH_SACRED); } if(sacred_path = (char *) getenv("MODULES_LD_LIBRARY_PATH_SACRED")){ ForceSacredPath( interp, "LD_LIBRARY_PATH", sacred_path); } else { ForceSacredPath( interp, "LD_LIBRARY_PATH", FORCE_LD_LIBRARY_PATH_SACRED); } } /** if( return_val) **/ #endif /** ** 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)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); ModuleCmd_Load( interp, 0, num_modulefiles, modulefile_list); return_val = TCL_OK; /** ** --- module SWITCH **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, swRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Switch( interp, num_modulefiles,modulefile_list); /** ** --- module DISPLAY **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, dispRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Display( interp,num_modulefiles,modulefile_list); /** ** --- module LIST **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, listRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); 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)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); 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)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Whatis(interp, num_modulefiles, modulefile_list); } else if(_MTCH Tcl_RegExpMatch(interp,module_command,aproposRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Apropos(interp, num_modulefiles,modulefile_list); /** ** --- module CLEAR **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,clearRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Clear( interp, num_modulefiles, modulefile_list); /** ** --- module UPDATE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,updateRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Update(interp, num_modulefiles, modulefile_list); /** ** --- module PURGE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,purgeRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Purge( interp, num_modulefiles, modulefile_list); /** ** --- module INIT **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command,initRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); if( Tcl_RegExpMatch(interp,module_command, "^inita|^ia")){/* initadd */ if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL); 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 */ if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL); 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*/ if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL); 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*/ if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL); 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*/ if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL); 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*/ if (_ISERR) ErrorLogger(ERR_EXEC,LOC,interp->result,NULL); 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)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Use( interp, num_modulefiles, modulefile_list); /** ** --- module UNUSE **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, unuseRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_UnUse( interp, num_modulefiles, modulefile_list); /** ** --- module HELP **/ } else if(_MTCH Tcl_RegExpMatch(interp,module_command, helpRE)) { if (_ISERR) ErrorLogger( ERR_EXEC, LOC, interp->result, NULL); return_val = ModuleCmd_Help( interp, num_modulefiles, modulefile_list); } /** ** Tracing **/ if( CheckTracingList(interp, module_command, num_modulefiles, modulefile_list)) Module_Tracing( return_val, argc, 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' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Read_Modulefile ** ** ** ** Description: Check the passed filename for to be a valid module ** ** and execute the according command file ** ** ** ** First Edition: 91/10/23 ** ** ** ** Parameters: Tcl_Interp *interp According Tcl interp.** ** char *filename ** ** ** ** Result: int TCL_OK Successfull completion ** ** TCL_ERROR Any error ** ** ** ** Attached Globals: ** ** ** ** ************************************************************************ ** ++++*/ int Read_Modulefile( Tcl_Interp *interp, char *filename) { int result; char *startp, *endp; #if WITH_DEBUGGING_UTIL ErrorLogger( NO_ERR_START, LOC, _proc_Read_Modulefile, NULL); #endif /** ** Parameter check. A valid filename is to be given. **/ if( !filename) { if( OK != ErrorLogger( ERR_PARAM, LOC, "filename", NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Check for the module 'magic cookie' ** Trust stdin as a valid module file ... **/ if( !strcmp( filename, _fil_stdin) && !check_magic( filename, MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH)) { if( OK != ErrorLogger( ERR_MAGIC, LOC, filename, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Now do execute that module file and evaluate the result of the ** latest executed command **/ if( TCL_ERROR == (result = Execute_TclFile(interp, filename))) { #if WITH_DEBUGGING_UTIL ErrorLogger( NO_ERR_DEBUG, LOC, "Execution of '", filename, "' failed", NULL); #endif if( *interp->result) { char *tstr = NULL; Tcl_RegExp retexpPtr; tstr = strdup(interp->result); retexpPtr = Tcl_RegExpCompile(interp, "^EXIT ([0-9]*)"); if( Tcl_RegExpExec(interp, retexpPtr, tstr, tstr)) { Tcl_RegExpRange(retexpPtr, 1, &startp, &endp); if( startp != '\0') result = atoi( startp ); } if (tstr) free(tstr); } } /** ** Return the result as derivered from the module file execution **/ #if WITH_DEBUGGING_UTIL ErrorLogger( NO_ERR_END, LOC, _proc_Read_Modulefile, NULL); #endif return( result); } /** End of 'Read_Modulefile' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Execute_TclFile ** ** ** ** Description: Read in and execute all commands concerning the Tcl ** ** file passed as parameter ** ** ** ** First Edition: 91/10/23 ** ** ** ** Parameters: Tcl_Interp *interp According Tcl interp.** ** char *filename ** ** ** ** Result: int TCL_OK Successfull completion ** ** TCL_ERROR Any error ** ** ** ** Attached Globals: line Input read buffer ** ** ** ** ************************************************************************ ** ++++*/ int Execute_TclFile( Tcl_Interp *interp, char *filename) { FILE *infile; int gotPartial = 0; int result = 0; char *cmd; Tcl_DString cmdbuf; #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_START, LOC, _proc_Execute_TclFile, NULL); #endif /** ** If there isn't a line buffer allocated so far, do it now **/ if( line == NULL) { if( NULL == (line = (char*) malloc( LINELENGTH * sizeof( char)))) { if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } } /** ** If we're supposed to be interpreting from stdin, set infile ** equal to stdin, otherwise, open the file and interpret **/ if( !strcmp( filename, _fil_stdin)) { infile = stdin; } else { if( NULL == (infile = fopen( filename, "r"))) { if( OK != ErrorLogger( ERR_OPEN, LOC, filename, "reading", NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } } /** ** Allow access to which file is being loaded. **/ linenum = 0; Tcl_SetVar( interp, "ModulesCurrentModulefile", filename, 0); Tcl_DStringInit( &cmdbuf); while( 1) { linenum++; if( fgets(line, LINELENGTH, infile) == NULL) { if( !gotPartial) { break; /** while **/ } line[0] = '\0'; } /** ** Put the whole command on the command buffer **/ cmd = Tcl_DStringAppend( &cmdbuf, line, (-1)); if( line[0] != 0 && !Tcl_CommandComplete(cmd)) { gotPartial++; continue; } /** ** Now evaluate the command and react on its result ** Reinitialize the command buffer **/ #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_DEBUG, LOC, " Evaluating '", cmd, "'", NULL); #endif result = Tcl_Eval( interp, cmd); if( TCL_ERROR == result) { ErrorLogger( ERR_EXEC, LOC, cmd, NULL); } Tcl_DStringTrunc( &cmdbuf, 0); #if WITH_DEBUGGING_UTIL_1 { char buffer[ 80]; switch( result) { case TCL_OK: strcpy( buffer, "TCL_OK"); break; case TCL_ERROR: strcpy( buffer, "TCL_ERROR"); break; case TCL_LEVEL0_RETURN: strcpy( buffer, "TCL_LEVEL0_RETURN"); break; } ErrorLogger( NO_ERR_DEBUG, LOC, " Result: '", buffer, "'", NULL); } #endif switch( result) { case TCL_OK: gotPartial = 0; continue; /** while **/ case TCL_ERROR: interp->errorLine = ((linenum-1)-gotPartial) + interp->errorLine; /* FALLTHROUGH */ case TCL_LEVEL0_RETURN: break; /** switch **/ } /** ** If the while loop hasn't been continued so far, it is to be broken ** now **/ break; /** while **/ } /** while **/ /** ** Free up what has been used, close the input file and return the result ** of the last command to the caller **/ Tcl_DStringFree( &cmdbuf); if( EOF == fclose( infile)) if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_END, LOC, _proc_Execute_TclFile, NULL); #endif return( result); } /** End of 'Execute_TclFile' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: CallModuleProcedure ** ** ** ** Description: Call a Tcl Procedure ** ** Executes the passed modulefile (conditionally hidden)** ** and then evaluates the passed Tcl procedure ** ** ** ** First Edition: 91/10/23 ** ** ** ** Parameters: Tcl_Interp *interp According Tcl interp.** ** Tcl_DString *cmdptr Buffer fot the Tcl ** ** command ** ** char *modulefile According module file** ** char *procname Name of the Tcl Proc.** ** int suppress_output Controlls redirect.** ** of stdout and stderr ** ** ** ** Result: int TCL_OK Successfull completion ** ** TCL_ERROR Any error ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ int CallModuleProcedure( Tcl_Interp *interp, Tcl_DString *cmdptr, char *modulefile, char *procname, int suppress_output) { char cmdline[ LINELENGTH]; char *cmd; int result; int saved_stdout = 0, saved_stderr = 0, devnull; #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_START, LOC, _proc_CallModuleProcedure, NULL); #endif /** ** Must send stdout and stderr to /dev/null until the ** ModulesHelp procedure is called. **/ if( suppress_output) { if( 0 > (devnull = open( _fil_devnull, O_RDWR))) { if( OK != ErrorLogger( ERR_OPEN, LOC, _fil_devnull, "changing", NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Close STDOUT and reopen it as /dev/null **/ if( -1 == ( saved_stdout = dup( 1))) if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == close( 1)) if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == dup( devnull)) if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ /** ** Close STDERR and reopen it as /dev/null **/ if( -1 == ( saved_stdout = dup( 2))) if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == close( 2)) if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == dup( devnull)) if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ } /** ** Read the passed module file **/ Read_Modulefile( interp, modulefile); /** ** Reinstall stdout and stderr **/ if( suppress_output) { /** ** Reinstall STDOUT **/ if( EOF == fflush( stdout)) if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( EOF == fflush( stderr)) if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stderr, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == close( 1)) if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ /** ** Reinstall STDERR **/ if( -1 == dup( saved_stdout)) if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == close( 2)) if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ if( -1 == dup( saved_stderr)) if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL)) return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ } /** ** Now evaluate the Tcl Procedure **/ /* sprintf( cmdline, "%s\n", procname); */ strcpy( cmdline, procname); strcat( cmdline, "\n"); cmd = Tcl_DStringAppend( cmdptr, cmdline, (-1)); result = Tcl_Eval( interp, cmd); Tcl_DStringTrunc( cmdptr, 0); #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_END, LOC, _proc_CallModuleProcedure, NULL); #endif return( result); } /** End of 'CallModuleProcedure' **/