/* uvec_alloc_ - allocate an unitialized uvec object and use the * given string functions. * returns NULL if an error, else the memory location if OK. */ uvec *uvec_alloc_(uvec_str strfns) { uvec *uv = (uvec *) NULL; if (!(uv = (uvec *) module_malloc(sizeof(uvec)))) { return uv; } uv->str_fns.str_alloc = strfns.str_alloc; uv->str_fns.str_free = strfns.str_free; return uv; }
FINDLIST *new_list(unsigned int n) { unsigned int size = (n>>3)+1; FINDLIST *list = module_malloc(sizeof(FINDLIST)+size-1); if (list==NULL) { errno=ENOMEM; return NULL; } memset(list->result,0,size); list->result_size = size; list->hit_count = 0; return list; }
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 whatis_dir( char *dir, int argc, char **argv, FILE *cfp, int whatis_list) { fi_ent *dirlst_head = NULL; /** Directory list base pointer **/ int count = 0; /** Number of elements in the top **/ /** level directory list **/ int tcount = 0; /** Total number of files to print **/ char **list; /** flat list of module files **/ int start = 0, i, k; int result = TCL_OK; Tcl_Interp *whatis_interp; Tcl_DString cmdbuf; char modulefile[ MOD_BUFSIZE]; char **wptr, *c; struct stat stats; #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_START, LOC, _proc_whatis_dir, "dir='", dir, NULL); #endif /** ** Normal reading of the files **/ if( NULL == (dirlst_head = get_dir( dir, NULL, &count, &tcount))) if( OK != ErrorLogger( ERR_READDIR, LOC, dir, NULL)) goto unwind0; if( NULL == (list = (char**) module_malloc( tcount * sizeof( char**)))) if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) goto unwind1; dirlst_to_list( list, dirlst_head, count, &start, NULL, NULL); /** ** Initialize the command buffer and set up the modules flag to 'whatislay ** only' **/ Tcl_DStringInit( &cmdbuf); g_flags |= M_WHATIS; /** ** Check all the files in the flat list for the passed tokens **/ for( i=0; i<tcount; i++) { whatis_interp = EM_CreateInterp(); if( TCL_OK != (result = InitializeModuleCommands( whatis_interp))) { EM_DeleteInterp( whatis_interp); result = TCL_ERROR; break; /** for( i) **/ } /** ** locate the filename related to the passed module **/ if( (char *) NULL == stringer(modulefile,MOD_BUFSIZE, dir,"/",list[i],NULL)) { result = TCL_ERROR; break; /** for( i) **/ } g_current_module = list[ i]; if( stat( modulefile, &stats) || S_ISDIR( stats.st_mode)) continue; cmdModuleWhatisInit(); result = CallModuleProcedure( whatis_interp, &cmdbuf, modulefile, "ModulesApropos", 0); /** ** Check if at least one of the passed tokens is found in the ** retrieved whatis strings. If yes, print the string. **/ if( whatis) { wptr = whatis; while( *wptr) { /** ** Cache output enabled? **/ if( cfp) fprintf( cfp, "%-21s: %s\n", list[i], *wptr); /** ** Ignore case? **/ if( sw_icase) { strncpy( modulefile, *wptr, MOD_BUFSIZE); for( c = modulefile; c && *c; c++) *c = tolower( *c); c = modulefile; } else c = *wptr; /** ** Seek for the passed tokens **/ if( whatis_list) fprintf( stderr, "%-21s: %s\n", list[i], *wptr); else for( k=0; k<argc; k++) { if( strstr( c, argv[ k])) fprintf( stderr, "%-21s: %s\n", list[i], *wptr); } wptr++; } } /** ** Remove the Tcl interpreter that has been used for printing ... **/ EM_DeleteInterp( whatis_interp); cmdModuleWhatisShut(); } /** for( i) **/ /** ** Cleanup **/ g_flags &= ~M_WHATIS; delete_dirlst( dirlst_head, count); delete_cache_list( list, start); #if WITH_DEBUGGING_UTIL_1 ErrorLogger( NO_ERR_END, LOC, _proc_whatis_dir, NULL); #endif return( result); /** ------- EXIT (result) --------> **/ unwind2: delete_cache_list( list, start); unwind1: delete_dirlst( dirlst_head, count); unwind0: return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/ } /** End of 'whatis_dir' **/
int SourceRC(Tcl_Interp *interp, char *path, char *name) { struct stat stats; /** Buffer for the stat() systemcall **/ int save_flags, i = 0; char *buffer; int Result = TCL_OK; static char **srclist = (char **)NULL; static int listsize = 0, listndx = 0; /* dummy condition to use 'i': */ if (i == 0) { ; } /** ** If there is a problem with the input parameters it means, that ** we do not have to source anything ** Only a valid TCL interpreter should be there **/ if (!path || !name) { return (TCL_OK); } if (!interp) { return (TCL_ERROR); } /** ** Build the full name of the RC file ** Avoid duplicate sourcing **/ if ((char *)NULL == (buffer = stringer(NULL, 0, path,"/", name, NULL))) { if (OK != ErrorLogger(ERR_STRING, LOC, NULL)) { goto unwind0; } } /** ** Check whether the RC file exists and has the magic cookie inside **/ if (!stat(buffer, &stats)) { if (check_magic(buffer, MODULES_MAGIC_COOKIE, MODULES_MAGIC_COOKIE_LENGTH)) { /** ** Set the flags to 'load only'. This prevents from accidently ** printing something **/ save_flags = g_flags; g_flags = M_LOAD; /** ** Source now **/ if (TCL_ERROR == Execute_TclFile(interp, buffer)) { if (OK != ErrorLogger(ERR_SOURCE, LOC, buffer, NULL)) { Result = TCL_ERROR; } } g_flags = save_flags; /** ** Save the currently sourced file in the list ** Check whether the list is big enough to fit in a new entry **/ if (!listsize) { listsize = SRCFRAG; if ((char **)NULL == (srclist = (char **)module_malloc((size_t)((unsigned long)listsize * sizeof(char **))))) { ErrorLogger(ERR_ALLOC, LOC, NULL); goto unwind1; } } else if ((listndx + 1) >= listsize) { listsize += SRCFRAG; if (!(srclist = (char **)module_realloc(srclist, (size_t)((unsigned long)listsize * sizeof(char **))))) { ErrorLogger(ERR_ALLOC, LOC, NULL); goto unwind1; } } /** ** Put the current RC files name on the list: **/ srclist[listndx++] = buffer; } else { ErrorLogger(ERR_MAGIC, LOC, buffer, NULL); null_free((void *)&buffer); } } /** end "if (!stat)" **/ /** ** Return our result **/ return (Result); unwind1: null_free((void *)&buffer); unwind0: return (TCL_ERROR); } /** End of 'SourceRC' **/
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 Execute_TclFile( Tcl_Interp *interp, char *filename) { FILE *infile; int gotPartial = 0; int result = 0; EM_RetVal em_result = EM_OK; 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*) module_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( EM_ERROR == (em_result = ReturnValue(interp, 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' **/
int cmdModuleWhatis( ClientData client_data, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { int i = 1; #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_START, LOC, _proc_cmdModuleWhatis, NULL); #endif /** ** Help mode **/ if( g_flags & M_HELP) return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/ /** ** Parameter check **/ if( argc < 2) { if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], " string", NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** If we don't have any whatis list buffer until now, we will create one **/ if( !whatis) { whatis_size = WHATIS_FRAG; if((char **) NULL == (whatis = module_malloc(whatis_size * sizeof(char *)))){ ErrorLogger( ERR_ALLOC, LOC, NULL); return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } } /** ** Display mode? **/ if( g_flags & M_DISPLAY) { fprintf( stderr, "%s\t ", argv[ 0]); for( i=1; i<argc; i++) fprintf( stderr, "%s ", argv[ i]); fprintf( stderr, "\n"); return( TCL_OK); /** ------- EXIT PROCEDURE -------> **/ } /** ** Check if printing is requested **/ if( g_flags & M_WHATIS ) { while( i < argc) { /** ** Conditionally we have to enlarge our buffer **/ while( whatis_ndx + 2 >= whatis_size) { whatis_size += WHATIS_FRAG; if(!(whatis = module_realloc( whatis, whatis_size * sizeof( char *)))) { ErrorLogger( ERR_ALLOC, LOC, NULL); return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } } /** ** Put the string on the buffer **/ if((char *) NULL == (whatis[ whatis_ndx++] = strdup( argv[ i++]))) { if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) return( TCL_ERROR); whatis_ndx--; } } /** while **/ } /** if **/ /** ** Put a trailing terminator on the buffer **/ whatis[ whatis_ndx] = (char *) NULL; #if WITH_DEBUGGING_CALLBACK ErrorLogger( NO_ERR_END, LOC, _proc_cmdModuleWhatis, NULL); #endif return( TCL_OK); } /** End of 'cmdModuleWhatis' **/