/***** ** ** Module Header ******************************************************* ** ** ** ** Modules Revision 3.0 ** ** Providing a flexible user environment ** ** ** ** File: utility.c ** ** First Edition: 1991/10/23 ** ** ** ** Authors: John Furlan, jlf@behere.com ** ** Jens Hamisch, jens@Strawberry.COM ** ** ** ** Description: General routines that are called throughout Modules ** ** which are not necessarily specific to any single ** ** block of functionality. ** ** ** ** Exports: store_hash_value ** ** clear_hash_value ** ** Delete_Global_Hash_Tables ** ** Delete_Hash_Tables ** ** Copy_Hash_Tables ** ** Unwind_Modulefile_Changes ** ** Output_Modulefile_Changes ** ** IsLoaded_ExactMatch ** ** IsLoaded ** ** chk_marked_entry ** ** set_marked_entry ** ** Update_LoadedList ** ** check_magic ** ** regex_quote ** ** xstrtok ** ** xstrtok_r ** ** chk4spch ** ** module_malloc ** ** xdup ** ** xgetenv ** ** stringer ** ** null_free ** ** countTclHash ** ** ** ** strdup if not defined by the system libs. ** ** ** ** Notes: ** ** ** ** ************************************************************************ ** ****/ /** ** Copyright *********************************************************** ** ** ** ** Copyright 1991-1994 by John L. Furlan. ** ** see LICENSE.GPL, which must be provided, for details ** ** ** ** ************************************************************************ **/ static char Id[] = "@(#)$Id: b16f29ec6f608bcbdc99e5e329befefbd7fa43fb $"; static void *UseId[] = { &UseId, Id }; /** ************************************************************************ **/ /** HEADERS **/ /** ************************************************************************ **/ #include "modules_def.h" /** ************************************************************************ **/ /** LOCAL DATATYPES **/ /** ************************************************************************ **/ /** not applicable **/ /** ************************************************************************ **/ /** CONSTANTS **/ /** ************************************************************************ **/ /** not applicable **/ /** ************************************************************************ **/ /** MACROS **/ /** ************************************************************************ **/ /** not applicable **/ /** ************************************************************************ **/ /** LOCAL DATA **/ /** ************************************************************************ **/ static char module_name[] = "utility.c"; /** File name of this module **/ #if WITH_DEBUGGING_UTIL_2 static char _proc_store_hash_value[] = "store_hash_value"; static char _proc_clear_hash_value[] = "clear_hash_value"; static char _proc_Clear_Global_Hash_Tables[] = "Clear_Global_Hash_Tables"; static char _proc_Delete_Global_Hash_Tables[] = "Delete_Global_Hash_Tables"; static char _proc_Delete_Hash_Tables[] = "Delete_Hash_Tables"; static char _proc_Copy_Hash_Tables[] = "Copy_Hash_Tables"; static char _proc_Unwind_Modulefile_Changes[] = "Unwind_Modulefile_Changes"; static char _proc_Output_Modulefile_Changes[] = "Output_Modulefile_Changes"; static char _proc_Output_Modulefile_Aliases[] = "Output_Modulefile_Aliases"; static char _proc_Output_Directory_Change[] = "Output_Directory_Change"; static char _proc_output_set_variable[] = "output_set_variable"; static char _proc_output_unset_variable[] = "output_unset_variable"; static char _proc_output_function[] = "output_function"; static char _proc_output_set_alias[] = "output_set_alias"; static char _proc_output_unset_alias[] = "output_unset_alias"; static char _proc_getLMFILES[] = "getLMFILES"; static char _proc___IsLoaded[] = "__IsLoaded"; static char _proc_chk_marked_entry[] = "chk_marked_entry"; static char _proc_set_marked_entry[] = "set_marked_entry"; static char _proc_get_module_basename[] = "get_module_basename"; static char _proc_Update_LoadedList[] = "Update_LoadedList"; static char _proc_check_magic[] = "check_magic"; static char _proc_cleanse_path[] = "cleanse_path"; static char _proc_chop[] = "chop"; #endif static FILE *aliasfile; /** Temporary file to write aliases **/ static char *aliasfilename; /** Temporary file name **/ static char alias_separator = ';'; /** Alias command separator **/ static const int eval_alias = /** EVAL_ALIAS macro **/ #ifdef EVAL_ALIAS 1 #else 0 #endif ; static const int bourne_funcs = /** HAS_BOURNE_FUNCS macro **/ #ifdef HAS_BOURNE_FUNCS 1 #else 0 #endif ; static const int bourne_alias = /** HAS_BOURNE_FUNCS macro **/ #ifdef HAS_BOURNE_ALIAS 1 #else 0 #endif ; /** ************************************************************************ **/ /** PROTOTYPES **/ /** ************************************************************************ **/ static void Clear_Global_Hash_Tables( void); static int Output_Modulefile_Aliases( Tcl_Interp *interp); static int Output_Directory_Change(Tcl_Interp *interp); static int output_set_variable( Tcl_Interp *interp, const char*, const char*); static int output_unset_variable( const char* var); static void output_function( const char*, const char*); static int output_set_alias( const char*, const char*); static int output_unset_alias( const char*, const char*); static int __IsLoaded( Tcl_Interp*, char*, char**, char*, int); static char *get_module_basename( char*); static char *chop( const char*); static void EscapeCshString(const char* in, char* out); static void EscapeShString(const char* in, char* out); static void EscapePerlString(const char* in, char* out); static void EscapeCmakeString(const char* in, char* out); /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: store_hash_value ** ** ** ** Description: Keeps the old value of the variable around if it is ** ** touched in the modulefile to enable undoing a ** ** modulefile by resetting the evironment to it started.** ** ** ** This is the same for unset_shell_variable() ** ** ** ** First Edition: 1992/10/14 ** ** ** ** Parameters: Tcl_HashTable *htable Hash table to be used** ** const char *key Attached key ** ** const char *value Alias value ** ** ** ** Result: int TCL_OK Successful completion ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ int store_hash_value( Tcl_HashTable* htable, const char* key, const char* value) { int new; /** Return from Tcl_CreateHashEntry **/ /** which indicates creation or ref- **/ /** ference to an existing entry **/ char *tmp; /** Temp pointer used for disalloc. **/ Tcl_HashEntry *hentry; /** Hash entry reference **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_store_hash_value, NULL); #endif /** ** Create a hash entry for the key to be stored. If there exists one ** so far, its value has to be unlinked. ** All values in this hash are pointers to allocated memory areas. **/ hentry = Tcl_CreateHashEntry( htable, (char*) key, &new); if( !new) { tmp = (char *) Tcl_GetHashValue( hentry); if( tmp) null_free((void *) &tmp); } /** ** Set up the new value. strdup allocates! **/ if( value) Tcl_SetHashValue( hentry, (char*) stringer(NULL,0, (char *)value,NULL)); else Tcl_SetHashValue( hentry, (char*) NULL); return( TCL_OK); } /** End of 'store_hash_value' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: clear_hash_value ** ** ** ** Description: Remove the specified shell variable from the passed ** ** hash table ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_HashTable *htable Hash table to be used** ** const char *key Attached key ** ** ** ** Result: int TCL_OK Successful completion ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ int clear_hash_value( Tcl_HashTable *htable, const char *key) { char *tmp; /** Temp pointer used for dealloc. **/ Tcl_HashEntry *hentry; /** Hash entry reference **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_clear_hash_value, NULL); #endif /** ** If I haven't already created an entry for keeping this environment ** variable's value, then just leave. ** Otherwise, remove this entry from the hash table. **/ if( hentry = Tcl_FindHashEntry( htable, (char*) key) ) { tmp = (char*) Tcl_GetHashValue( hentry); if( tmp) null_free((void *) &tmp); Tcl_DeleteHashEntry( hentry); } return( TCL_OK); } /** End of 'clear_hash_value' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Clear_Global_Hash_Tables ** ** ** ** Description: Deletes and reinitializes our env. hash tables. ** ** ** ** First Edition: 1992/10/14 ** ** ** ** Parameters: - ** ** Result: - ** ** ** ** Attached Globals: setenvHashTable, ** ** unsetenvHashTable, ** ** aliasSetHashTable, ** ** aliasUnsetHashTable ** ** ** ** ************************************************************************ ** ++++*/ static void Clear_Global_Hash_Tables( void) { Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/ char *val = NULL; /** Stored value (is a pointer!) **/ /** ** The following hash tables are to be initialized **/ Tcl_HashTable *table[5], **table_ptr = table; table[0] = setenvHashTable; table[1] = unsetenvHashTable; table[2] = aliasSetHashTable; table[3] = aliasUnsetHashTable; table[4] = NULL; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Clear_Global_Hash_Tables, NULL); #endif /** ** Loop for all the hash tables named above. If there's no value stored ** in a hash table, skip to the next one. **/ for( ; *table_ptr; table_ptr++) { if( ( hashEntry = Tcl_FirstHashEntry( *table_ptr, &searchPtr)) == NULL) continue; /** ** Otherwise remove all values stored in the table **/ do { val = (char*) Tcl_GetHashValue( hashEntry); if( val) null_free((void *) &val); } while( hashEntry = Tcl_NextHashEntry( &searchPtr)); /** ** Reinitialize the hash table by unlocking it from memory and ** thereafter initializing it again. **/ Tcl_DeleteHashTable( *table_ptr); Tcl_InitHashTable( *table_ptr, TCL_STRING_KEYS); } /** for **/ } /** End of 'Clear_Global_Hash_Tables' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Delete_Global_Hash_Tables ** ** Delete_Hash_Tables ** ** ** ** Description: Deletes our environment hash tables. ** ** ** ** First Edition: 1992/10/14 ** ** ** ** Parameters: Tcl_HashTable **table_ptr NULL-Terminated list ** ** of hash tables to be ** ** deleted ** ** Result: - ** ** ** ** Attached Globals: setenvHashTable, ** ** unsetenvHashTable, ** ** aliasSetHashTable, ** ** aliasUnsetHashTable ** ** ** ** ************************************************************************ ** ++++*/ void Delete_Global_Hash_Tables( void) { /** ** The following hash tables are to be initialized **/ Tcl_HashTable *table[5]; table[0] = setenvHashTable; table[1] = unsetenvHashTable; table[2] = aliasSetHashTable; table[3] = aliasUnsetHashTable; table[4] = NULL; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Delete_Global_Hash_Tables, NULL); #endif Delete_Hash_Tables( table); } /** End of 'Delete_Global_Hash_Tables' **/ void Delete_Hash_Tables( Tcl_HashTable **table_ptr) { Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/ char *val = NULL; /** Stored value (is a pointer!) **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Delete_Hash_Tables, NULL); #endif /** ** Loop for all the hash tables named above. Remove all values stored in ** the table and then free up the whole table **/ for( ; *table_ptr; table_ptr++) { if( ( hashEntry = Tcl_FirstHashEntry( *table_ptr, &searchPtr))) { /** ** Remove all values stored in the table **/ do { val = (char*) Tcl_GetHashValue( hashEntry); if( val) null_free((void *) &val); } while( hashEntry = Tcl_NextHashEntry( &searchPtr)); /** ** Remove internal hash control structures **/ Tcl_DeleteHashTable( *table_ptr); } null_free((void *) table_ptr); } /** for **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_END, LOC, _proc_Delete_Hash_Tables, NULL); #endif } /** End of 'Delete_Hash_Tables' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Copy_Hash_Tables ** ** ** ** Description: Allocate new hash tables for the global environment, ** ** initialize them and copy the contents of the current ** ** tables into them. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: - ** ** Result: Tcl_HashTable** Pointer to the new list of ** ** hash tables ** ** Attached Globals: setenvHashTable, ** ** unsetenvHashTable, ** ** aliasSetHashTable, ** ** aliasUnsetHashTable ** ** ** ** ************************************************************************ ** ++++*/ Tcl_HashTable **Copy_Hash_Tables( void) { Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ Tcl_HashEntry *oldHashEntry, /** Hash entries to be copied **/ *newHashEntry; char *val = NULL, /** Stored value (is a pointer!) **/ *key = NULL; /** Hash key **/ int new; /** Tcl inidicator, if the new hash **/ /** entry has been created or ref. **/ Tcl_HashTable *oldTable[5], **o_ptr, **n_ptr, **newTable; /** Destination hash table **/ oldTable[0] = setenvHashTable; oldTable[1] = unsetenvHashTable; oldTable[2] = aliasSetHashTable; oldTable[3] = aliasUnsetHashTable; oldTable[4] = NULL; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Copy_Hash_Tables, NULL); #endif /** ** Allocate storage for the new list of hash tables **/ if( !(newTable = (Tcl_HashTable**) module_malloc( sizeof( oldTable)))) if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) goto unwind0; /** ** Now copy each hashtable out of the list **/ for( o_ptr = oldTable, n_ptr = newTable; *o_ptr; o_ptr++, n_ptr++) { /** ** Allocate memory for a single hash table **/ if( !(*n_ptr = (Tcl_HashTable*) module_malloc( sizeof( Tcl_HashTable)))) if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) goto unwind1; /** ** Initialize that guy and copy it from the old table **/ Tcl_InitHashTable( *n_ptr, TCL_STRING_KEYS); if( oldHashEntry = Tcl_FirstHashEntry( *o_ptr, &searchPtr)) { /** ** Copy all entries if there are any **/ do { key = (char*) Tcl_GetHashKey( *o_ptr, oldHashEntry); val = (char*) Tcl_GetHashValue( oldHashEntry); newHashEntry = Tcl_CreateHashEntry( *n_ptr, key, &new); if(val) Tcl_SetHashValue(newHashEntry, stringer(NULL,0, val, NULL)); else Tcl_SetHashValue(newHashEntry, (char *) NULL); } while( oldHashEntry = Tcl_NextHashEntry( &searchPtr)); } /** if **/ } /** for **/ /** ** Put a terminator at the end of the new table **/ *n_ptr = NULL; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_END, LOC, _proc_Copy_Hash_Tables, NULL); #endif return( newTable); unwind1: null_free((void *) &newTable); unwind0: return( NULL); /** -------- EXIT (FAILURE) -------> **/ } /** End of 'Copy_Hash_Tables' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: ** ** ** ** Description: Once a the loading or unloading of a modulefile ** ** fails, any changes it has made to the environment ** ** must be undone and reset to its previous state. This ** ** function is responsible for unwinding any changes a ** ** modulefile has made. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp According TCL interp.** ** Tcl_HashTable **oldTables Hash tables storing ** ** the former environm. ** ** Result: ** ** Attached Globals: ** ** ** ** ************************************************************************ ** ++++*/ int Unwind_Modulefile_Changes( Tcl_Interp *interp, Tcl_HashTable **oldTables ) { Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/ char *val = NULL, /** Stored value (is a pointer!) **/ *key; /** Tcl hash key **/ int i; /** Loop counter **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Unwind_Modulefile_Changes, NULL); #endif if( oldTables) { /** ** Use only entries 0 and 1 which do contain all changes to the ** shell varibles (setenv and unsetenv) **/ /** ??? What about the aliases (table 2 and 3) ??? **/ for( i = 0; i < 2; i++) { if( hashEntry = Tcl_FirstHashEntry( oldTables[i], &searchPtr)) { do { key = (char*) Tcl_GetHashKey( oldTables[i], hashEntry); /** ** The hashEntry will contain the appropriate value for the ** specified 'key' because it will have been aquired depending ** upon whether the unset or set table was used. **/ val = (char*) Tcl_GetHashValue( hashEntry); if( val) EMSetEnv( interp, key, val); } while( hashEntry = Tcl_NextHashEntry( &searchPtr) ); } /** if **/ } /** for **/ /** ** Delete and reset the hash tables now that the current contents have been ** flushed. **/ Delete_Global_Hash_Tables(); setenvHashTable = oldTables[0]; unsetenvHashTable = oldTables[1]; aliasSetHashTable = oldTables[2]; aliasUnsetHashTable = oldTables[3]; } else { Clear_Global_Hash_Tables(); } return( TCL_OK); } /** End of 'Unwind_Modulefile_Changes' **/ static int keycmp(const void *a, const void *b) { return strcmp(*(const char **) a, *(const char **) b); } /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Output_Modulefile_Changes ** ** ** ** Description: Is used to flush out the changes of the current ** ** modulefile in a manner depending upon whether the ** ** modulefile was successful or unsuccessful. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp The attached Tcl in- ** ** terpreter ** ** ** ** Result: int TCL_OK Successful operation ** ** ** ** Attached Globals: setenvHashTable, ** ** unsetenvHashTable, ** ** aliasSetHashTable, via Output_Modulefile_Aliases** ** aliasUnsetHashTable via Output_Modulefile_Aliases** ** change_dir for the chdir command ** ** ** ** ************************************************************************ ** ++++*/ int Output_Modulefile_Changes( Tcl_Interp *interp) { Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/ char *val = NULL, /** Stored value (is a pointer!) **/ *key, /** Tcl hash key **/ **list; /** list of keys **/ int i,k; /** Loop counter **/ size_t hcnt; /** count of hash entries **/ /** ** The following hash tables do contain all changes to be made on ** shell variables **/ Tcl_HashTable *table[2]; table[0] = setenvHashTable; table[1] = unsetenvHashTable; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Changes, NULL); #endif aliasfile = stdout; /** ** Scan both tables that are of interest for shell variables **/ for(i = 0; i < 2; i++) { /* count hash */ hcnt = countTclHash(table[i]); /* allocate array for keys */ if( !(list = (char **) module_malloc(hcnt * sizeof(char *)))) { if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) return(TCL_ERROR);/** ------- EXIT (FAILURE) ------> **/ } /* collect keys */ k = 0; if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr)) do { key = (char*) Tcl_GetHashKey( table[i], hashEntry); list[k++] = stringer(NULL,0, key, NULL); } while( hashEntry = Tcl_NextHashEntry( &searchPtr)); /* sort hash */ if (hcnt > 1) qsort((void *) list, hcnt, sizeof(char *), keycmp); /* output key/values */ for (k = 0; k < hcnt; ++k) { key = list[k]; hashEntry = Tcl_FindHashEntry( table[i], key); /** ** The table list indicator is used in order to differ ** between the setenv and unsetenv operation **/ if( i == 1) { output_unset_variable( (char*) key); } else { val = EMGetEnv(interp, key); if(val) output_set_variable(interp, (char*) key, val); null_free((void *)&val); } } /** for **/ /* delloc list */ for (k = 0; k < hcnt; ++k) free(list[k]); free(list); } /** for **/ if( EOF == fflush( stdout)) if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ Output_Modulefile_Aliases( interp); Output_Directory_Change( interp); /** ** Delete and reset the hash tables since the current contents have been ** flushed. **/ Clear_Global_Hash_Tables(); return( TCL_OK); } /* End of 'Output_Modulefile_Changes' */ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Open_Aliasfile ** ** ** ** Description: Creates/opens or closes temporary file for sourcing ** ** or aliases. ** ** Passes back the filehandle and filename in global ** ** variables. ** ** ** ** First Edition: 2005/09/26 R.K.Owen ** ** ** ** Parameters: int action if != 0 to open else close ** ** ** ** Result: int TCL_OK Successful operation ** ** ** ** Attached Globals: aliasfile ** ** aliasfilename ** ** ** ** ************************************************************************ ** ++++*/ static int Open_Aliasfile(int action) { if (action) { /** ** Open the file ... **/ if( tmpfile_mod(&aliasfilename,&aliasfile)) if(OK != ErrorLogger( ERR_OPEN, LOC, aliasfilename, "append", NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } else { if( EOF == fclose( aliasfile)) if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfilename, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } return( TCL_OK); } /** End of 'Open_Aliasfile' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Output_Modulefile_Aliases ** ** ** ** Description: Is used to flush out the changes to the aliases of ** ** the current modulefile. But, some shells don't work ** ** well with having their alias information set via the ** ** 'eval' command. So, what we'll do now is output the ** ** aliases into a /tmp dotfile, have the shell source ** ** the /tmp dotfile and then have the shell remove the ** ** /tmp dotfile. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp The attached Tcl in- ** ** terpreter ** ** ** ** Result: int TCL_OK Successful operation ** ** ** ** Attached Globals: aliasSetHashTable, via Output_Modulefile_Aliases** ** aliasUnsetHashTable via Output_Modulefile_Aliases** ** ** ** ************************************************************************ ** ++++*/ static int Output_Modulefile_Aliases( Tcl_Interp *interp) { Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/ char *val = NULL, /** Stored value (is a pointer!) **/ *key; /** Tcl hash key **/ int i, /** Loop counter **/ openfile = 0; /** whether using a file or not **/ char *sourceCommand; /** Command used to source the alias **/ /** ** The following hash tables do contain all changes to be made on ** shell aliases **/ Tcl_HashTable *table[2]; table[0] = aliasSetHashTable; table[1] = aliasUnsetHashTable; /** ** If configured so, all changes to aliases are written into a temporary ** file which is sourced by the invoking shell ... ** In this case a temporary filename has to be assigned for the alias ** source file. The file has to be opened as 'aliasfile'. ** The default for aliasfile, if no shell sourcing is used, is stdout. **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Aliases, NULL); #endif /** ** We only need to output stuff into a temporary file if we're setting ** stuff. We can unset variables and aliases by just using eval. **/ if( hashEntry = Tcl_FirstHashEntry( aliasSetHashTable, &searchPtr)) { /** ** We must use an aliasfile if EVAL_ALIAS is not defined ** or the sh shell does not do aliases (HAS_BOURNE_ALIAS) ** and that the sh shell does do functions (HAS_BOURNE_FUNCS) **/ if (!eval_alias || (!strcmp(shell_name,"sh") && !bourne_alias && bourne_funcs)) { if (OK != Open_Aliasfile(1)) if(OK != ErrorLogger(ERR_OPEN,LOC,aliasfilename,"append",NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ openfile = 1; } /** ** We only support sh and csh variants for aliases. If not either ** sh or csh print warning message and return **/ assert(shell_derelict != NULL); if( !strcmp( shell_derelict, "csh")) { sourceCommand = "source %s%s"; } else if( !strcmp( shell_derelict, "sh")) { sourceCommand = ". %s%s"; } else { return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } if (openfile) { /** ** Only the source command has to be flushed to stdout. After ** sourcing the alias definition (temporary) file, the source ** file is to be removed. **/ alias_separator = '\n'; fprintf( stdout, sourceCommand, aliasfilename, shell_cmd_separator); fprintf( stdout, "/bin/rm -f %s%s", aliasfilename, shell_cmd_separator); } /** openfile **/ } /** if( alias to set) **/ /** ** Scan the hash tables involved in changing aliases **/ for( i=0; i<2; i++) { if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr)) { do { key = (char*) Tcl_GetHashKey( table[i], hashEntry); val = (char*) Tcl_GetHashValue( hashEntry); /** ** The hashtable list index is used to differ between aliases ** to be set and aliases to be reset **/ if(i == 1) { output_unset_alias( key, val); } else { output_set_alias( key, val); } } while( hashEntry = Tcl_NextHashEntry( &searchPtr)); } /** if **/ } /** for **/ if(openfile) { if( OK != Open_Aliasfile(0)) if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfilename, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ null_free((void *) &aliasfilename); } return( TCL_OK); } /** End of 'Output_Modulefile_Aliases' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Output_Directory_Change ** ** ** ** Description: Changes the current working directory. ** ** ** ** Parameters: Tcl_Interp *interp The attached Tcl interpreter ** ** ** ** Result: int TCL_OK Successful operation ** ** TCL_ERROR When not applicable ** ** ** ** Attached Global: change_dir ** ** ** ** ************************************************************************ ** ++++*/ static int Output_Directory_Change(Tcl_Interp *interp) { int rc = TCL_OK; if (change_dir == NULL) return rc; assert(shell_derelict != NULL); if(!strcmp(shell_derelict, "csh") || !strcmp(shell_derelict, "sh")) { fprintf(stdout, "cd '%s'%s", change_dir, shell_cmd_separator); } else if(!strcmp( shell_derelict, "perl")) { fprintf(stdout, "chdir '%s'%s", change_dir, shell_cmd_separator); } else if( !strcmp( shell_derelict, "python")) { fprintf(stdout, "os.chdir('%s')\n", change_dir); } else if( !strcmp( shell_derelict, "ruby")) { fprintf(stdout, "Dir.chdir('%s')\n", change_dir); } else { rc = TCL_ERROR; } free(change_dir); change_dir = NULL; return rc; } /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: output_set_variable ** ** ** ** Description: Outputs the command required to set a shell variable ** ** according to the current shell ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp The attached Tcl interpreter ** ** const char *var Name of the variable to be ** ** set ** ** const char *val Value to be assigned ** ** ** ** Result: int TCL_OK Finished successful ** ** TCL_ERROR Unknown shell type ** ** ** ** Attached Globals: shell_derelict ** ** ** ** ************************************************************************ ** ++++*/ static int output_set_variable( Tcl_Interp *interp, const char *var, const char *val) { /** ** Differ between the different kinds od shells at first ** ** CSH **/ chop( val); chop( var); assert(shell_derelict != NULL); #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_output_set_variable, " var='", var, "' val= '", val, "'", NULL); #endif if( !strcmp((char*) shell_derelict, "csh")) { #ifdef LMSPLIT_SIZE /** ** Many C Shells (specifically the Sun one) has a hard limit on ** the size of the environment variables around 1k. The ** _LMFILES_ variable can grow beyond 1000 characters. So, I'm ** going to break it up here since I can put it back together ** again when I use it. ** ** You can set the split size using --with-split-size= ** it should probably be <1000. I don't count the size of ** "setenv _LMFILES_xxx" so subtract this from your limit. **/ if( !strcmp( var, "_LMFILES_")) { char formatted[ MOD_BUFSIZE]; char *cptr = NULL; int lmfiles_len; int count = 0; char* escaped = stringer(NULL,strlen(val)*2+1,NULL); EscapeCshString(val,escaped); if(( lmfiles_len = strlen(escaped)) > LMSPLIT_SIZE) { char buffer[ LMSPLIT_SIZE + 1]; /** ** Break up the _LMFILES_ variable... **/ while( lmfiles_len > LMSPLIT_SIZE) { strncpy( buffer, ( escaped + count*LMSPLIT_SIZE ), LMSPLIT_SIZE); buffer[ LMSPLIT_SIZE] = '\0'; fprintf( stdout, "setenv %s%03d %s %s", var, count, buffer, shell_cmd_separator); lmfiles_len -= LMSPLIT_SIZE; count++; } if( lmfiles_len) { fprintf( stdout, "setenv %s%03d %s %s", var, count, (escaped + count*LMSPLIT_SIZE), shell_cmd_separator); count++; } /** ** Unset _LMFILES_ as indicator to use the multi-variable ** _LMFILES_ **/ fprintf(stdout, "unsetenv %s %s", var, shell_cmd_separator); } else { /** if ( lmfiles_len = strlen(val)) > LMSPLIT_SIZE) **/ fprintf(stdout, "setenv %s %s %s", var, escaped, shell_cmd_separator); } /** ** Unset the extra _LMFILES_%03d variables that may be set **/ do { if (cptr) null_free((void *) &cptr); sprintf( formatted, "_LMFILES_%03d", count++); cptr = EMGetEnv( interp, formatted); if(cptr && *cptr) { fprintf(stdout, "unsetenv %s %s", formatted, shell_cmd_separator); } } while( cptr && *cptr); null_free((void *) &cptr); null_free((void *) &escaped); } else { /** if( var == "_LMFILES_") **/ #endif /* not LMSPLIT_SIZE */ char* escaped = stringer(NULL,strlen(val)*2+1,NULL); EscapeCshString(val,escaped); fprintf(stdout, "setenv %s %s %s", var, escaped, shell_cmd_separator); null_free((void *) &escaped); #ifdef LMSPLIT_SIZE } #endif /* not LMSPLIT_SIZE */ /** ** SH **/ } else if( !strcmp((char*) shell_derelict, "sh")) { char* escaped = (char*)module_malloc(strlen(val)*2+1); EscapeShString(val,escaped); fprintf( stdout, "%s=%s %sexport %s%s", var, escaped, shell_cmd_separator, var, shell_cmd_separator); free(escaped); /** ** EMACS **/ } else if( !strcmp((char*) shell_derelict, "emacs")) { fprintf( stdout, "(setenv \"%s\" \'%s\')\n", var, val); /** ** PERL **/ } else if( !strcmp((char*) shell_derelict, "perl")) { char* escaped = stringer(NULL,strlen(val)*2+1,NULL); EscapePerlString(val,escaped); fprintf(stdout, "$ENV{'%s'} = '%s'%s", var, escaped, shell_cmd_separator); null_free((void *) &escaped); /** ** PYTHON **/ } else if( !strcmp((char*) shell_derelict, "python")) { fprintf( stdout, "os.environ['%s'] = '%s'\n", var, val); /** ** RUBY **/ } else if( !strcmp((char*) shell_derelict, "ruby")) { fprintf( stdout, "ENV['%s'] = '%s'\n", var, val); /** ** CMAKE **/ } else if( !strcmp((char*) shell_derelict, "cmake")) { char* escaped = stringer(NULL, strlen(val)*2+1,NULL); EscapeCmakeString(val,escaped); fprintf(stdout, "set(ENV{%s} \"%s\")%s", var, escaped, shell_cmd_separator); null_free((void *) &escaped); /** ** SCM **/ } else if ( !strcmp((char*) shell_derelict, "scm")) { fprintf( stdout, "(putenv \"%s=%s\")\n", var, val); /** ** MEL (Maya Extension Language) **/ } else if ( !strcmp((char*) shell_derelict, "mel")) { fprintf( stdout, "putenv \"%s\" \"%s\";", var, val); /** ** Unknown shell type - print an error message and ** return on error **/ } else { if( OK != ErrorLogger( ERR_DERELICT, LOC, shell_derelict, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Return and acknowldge success **/ g_output = 1; return( TCL_OK); } /** End of 'output_set_variable' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: output_unset_variable ** ** ** ** Description: Outputs the command required to unset a shell ** ** variable according to the current shell ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: const char *var Name of the variable to be ** ** unset ** ** ** ** Result: int TCL_OK Finished successful ** ** TCL_ERROR Unknown shell type ** ** ** ** Attached Globals: shell_derelict ** ** ** ** ************************************************************************ ** ++++*/ static int output_unset_variable( const char* var) { chop( var); assert(shell_derelict != NULL); #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_output_unset_variable, NULL); #endif /** ** Display the 'unsetenv' command according to the current invoking shell. **/ if( !strcmp( shell_derelict, "csh")) { fprintf( stdout, "unsetenv %s%s", var, shell_cmd_separator); } else if( !strcmp( shell_derelict, "sh")) { fprintf( stdout, "unset %s%s", var, shell_cmd_separator); } else if( !strcmp( shell_derelict, "emacs")) { fprintf( stdout, "(setenv \"%s\" nil)\n", var); } else if( !strcmp( shell_derelict, "perl")) { fprintf( stdout, "delete $ENV{'%s'}%s", var, shell_cmd_separator); } else if( !strcmp( shell_derelict, "cmake")) { fprintf( stdout, "unset(ENV{%s})%s", var, shell_cmd_separator); } else if( !strcmp( shell_derelict, "python")) { fprintf( stdout, "os.environ['%s'] = ''\ndel os.environ['%s']\n",var,var); } else if( !strcmp( shell_derelict, "ruby")) { fprintf( stdout, "ENV['%s'] = nil\n",var); } else if( !strcmp( shell_derelict, "scm")) { fprintf( stdout, "(putenv \"%s\")\n", var); } else if( !strcmp( shell_derelict, "mel")) { fprintf( stdout, "putenv \"%s\" \"\";", var); } else { if( OK != ErrorLogger( ERR_DERELICT, LOC, shell_derelict, NULL)) return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/ } /** ** Return and acknowldge success **/ g_output = 1; return( TCL_OK); } /** End of 'output_unset_variable' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: output_function ** ** ** ** Description: Actually turns the Modules set-alias information ** ** into a string that a shell can source. Previously, ** ** this routine just output the alias information to be ** ** eval'd by the shell. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: const char *var Name of the alias to be set ** ** const char *val Value to be assigned ** ** ** ** Result: - ** ** ** ** Attached Globals: aliasfile, The output file for alias commands. ** ** see 'Output_Modulefile_Aliases' ** ** alias_separator ** ** ** ** ************************************************************************ ** ++++*/ static void output_function( const char *var, const char *val) { const char *cptr = val; int nobackslash = 1; #if WITH_DEBUGGING_UTIL_2 ErrorLogger(NO_ERR_START, LOC, _proc_output_function, NULL); #endif /** ** This opens a function ... **/ fprintf(aliasfile, "%s() { ", var); /** ** ... now print the value. Print it as a single line and remove any ** backslashes, and substitute a safe $* **/ while (*cptr) { if (*cptr == '\\') { if (!nobackslash) putc(*cptr, aliasfile); else nobackslash = 0; cptr++; continue; } else if (*cptr == '$' && (cptr + 1) && (*(cptr + 1) == '*')) { /* found $* */ fputs("${1+\"$@\"}", aliasfile); cptr++; cptr++; continue; } else nobackslash = 1; putc(*cptr++, aliasfile); } /** while **/ /** ** Finally close the function **/ fprintf(aliasfile, "%c}%c", alias_separator, alias_separator); } /** End of 'output_function' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: output_set_alias ** ** ** ** Description: Flush the commands required to set shell aliases de- ** ** pending on the current invoking shell ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: const char *alias Name of the alias ** ** const char *val Value to be assigned ** ** ** ** Result: int TCL_OK Operation successful ** ** ** ** Attached Globals: aliasfile, The alias command is written out to ** ** alias_separator Defined the command separator ** ** shell_derelict to determine the shell family ** ** shell_name to determine the real shell type ** ** ** ** ************************************************************************ ** ++++*/ static int output_set_alias( const char *alias, const char *val) { int nobackslash = 1; /** Controls whether backslashes are **/ /** to be print **/ const char *cptr = val; /** Scan the value char by char **/ assert(shell_derelict != NULL); #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_output_set_alias, NULL); #endif /** ** Check for the shell family ** CSHs need to switch $* to \!* and $n to \!\!:n unless the $ has a ** backslash before it **/ if( !strcmp( shell_derelict, "csh")) { /** ** On CSHs the command is 'alias '. Print the beginning ** of the command and then print the value char by char. **/ fprintf( aliasfile, "alias %s '", alias); while( *cptr) { /** ** Convert $n to \!\!:n **/ if( *cptr == '$' && nobackslash) { cptr++; if( *cptr == '*') fprintf( aliasfile, "\\!"); else fprintf( aliasfile, "\\!\\!:"); } /** ** Recognize backslashes **/ if( *cptr == '\\') { if( !nobackslash) putc( *cptr, aliasfile); else nobackslash = 0; cptr++; continue; } else nobackslash = 1; /** ** print the read character **/ putc( *cptr++, aliasfile); } /** while **/ /** ** Now close up the command using the alias command terminator as ** defined in the global variable **/ fprintf( aliasfile, "'%c", alias_separator); /** ** Bourne shell family: The alias has to be translated into a ** function using the function call 'output_function' **/ } else if( !strcmp(shell_derelict, "sh")) { /** ** Shells supporting extended bourne shell syntax .... **/ if( (!strcmp( shell_name, "sh") && bourne_alias) || (!strcmp( shell_name, "bash") && is_interactive()) || !strcmp( shell_name, "zsh" ) || !strcmp( shell_name, "ksh")) { /** ** in this case we only have to write a function if the alias ** takes arguments. This is the case if the value has '$' ** somewhere in it without a '\' in front. **/ while( *cptr) { if( *cptr == '\\') { if( nobackslash) { nobackslash = 0; } } else { if( *cptr == '$') { if( nobackslash) { output_function( alias, val); return TCL_OK; } } nobackslash = 1; } cptr++; } /** ** So, we can just output an alias with '\$' translated to '$'... **/ fprintf( aliasfile, "alias %s='", alias); nobackslash = 1; cptr = val; while( *cptr) { if( *cptr == '\\') { if( nobackslash) { nobackslash = 0; cptr++; continue; } } nobackslash = 1; putc(*cptr++, aliasfile); } /** while **/ fprintf( aliasfile, "'%c", alias_separator); } else if( ((!strcmp( shell_name, "sh")) && bourne_funcs) || (!strcmp( shell_name, "bash") && !is_interactive())) { /** ** The bourne shell itself ** need to write a function unless this sh doesn't support ** functions (then just punt) **/ output_function(alias, val); } /** ??? Unknown derelict ??? **/ } /** if( sh ) **/ return( TCL_OK); } /** End of 'output_set_alias' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: output_unset_alias ** ** ** ** Description: Flush the commands required to reset shell aliases ** ** depending on the current invoking shell ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: const char *alias Name of the alias ** ** const char *val Value which has been ** ** assigned ** ** ** ** Result: int TCL_OK Operation successful ** ** ** ** Attached Globals: aliasfile, The alias command is writte out to ** ** alias_separator Defined the command separator ** ** shell_derelict to determine the shell family ** ** shell_name to determine the real shell type ** ** ** ** ************************************************************************ ** ++++*/ static int output_unset_alias( const char *alias, const char *val) { int nobackslash = 1; /** Controls wether backslashes are **/ /** to be print **/ const char *cptr = val; /** Need to read the value char by char **/ assert(shell_derelict != NULL); #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_output_unset_alias, NULL); #endif /** ** Check for the shell family at first ** Ahh! CSHs ... ;-) **/ if( !strcmp( shell_derelict, "csh")) { fprintf( aliasfile, "unalias %s%c", alias, alias_separator); /** ** Hmmm ... bourne shell types ;-( ** Need to unset a function in case of sh or if the alias took parameters **/ } else if( !strcmp( shell_derelict, "sh")) { if( (!strcmp( shell_name, "sh") && bourne_alias) || (!strcmp( shell_name, "bash") && is_interactive()) || !strcmp( shell_name, "zsh" ) || !strcmp( shell_name, "ksh")) { /** ** If we have what the old value should have been, then look to ** see if it was a function or an alias because bash spits out an ** error if you try to unalias a non-existent alias. **/ if(val) { /** ** Was it a function? ** Yes, if it has arguments... **/ while( *cptr) { if( *cptr == '\\') { if( nobackslash) { nobackslash = 0; } } else { if(*cptr == '$') { if( nobackslash) { fprintf(aliasfile, "unset -f %s%c", alias, alias_separator); return TCL_OK; } } nobackslash = 1; } cptr++; } /** ** Well, it wasn't a function, so we'll put out an unalias... **/ fprintf( aliasfile, "unalias %s%c", alias, alias_separator); } else { /** No value known (any more?) **/ /** We want to make sure to get remove the alias/function, ** but avoid generating commands which might throw an error! ** How exactly this can be done depends on the used shell **/ if( !strcmp( shell_name, "zsh")) { /** zsh has "-m" for pattern matching, which won't complain ** about non-existing functions/aliases **/ fprintf( aliasfile, "unset -fm %s%c", alias, alias_separator); fprintf( aliasfile, "unhash -am %s%c", alias, alias_separator); } else if( !strcmp( shell_name, "ksh")) { /** ksh doesn't complain about unsetting non-existing ** functions/aliases, so we can try both **/ fprintf( aliasfile, "unset -f %s%c", alias, alias_separator); fprintf( aliasfile, "unalias %s%c", alias, alias_separator); } else { /** bash will complain about unsetting a non-existing alias, ** so we just try to unset the function. ** "sh" can be any Bourne-compatible shell, and will on most ** systems be bash in POSIX-mode, so let's handle it the same **/ fprintf( aliasfile, "unset -f %s%c", alias, alias_separator); } } } else if( ((!strcmp( shell_name, "sh")) && bourne_funcs) || (!strcmp( shell_name, "bash") && !is_interactive())) { fprintf(aliasfile, "unset -f %s%c", alias, alias_separator); } /** if (shell supports aliases) **/ /** ??? Unknown derelict ??? **/ } /** if( sh-family) **/ return( TCL_OK); } /** End of 'output_unset_alias' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: getLMFILES ** ** ** ** Description: Read in the _LMFILES_ environment variable. This one ** ** may be split into several variables cause by limited ** ** variable space of some shells (esp. the SUN csh) ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp Attached Tcl interpreter ** ** ** ** Result: char* Value of the environment varibale _LMFILES_ ** ** ** ** Attached Globals: ** ** ** ** ************************************************************************ ** ++++*/ char *getLMFILES( Tcl_Interp *interp) { static char *lmfiles = NULL; /** Buffer pointer for the value **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_getLMFILES, NULL); #endif /** ** Try to read the variable _LMFILES_. If the according buffer pointer ** contains a value, disallocate it before. **/ if( lmfiles) null_free((void *) &lmfiles); lmfiles = EMGetEnv( interp, "_LMFILES_"); /** ** Now the pointer is NULL in case of the variable has not been defined. ** In this case try to read in the splitted variable from _LMFILES_xxx **/ if( !lmfiles || !*lmfiles) { char buffer[ MOD_BUFSIZE]; /** Used to set up the split variab- **/ /** les name **/ int count = 0; /** Split part count **/ int lmsize = 0; /** Total size of _LMFILES_ content **/ int old_lmsize; /** Size save buffer **/ int cptr_len; /** Size of the current split part **/ char *cptr; /** Split part read pointer **/ /** ** Set up the split part environment variable name and try to read it ** in **/ sprintf( buffer, "_LMFILES_%03d", count++); cptr = EMGetEnv( interp, buffer); while(cptr && *cptr) { /** Something available **/ /** ** Count up the variables length **/ cptr_len = strlen( cptr); old_lmsize = lmsize; lmsize += cptr_len; /** ** Reallocate the value's buffer and copy the current split ** part at its end **/ if(!(lmfiles = (char*) module_realloc( lmfiles, lmsize * sizeof(char) + 1))) { if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) return( NULL); /** ---- EXIT (FAILURE) ---> **/ } strncpy( lmfiles + old_lmsize, cptr, cptr_len); *(lmfiles + old_lmsize + cptr_len) = '\0'; /** ** Read the next split part variable **/ sprintf( buffer, "_LMFILES_%03d", count++); cptr = EMGetEnv( interp,buffer); } } else { /** if( lmfiles) **/ /** ** If the environvariable _LMFILES_ has been set, copy the contents ** of the returned buffer into a free allocated one in order to ** avoid side effects. **/ char *tmp = stringer(NULL,0, lmfiles, NULL); if( !tmp) if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) return( NULL); /** -------- EXIT (FAILURE) -------> **/ /** ** Set up lmfiles pointing to the new buffer in order to be able to ** disallocate when invoked next time. **/ lmfiles = tmp; } /** if( lmfiles) **/ /** ** Return the received value to the caller **/ return( lmfiles); } /** end of 'getLMFILES' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: IsLoaded ** ** ** ** Description: Check whether the passed modulefile is currently ** ** loaded ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp According Tcl interp.** ** char *modulename Name of the module to** ** be searched for ** ** char **realname Buffer for the name ** ** and version of the ** ** module that has mat- ** ** ched the query ** ** char *filename Buffer to store the ** ** whole filename of a ** ** found loaded module ** ** ** ** Result: int 0 Requested module not loaded ** ** 1 module is loaded ** ** ** ** realname points to the name of the module that** ** has matched the query. If this poin- ** ** differs form 'modulename' after this ** ** function has finished, the buffer for** ** to store the module name in has been ** ** allocated here. ** ** if (char **) NULL is passed, no buf- ** ** fer will be allocated ** ** ??? Is this freed correctly by the caller ???** ** ** ** filename will be filled with the full module ** ** file path of the module that has ** ** matched the query ** ** ** ** Attached Globals: ** ** ** ** ************************************************************************ ** ++++*/ /** ** Check all possibilities of module-versions **/ int IsLoaded( Tcl_Interp *interp, char *modulename, char **realname, char *filename ) { return( __IsLoaded( interp, modulename, realname, filename, 0)); } /** ** Check only an exact match of the passed module and version **/ int IsLoaded_ExactMatch( Tcl_Interp *interp, char *modulename, char **realname, char *filename ) { return( __IsLoaded( interp, modulename, realname, filename, 1)); } /** ** The subroutine __IsLoaded finally checks for the requested module being ** loaded or not. **/ static int __IsLoaded( Tcl_Interp *interp, char *modulename, char **realname, char *filename, int exact) { char *l_modules = NULL; /** Internal module list buffer **/ char *l_modulefiles = NULL; /** Internal module file list buffer **/ char *loaded = NULL; /** Buffer for the module **/ char *basename = NULL; /** Pointer to module basename **/ char *loadedmodule_path = NULL; /** Pointer to one loaded module out **/ /** of the loaded modules list **/ int count = 0; /** ** Get a list of loaded modules (environment variable 'LOADEDMODULES') ** and the list of loaded module-files (env. var. __LMFILES__) **/ char *loaded_modules = EMGetEnv( interp, "LOADEDMODULES"); char *loaded_modulefiles = getLMFILES( interp); #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc___IsLoaded, NULL); #endif /** ** If no module is currently loaded ... the requested module is surely ** not loaded, too ;-) **/ if( !loaded_modules || !*loaded_modules) { goto unwind0; } /** ** Copy the list of currently loaded modules into a new allocated array ** for further handling. If this fails it will be assumed, that the ** module is *NOT* loaded. **/ if((char *) NULL == (l_modules = stringer(NULL,0,loaded_modules,NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind0; /** ** Copy the list of currently loaded modulefiles into a new allocated ** array for further handling. If this failes it will be assumed, that ** the module is *NOT* loaded. **/ if(loaded_modulefiles) if((char *) NULL == (l_modulefiles = stringer(NULL,0, loaded_modulefiles,NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind1; /** ** Assume the modulename given was an exact match so there is no ** difference to return -- this will change in the case it wasn't an ** exact match below **/ if( realname) *realname = modulename; if( *l_modules) { /** ** Get each single module which is loaded by splitting up at colons ** The variable LOADEDMODULES contains a list of modulefile like the ** following: ** gnu/2.0:openwin/3.0 **/ loadedmodule_path = xstrtok( l_modules, ":"); while( loadedmodule_path) { if((char *) NULL == (loaded = stringer(NULL,0, loadedmodule_path,NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind2; /** ** Get a modulefile without a version and check if this is the ** requested one. **/ if( !strcmp( loaded, modulename)) { /** FOUND **/ null_free ((void *) &loaded); break; /** leave the while loop **/ } else if( !exact) { /** NOT FOUND **/ /** ** Try to more and more simplify the modulename by removing ** all detail (version) information **/ basename = get_module_basename( loaded); while( basename && strcmp( basename, modulename)) { basename = get_module_basename( basename); } /** ** Something left after splitting again? If yes the requested ** module is found! ** Since the name given was a basename, return the fully ** loaded path **/ if( basename) { null_free ((void *) &loaded); if( realname) if((char *) NULL == (*realname = stringer(NULL,0, loadedmodule_path,NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) goto unwind2; break; /** leave the while loop **/ } /** if( basename) **/ } /** if not found with single basename **/ /** ** Get the next entry from the loaded modules list **/ loadedmodule_path = xstrtok( NULL, ":"); count++; null_free ((void *) &loaded); /** Free what has been alloc. **/ } /** while **/ } /** if( *l_modules) **/ /** ** If we found something locate it's associated modulefile **/ if( loadedmodule_path) { if( filename && l_modulefiles && *l_modulefiles) { /** ** The position of the loaded module within the list of loaded ** modules has been counted in 'count'. The position of the ** associated modulefile should be the same. So tokenize the ** list of modulefiles by the colon until the wanted position ** is reached. **/ char* modulefile_path = xstrtok(l_modulefiles, ":"); while( count) { if( !( modulefile_path = xstrtok( NULL, ":"))) { /** ** Oops! Fewer entries in the list of loaded modulefiles ** than in the list of loaded modules. This will ** generally suggest that _LMFILES_ has become corrupted, ** but it may just mean we're working intermittantly with ** an old version. So, I'll just not touch filename which ** means the search will continue using the old method of ** looking through MODULEPATH. */ goto success0; } count--; } /** while **/ /** ** Copy the result into the buffer passed from the caller **/ strcpy( filename, modulefile_path); } /** ** FOUND. ** free up everything which has been allocated and return on success **/ goto success0; } /** ** NOT FOUND. Free up everything which has been alloc'd and return on ** failure **/ unwind2: if( l_modulefiles) null_free((void *) &l_modulefiles); unwind1: null_free((void *) &l_modules); unwind0: null_free((void *)&loaded_modules); return( 0); /** -------- EXIT (FAILURE) -------> **/ success0: if( l_modulefiles) null_free((void *) &l_modulefiles); null_free((void *) &l_modules); return( 1); /** -------- EXIT (SUCCESS) -------> **/ } /** End of '__IsLoaded' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: chk_marked_entry, set_marked_entry ** ** ** ** Description: When switching, the variables are marked with a mar- ** ** ker that is tested to see if the variable was changed** ** in the second modulefile. If it was not, then the ** ** variable is unset. ** ** ** ** First Edition: 1992/10/25 ** ** ** ** Parameters: Tcl_HashTable *table Attached hash table ** ** char *var According variable name ** ** int val Value to be set. ** ** ** ** Result: int 0 Mark not set (or the value of the ** ** mark was 0 ;-) ** ** else Value of the mark that has been set ** ** with set_marked_entry. ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ intptr_t chk_marked_entry( Tcl_HashTable *table, char *var) { Tcl_HashEntry *hentry; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_chk_marked_entry, NULL); #endif if( hentry = Tcl_FindHashEntry( table, var)) return((intptr_t) Tcl_GetHashValue( hentry)); else return 0; } void set_marked_entry( Tcl_HashTable *table, char *var, intptr_t val) { Tcl_HashEntry *hentry; int new; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_set_marked_entry, NULL); #endif if( (hentry = Tcl_CreateHashEntry( table, var, &new))) { if( val) Tcl_SetHashValue( hentry, val); } /** ??? Shouldn't there be an error return in case of hash creation failing ??? **/ } /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: get_module_basename ** ** ** ** Description: Get the name of a module without its version. ** ** This function modifies the string passed in. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: char *modulename Full module name ** ** ** ** Result: char* Module name without version ** ** ** ** Attached Globals: ** ** ** ** ************************************************************************ ** ++++*/ static char *get_module_basename( char *modulename) { char *version; /** Used to locate the version sep. **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_get_module_basename, NULL); #endif /** ** Use strrchr to locate the very last version string on the module ** name. **/ if((version = strrchr( modulename, '/'))) { *version = '\0'; } else { modulename = NULL; } /** ** Return the *COPIED* string **/ return( modulename); } /** End of 'get_module_basename' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: Update_LoadedList ** ** ** ** Description: Add or remove the passed modulename and filename to/ ** ** from LOADEDMODULES and _LMFILES_ ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: Tcl_Interp *interp Attached Tcl Interp. ** ** char *modulename Name of the module ** ** char *filename Full path name of the** ** related modulefile ** ** ** ** Result: int 1 Successful operation ** ** ** ** Attached Globals: g_flags Controls whether the modulename ** ** should be added (M_XXXX) or removed ** ** (M_REMOVE) from the list of loaded ** ** modules ** ** ** ** ************************************************************************ ** ++++*/ int Update_LoadedList( Tcl_Interp *interp, char *modulename, char *filename) { char *argv[4]; char *basename; char *module; #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_Update_LoadedList, NULL); #endif /** ** Apply changes to LOADEDMODULES first **/ argv[1] = "LOADEDMODULES"; argv[2] = modulename; argv[3] = NULL; if(g_flags & M_REMOVE) { argv[0] = "remove-path"; cmdRemovePath( 0, interp, 3, (CONST84 char **) argv); } else { argv[0] = "append-path"; cmdSetPath( 0, interp, 3, (CONST84 char **) argv); } /** ** Apply changes to _LMFILES_ now **/ argv[1] = "_LMFILES_"; argv[2] = filename; argv[3] = NULL; if(g_flags & M_REMOVE) { argv[0] = "remove-path"; cmdRemovePath( 0, interp, 3, (CONST84 char **) argv); } else { argv[0] = "append-path"; cmdSetPath( 0, interp, 3, (CONST84 char **) argv); } /** ** A module with just the basename might have been added and now we're ** removing one of its versions. We'll want to look for the basename in ** the path too. **/ if( g_flags & M_REMOVE) { module = stringer(NULL,0, modulename, NULL); basename = module; if( basename = get_module_basename( basename)) { argv[2] = basename; argv[0] = "remove-path"; cmdRemovePath( 0, interp, 3, (CONST84 char **) argv); } null_free((void *) &module); } /** ** Return on success **/ return( 1); } /** End of 'Update_LoadedList' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: check_magic ** ** ** ** Description: Check the magic cookie of the file passed as para- ** ** meter if it is a valid module file ** ** Based on check_magic in Richard Elling's ** ** find_by_magic ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: char *filename Name of the file to check ** ** char *magic_name Magic cookie ** ** int magic_len Length of the magic cookie ** ** ** ** Result: int 0 Magic cookie doesn't match or any ** ** I/O error ** ** 1 Success - Magic cookie has matched ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ int check_magic( char *filename, char *magic_name, int magic_len) { int fd; /** File descriptor for reading in **/ int read_len; /** Number of bytes read **/ char buf[BUFSIZ]; /** Read buffer **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_check_magic, NULL); #endif /** ** Parameter check. The length of the magic cookie shouldn't exceed the ** length of out read buffer **/ if( magic_len > BUFSIZ) return 0; /** ** Open the file and read in as many bytes as required for checking the ** magic cookie. If there's an I/O error (Unable to open the file or ** less than magic_len have been read) return on failure. **/ if( 0 > (fd = open( filename, O_RDONLY))) if( OK != ErrorLogger( ERR_OPEN, LOC, filename, "reading", NULL)) return( 0); /** -------- EXIT (FAILURE) -------> **/ read_len = read( fd, buf, magic_len); if( 0 > close(fd)) if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL)) return( 0); /** -------- EXIT (FAILURE) -------> **/ if( read_len < magic_len) return( 0); /** ** Check the magic cookie now **/ return( !strncmp( buf, magic_name, magic_len)); } /** end of 'check_magic' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: regex_quote ** ** ** ** Description: Copy the passed path into the new path buffer and ** ** devalue '.' and '+' ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: const char *path Original path ** ** char *newpath Buffer for to copy the new ** ** path in ** ** int len Max length of the new path ** ** ** ** Result: newpath will be filled up with the new, de- ** ** valuated path ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ void regex_quote( const char *path, char *newpath, int len) { unsigned int path_len = strlen( path); /** Length of the orig. path **/ int i, /** Read index **/ j; /** Write index **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_cleanse_path, NULL); #endif /** ** Stopping at (len - 1) ensures that the newpath string can be ** null-terminated below. **/ for( i=0, j=0; i **/ return( new); /** -------- EXIT (SUCCESS) -------> **/ } #endif /* HAVE_STRDUP */ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: xstrtok_r,xstrtok ** ** ** ** Description: Considers the string s to consist of a sequence of ** ** zero or more text tokens separated by spans of one ** ** or more characters from the separator string delim. ** ** Just like the "standard" strtok(3), and the ** reentrant version strtok_r(3). ** ** Except this tokenizer will return "empty" tokens too.** ** Providing our own strtok() eliminates the various ** ** nuances of different implementations. ** ** ** ** First Edition: 2006/04/17 R.K.Owen ** ** ** ** Parameters: ** ** Result: ** ** Attached Globals: ** ** ** ** ************************************************************************ ** ++++*/ char *xstrtok_r(char *s, const char *delim, char **ptrptr) { register char *ptr, *lptr; register int c,sc; const char *tok; /* return NULL if NULL string and at end of the line */ if (s == NULL && *ptrptr == NULL) return (NULL); /* do not skip leading (or trailing) delimiters ... */ /* if non-NULL string then at beginning of token parsing */ if (s != NULL) *ptrptr = s; ptr = *ptrptr; while (ptr && *ptr) { /* cycle through delimiters */ tok = delim; while (tok && *tok) { if (*ptr == *tok) { /* match */ *ptr = '\0'; /* null terminate */ lptr = *ptrptr; *ptrptr = ++ptr; /* set for next time */ return lptr; } tok++; } ptr++; } /* didn't find delimiter */ lptr = *ptrptr; *ptrptr = NULL; return lptr; } /** End of 'xstrtok_r' **/ char *xstrtok(char *s, const char *delim) { static char *last; return xstrtok_r(s,delim,&last); } /** End of 'xstrtok' **/ #if 0 void tryxstrtok (char *string, char *delim) { char *start, *str; char *token; int n = 1; start = str = strdup(string); printf("string: %s\n", str); printf("delim : %s\n", delim); token = xstrtok(str,delim); printf("\t%d = %s\n", n, token); while (token = xstrtok(NULL, delim)) { printf("\t%d = %s\n", ++n, token); } free(start); } int main () { tryxstrtok("abc:def;ghi,jkl", ":;,"); tryxstrtok(":abc:def;ghi,jkl", ":;,"); tryxstrtok("::abc:def;ghi,jkl", ":;,"); tryxstrtok("abc:def;ghi,jkl:", ":;,"); tryxstrtok("abc:def;ghi,jkl::", ":;,"); tryxstrtok("abc", ":;,"); tryxstrtok("", ":;,"); } #endif /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: chk4spch ** ** ** ** Description: goes through the given string and changes any non- ** ** printable characters to question marks. ** ** ** ** First Edition: 1991/10/23 ** ** ** ** Parameters: char *s String to be checke ** ** ** ** Result: *s Will be changed accordingly ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ void chk4spch(char* s) { for( ; *s; s++) if( !isgraph( *s)) *s = '?'; } /** End of 'chk4spch' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: module_malloc ** ** module_realloc ** ** ** ** Description: A wrapper for the system malloc(),realloc() function ** ** so the argument can be tested and set to a positive ** ** value. ** ** ** ** First Edition: 2007/02/14 R.K.Owen ** ** ** ** Parameters: size_t size Number of bytes to allocate ** ** ** ** Result: void * An allocated memory pointer ** ** ** ** ************************************************************************ ** ++++*/ void *module_malloc(size_t size) { void *ret; if (size == 0) size = 1; #ifdef TCL_MEM_DEBUG ret = ckalloc(size); #else ret = malloc(size); #endif ret = memset(ret,'\0',size); return ret; } /** End of 'module_malloc' **/ void *module_realloc(void * ptr, size_t size) { void *ret; #ifdef TCL_MEM_DEBUG ret = ckrealloc(ptr, size); #else ret = realloc(ptr, size); #endif return ret; } /** End of 'module_realloc' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: xdup ** ** ** ** Description: will return a string with 1 level of environment ** ** variables expanded. The limit is MOD_BUFSIZE. ** ** An env.var. is denoted with either $name or ${name} ** ** \$ escapes the expansion and substitutes a '$' in ** ** its place. ** ** ** ** First Edition: 2000/01/21 R.K.Owen ** ** ** ** Parameters: char *string Environment variable ** ** ** ** Result: char * An allocated string ** ** ** ** ************************************************************************ ** ++++*/ char *xdup(char const *string) { char *result = NULL; char *dollarptr; if (string == (char *)NULL) return result; /** need to work from copy of string **/ if (((char *) NULL) == (result = stringer(NULL,0, string, NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) return( (char*) NULL); /** -------- EXIT (FAILURE) -------> **/ /** check for '$' else just pass strdup of it **/ if ((dollarptr = strchr(result, '$')) == (char *) NULL) { return result; } else { /** found something **/ char const *envvar; char buffer[MOD_BUFSIZE]; char oldbuffer[MOD_BUFSIZE]; size_t blen = 0; /** running buffer length **/ char *slashptr = result;/** where to continue parsing **/ char slashchr; /** store slash char **/ int brace; /** flag if ${name} **/ pid_t pid; /** the process id **/ /** zero out buffers */ memset( buffer, '\0', MOD_BUFSIZE); memset(oldbuffer, '\0', MOD_BUFSIZE); /** copy everything upto $ into old buffer **/ *dollarptr = '\0'; strncpy(oldbuffer, slashptr, MOD_BUFSIZE-1); *dollarptr = '$'; while (dollarptr) { if (*oldbuffer) strncpy(buffer, oldbuffer, MOD_BUFSIZE); blen = strlen(buffer); brace = 0; /** get the env.var. name **/ if (*(dollarptr + 1) == '{') { brace = 1; slashptr = strchr(dollarptr + 1, '}'); } else if (*(dollarptr + 1) == '$') { slashptr = dollarptr + 2; } else { slashptr = dollarptr + 1 + strcspn(dollarptr + 1,"/:$\\"); brace = 0; } if (*slashptr) { slashchr = *slashptr; *slashptr = '\0'; } else slashptr = (char *)NULL; /** see if escaped **/ if ((result != dollarptr) && *(dollarptr - 1) == '\\') { /** replace \ with 0 and copy rest of name **/ buffer[blen - 1] = '\0'; strncat(buffer, dollarptr, MOD_BUFSIZE-blen); blen = strlen(buffer); if(brace) strncat(buffer,"}",MOD_BUFSIZE-blen-1); } else { if (! strcmp(dollarptr + 1 + brace, "$")) { /** put in the process pid **/ pid = getpid(); snprintf(buffer + blen,MOD_BUFSIZE-blen,"%ld",(long)pid); } else { /** get env.var. value **/ envvar = getenv(dollarptr + 1 + brace); /** cat value to rest of string **/ if (envvar) strncat(buffer,envvar, MOD_BUFSIZE-blen-1); } } blen = strlen(buffer); /** start at slashptr and find next $ **/ if (slashptr) { *slashptr = slashchr; dollarptr = strchr(slashptr, '$'); /** copy everything upto $ **/ if (dollarptr) *dollarptr = '\0'; strncat(buffer, slashptr + brace, MOD_BUFSIZE -blen -1); if (dollarptr) { *dollarptr = '$'; strncpy(oldbuffer, buffer, MOD_BUFSIZE); } } else { /** no more to show **/ dollarptr = (char *)NULL; } } null_free((void *) &result); return stringer(NULL,0, buffer, NULL); } } /** End of 'xdup' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: xgetenv ** ** ** ** Description: will return an expanded environment variable. ** ** However, it will only expand 1 level. ** ** See xdup() for details. ** ** ** ** First Edition: 2000/01/18 R.K.Owen ** ** ** ** Parameters: char *var Environment variable ** ** ** ** Result: char * An allocated string ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ char *xgetenv(char const * var) { char *result = NULL; if (var == (char *)NULL) return result; return xdup(getenv(var)); } /** End of 'xgetenv' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: EscapeCshString(char* in,char* out) ** ** ** ** Description: will translate input string to escaped output string ** ** out must be allocated first ** ** ** ** First Edition: 2002/04/10 ** ** ** ** Parameters: char *in input ** ** char *out output ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ void EscapeCshString(const char* in, char* out) { for(;*in;in++) { if (*in == ' ' || *in == '\t'|| *in == '\\'|| *in == '{' || *in == '}' || *in == '|' || *in == '<' || *in == '>' || *in == '!' || *in == ';' || *in == '#' || *in == '$' || *in == '^' || *in == '&' || *in == '*' || *in == '\''|| *in == '"' || *in == '(' || *in == ')') { *out++ = '\\'; } *out++ = *in; } *out = 0; } void EscapeShString(const char* in, char* out) { for(;*in;in++) { if (*in == ' ' || *in == '\t'|| *in == '\\'|| *in == '{' || *in == '}' || *in == '|' || *in == '<' || *in == '>' || *in == '!' || *in == ';' || *in == '#' || *in == '$' || *in == '^' || *in == '&' || *in == '*' || *in == '\''|| *in == '"' || *in == '(' || *in == ')') { *out++ = '\\'; } *out++ = *in; } *out = 0; } void EscapePerlString(const char* in, char* out) { for(;*in;in++) { if (*in == '\\'|| *in == ';' || *in == '\'') { *out++ = '\\'; } *out++ = *in; } *out = 0; } /* I think this needs a bunch of work --NJW */ void EscapeCmakeString(const char* in, char* out) { for(;*in;in++) { if (*in == '\\'|| *in == '"') { *out++ = '\\'; } *out++ = *in; } *out = 0; } /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: tmpfile_mod ** ** ** ** Description: emulates tempnam and tmpnam and mktemp ** ** Atomically creates a unique temp file and opens it ** ** for writing. returns 0 on success, 1 on failure ** ** Filename and file handle are returned through ** ** argument pointers ** ** ** ** First Edition: 2002/04/22 ** ** ** ** Parameters: char **filename pointer to char* ** ** char **file pointer to FILE* ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ int tmpfile_mod(char** filename, FILE** file) { char* filename2; FILE* f = NULL; int trial = 0; if ((char *) NULL == (filename2 = stringer(NULL, strlen(TMP_DIR)+strlen("modulesource")+20, NULL))) if( OK != ErrorLogger( ERR_STRING, LOC, NULL)) return 1; do { int fildes; sprintf(filename2,"%s/modulesource_%d",TMP_DIR,trial++); fildes = open(filename2,O_WRONLY | O_CREAT | O_EXCL | O_TRUNC,0755); #if 0 fprintf(stderr,"DEBUG: filename=%s fildes=%d\n", filename2,fildes); #endif if (fildes >=0) { *file = fdopen(fildes,"w"); *filename = filename2; return 0; } } while (trial < 1000); null_free((void *) &filename2); fprintf(stderr, "FATAL: could not get a temp file! at %s(%d)",__FILE__,__LINE__); return 1; } /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: stringer ** ** ** ** Description: Safely copies and concats series of strings ** ** until it hits a NULL argument. ** ** Either a buffer & length are given or if the buffer ** ** pointer is NULL then it will allocate memory to the ** ** given length. If the length is 0 then get the length ** ** from the series of strings. ** ** The resultant buffer is returned unless there ** ** is an error then NULL is returned. ** ** (Therefore, one of the main uses of stringer is to ** ** allocate string memory.) ** ** ** ** ** ** First Edition: 2001/08/08 R.K.Owen ** ** ** ** Parameters: char *buffer string buffer (if not NULL) ** ** int len maximum length of buffer ** ** const char *str1 1st string to copy to buffer ** ** const char *str2 2nd string to cat to buffer ** ** ... ** ** const char *strN Nth string to cat to buffer ** ** const char *NULL end of arguments ** ** ** ** Result: char *buffer if successful completion ** ** else NULL ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ char *stringer( char * buffer, int len, ... ) { va_list argptr; /** stdarg argument ptr **/ char *ptr; /** argument string ptr **/ char *tbuf = buffer; /** tempory buffer ptr **/ int sumlen = 0; /** length of all the concat strings **/ char *(*strfn)(char*,const char*) = strcpy; /** ptr to 1st string function **/ #if WITH_DEBUGGING_UTIL_2 ErrorLogger( NO_ERR_START, LOC, _proc_stringer, NULL); #endif /* get start of optional arguments and sum string lengths */ va_start(argptr, len); while ((ptr = va_arg(argptr, char *))) { sumlen += strlen(ptr); } va_end(argptr); /* can we even proceed? */ if (tbuf && (sumlen >= len || len < 0)) { return (char *) NULL; } /* do we need to allocate memory? */ if (tbuf == (char *) NULL) { if (len == 0) { len = sumlen + 1; } if ((char *) NULL == (tbuf = (char*) module_malloc(len))) { if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL)) return (char *) NULL; } } /* concat all the strings to buffer */ va_start(argptr, len); while ((ptr = va_arg(argptr, char *))) { strfn(tbuf, ptr); strfn = strcat; } va_end(argptr); /* got here successfully - return buffer */ return tbuf; } /** End of 'stringer' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: null_free ** ** ** ** Description: does a free and then nulls the pointer. ** ** ** ** first edition: 2000/08/24 r.k.owen ** ** ** ** parameters: void **var allocated memory ** ** ** ** result: void (nothing) ** ** ** ** attached globals: - ** ** ** ** ************************************************************************ ** ++++*/ void null_free(void ** var) { if (! *var) return; /* passed in a NULL ptr */ #ifdef USE_FREE # ifdef TCL_MEM_DEBUG ckfree( *var); # else free( *var); # endif #endif *var = NULL; } /** End of 'null_free' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: countTclHash ** ** ** ** Description: returns the number of hash entries in a TclHash ** ** ** ** first edition: 2005/09/01 R.K.Owen ** ** ** ** Parameters: Tcl_HashTable *table Hash to count ** ** ** ** Result: size_t Count of Hash Entries ** ** ** ** Attached Globals: - ** ** ** ** ************************************************************************ ** ++++*/ size_t countTclHash(Tcl_HashTable *table) { size_t result = 0; Tcl_HashSearch searchPtr; /** Tcl hash search handle **/ if(Tcl_FirstHashEntry(table, &searchPtr)) { do { result++; } while(Tcl_NextHashEntry( &searchPtr)); } /** if **/ return result; } /** End of 'countHashTable' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: ReturnValue ** ** ** ** Description: Handles the various possible return values ** ** ** ** first edition: 2006/02/13 R.K.Owen ** ** ** ** Parameters: Tcl_Interp *interp Attached Tcl Interp. ** ** int retval Return value to check** ** ** ** Result: EM_RetVal Limited set ** ** ** ** Attached Globals: g_retval set to N if "exit N" ** ** ** ** ************************************************************************ ** ++++*/ EM_RetVal ReturnValue(Tcl_Interp *interp, int retval) { EM_RetVal em_result; char *startp = (char *) NULL, *endp = (char *) NULL; const char *tstr; int result; static char *Exit_ = "^EXIT ([0-9]*)", *Break = ".*\"break\".*", *Cont = ".*\"continue\".*"; static Tcl_Obj *exit_Ptr = (Tcl_Obj *) NULL, *break_Ptr = (Tcl_Obj *) NULL, *cont_Ptr = (Tcl_Obj *) NULL; static Tcl_RegExp exit__expPtr = (Tcl_RegExp) NULL, break_expPtr = (Tcl_RegExp) NULL, cont_expPtr = (Tcl_RegExp) NULL; tstr = (const char *) TCL_RESULT(interp); /* compile regular expression the first time through */ if (!exit_Ptr) exit_Ptr = Tcl_NewStringObj(Exit_,strlen(Exit_)); if (!exit__expPtr) exit__expPtr = Tcl_GetRegExpFromObj(interp, exit_Ptr,TCL_REG_ADVANCED); /* result = "invoked \"break\" outside of a loop" */ if (!break_Ptr) break_Ptr = Tcl_NewStringObj(Break,strlen(Break)); if (!break_expPtr) break_expPtr = Tcl_GetRegExpFromObj(interp, break_Ptr,TCL_REG_ADVANCED); /* result = "invoked \"continue\" outside of a loop" */ if (!cont_Ptr) cont_Ptr = Tcl_NewStringObj(Cont,strlen(Cont)); if (!cont_expPtr) cont_expPtr = Tcl_GetRegExpFromObj(interp, cont_Ptr,TCL_REG_ADVANCED); /* intercept any "EXIT N" first */ if(tstr && *tstr && 0 < Tcl_RegExpExec(interp, exit__expPtr, (CONST84 char *) tstr, (CONST84 char *) tstr)){ /* found 'EXIT' */ Tcl_RegExpRange(exit__expPtr, 1, (CONST84 char **) &startp, (CONST84 char **) &endp); if( startp && *startp != '\0') result = atoi((const char *) startp); else result = 0; g_retval = result; em_result = EM_EXIT; /* check for a break not within loop */ } else if(tstr && *tstr && 0 < Tcl_RegExpExec(interp, break_expPtr, (CONST84 char *) tstr, (CONST84 char *) tstr)){ em_result = EM_BREAK; /* check for a continue not within loop */ } else if(tstr && *tstr && 0 < Tcl_RegExpExec(interp, cont_expPtr, (CONST84 char *) tstr, (CONST84 char *) tstr)){ em_result = EM_CONTINUE; } else { switch (retval) { case TCL_OK: em_result = EM_OK; break; case TCL_BREAK: em_result = EM_BREAK; break; case TCL_CONTINUE: em_result = EM_CONTINUE; break; case TCL_ERROR: default: em_result = EM_ERROR; break; } } return em_result; } /** End of 'ReturnValue' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: OutputExit ** ** ** ** Description: Outputs a 'test 0 = 1' line so command will eval ** ** with a non-zero exit code ** ** ** ** first edition: 2006/03/07 R.K.Owen ** ** ** ** Parameters: void none ** ** ** ** result: void (nothing) ** ** ** ** Attached Globals: g_retval if non-zero ** ** g_output if non-zero ** ** ** ** ************************************************************************ ** ++++*/ void OutputExit() { if (shell_derelict == NULL) { return; } else if( !strcmp( shell_derelict, "csh")) { /* OK shell derelict */ } else if( !strcmp( shell_derelict, "sh")) { /* OK shell derelict */ } else { return; } if (g_retval) { fprintf( stdout, " test 0 = 1;"); } } /** End of 'OutputExit' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: EMGetEnv ** ** ** ** Description: Wrap the Tcl_GetVar2() call and return an allocated ** ** string ** ** ** ** first edition: 2011/08/15 R.K.Owen ** ** ** ** Parameters: Tcl_Interp *interp TCL interp. ** ** char *var Environment variable ** ** ** ** Result: char * An allocated string ** ** ** ** ************************************************************************ ** ++++*/ char * EMGetEnv( Tcl_Interp *interp, char const *var) { char *value, *string; Tcl_Preserve(interp); value = (char *) Tcl_GetVar2( interp, "env", var, TCL_GLOBAL_ONLY); Tcl_Release(interp); string = stringer(NULL, 0, value, NULL); if(!string) if (OK != ErrorLogger(ERR_ALLOC, LOC, NULL)) return (NULL); /** ---- EXIT (FAILURE) ---> **/ return string; } /** End of 'EMGetEnv' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: EMSetEnv ** ** ** ** Description: Wrap the Tcl_SetVar2() call and return an allocated ** ** string ** ** ** ** first edition: 2011/09/26 R.K.Owen ** ** ** ** Parameters: Tcl_Interp *interp TCL interp. ** ** char *var Environment variable ** ** char *val New value ** ** ** ** Result: char * current value string ** ** ** ** ************************************************************************ ** ++++*/ char * EMSetEnv( Tcl_Interp *interp, char const *var, char const *val) { char *value; Tcl_Preserve(interp); value = (char *) Tcl_SetVar2( interp, "env", var, val, TCL_GLOBAL_ONLY); Tcl_Release(interp); return value; } /** End of 'EMSetEnv' **/ /*++++ ** ** Function-Header ***************************************************** ** ** ** ** Function: is_interactive ** ** ** ** Description: Test whether an interactive shell or not ** ** (for bash) ** ** ** ** first edition: 2012/05/21 R.K.Owen ** ** ** ** Parameters: none ** ** ** ** Result: int return 1 if true, else 0 ** ** ** ** ************************************************************************ ** ++++*/ int is_interactive(void) { static int saved = -1; FILE *tty = (FILE *) NULL; if (saved < 0) { /* try /dev/tty */ if (!(tty = fopen("/dev/tty","w"))) { saved = 0; /* no tty - hence non-interactive */ } else if (isatty(fileno(stdin)) || isatty(fileno(stdout)) || isatty(fileno(stderr))) { /* at least one of stdin/out/err is a tty */ saved = 1; } else { saved = 0; } if (tty) fclose(tty); } return saved; } /** End of 'is_interactive' **/