1 | /*****
2 | ** ** Module Header ******************************************************* **
3 | ** **
4 | ** Modules Revision 3.0 **
5 | ** Providing a flexible user environment **
6 | ** **
7 | ** File: utility.c **
8 | ** First Edition: 1991/10/23 **
9 | ** **
10 | ** Authors: John Furlan, jlf@behere.com **
11 | ** Jens Hamisch, jens@Strawberry.COM **
12 | ** **
13 | ** Description: General routines that are called throughout Modules **
14 | ** which are not necessarily specific to any single **
15 | ** block of functionality. **
16 | ** **
17 | ** Exports: store_hash_value **
18 | ** clear_hash_value **
19 | ** Delete_Global_Hash_Tables **
20 | ** Delete_Hash_Tables **
21 | ** Copy_Hash_Tables **
22 | ** Unwind_Modulefile_Changes **
23 | ** Output_Modulefile_Changes **
24 | ** IsLoaded_ExactMatch **
25 | ** IsLoaded **
26 | ** chk_marked_entry **
27 | ** set_marked_entry **
28 | ** Update_LoadedList **
29 | ** check_magic **
30 | ** cleanse_path **
31 | ** chk4spch **
32 | ** xdup **
33 | ** xgetenv **
34 | ** stringer **
35 | ** null_free **
36 | ** countTclHash **
37 | ** **
38 | ** strdup if not defined by the system libs. **
39 | ** strtok if not defined by the system libs. **
40 | ** **
41 | ** Notes: **
42 | ** **
43 | ** ************************************************************************ **
44 | ****/
45 |
46 | /** ** Copyright *********************************************************** **
47 | ** **
48 | ** Copyright 1991-1994 by John L. Furlan. **
49 | ** see LICENSE.GPL, which must be provided, for details **
50 | ** **
51 | ** ************************************************************************ **/
52 |
53 | static char Id[] = "@(#)$Id: utility.c.src.html,v 1.6 2006/01/18 05:35:11 rkowen Exp $";
54 | static void *UseId[] = { &UseId, Id };
55 |
56 | /** ************************************************************************ **/
57 | /** HEADERS **/
58 | /** ************************************************************************ **/
59 |
60 | #include "modules_def.h"
61 |
62 | /** ************************************************************************ **/
63 | /** LOCAL DATATYPES **/
64 | /** ************************************************************************ **/
65 |
66 | /** not applicable **/
67 |
68 | /** ************************************************************************ **/
69 | /** CONSTANTS **/
70 | /** ************************************************************************ **/
71 |
72 | /** not applicable **/
73 |
74 | /** ************************************************************************ **/
75 | /** MACROS **/
76 | /** ************************************************************************ **/
77 |
78 | /** not applicable **/
79 |
80 | /** ************************************************************************ **/
81 | /** LOCAL DATA **/
82 | /** ************************************************************************ **/
83 |
84 | static char module_name[] = "utility.c"; /** File name of this module **/
85 |
86 | #if WITH_DEBUGGING_UTIL_2
87 | static char _proc_store_hash_value[] = "store_hash_value";
88 | static char _proc_clear_hash_value[] = "clear_hash_value";
89 | static char _proc_Clear_Global_Hash_Tables[] = "Clear_Global_Hash_Tables";
90 | static char _proc_Delete_Global_Hash_Tables[] = "Delete_Global_Hash_Tables";
91 | static char _proc_Delete_Hash_Tables[] = "Delete_Hash_Tables";
92 | static char _proc_Copy_Hash_Tables[] = "Copy_Hash_Tables";
93 | static char _proc_Unwind_Modulefile_Changes[] = "Unwind_Modulefile_Changes";
94 | static char _proc_Output_Modulefile_Changes[] = "Output_Modulefile_Changes";
95 | static char _proc_Output_Modulefile_Aliases[] = "Output_Modulefile_Aliases";
96 | static char _proc_output_set_variable[] = "output_set_variable";
97 | static char _proc_output_unset_variable[] = "output_unset_variable";
98 | static char _proc_output_function[] = "output_function";
99 | static char _proc_output_set_alias[] = "output_set_alias";
100 | static char _proc_output_unset_alias[] = "output_unset_alias";
101 | static char _proc_getLMFILES[] = "getLMFILES";
102 | static char _proc___IsLoaded[] = "__IsLoaded";
103 | static char _proc_chk_marked_entry[] = "chk_marked_entry";
104 | static char _proc_set_marked_entry[] = "set_marked_entry";
105 | static char _proc_get_module_basename[] = "get_module_basename";
106 | static char _proc_Update_LoadedList[] = "Update_LoadedList";
107 | static char _proc_check_magic[] = "check_magic";
108 | static char _proc_cleanse_path[] = "cleanse_path";
109 | static char _proc_chop[] = "chop";
110 | #endif
111 |
112 | static FILE *aliasfile; /** Temporary file to write aliases **/
113 | static char *aliasfilename; /** Temporary file name **/
114 | static char alias_separator = ';'; /** Alias command separator **/
115 | static const int eval_alias = /** EVAL_ALIAS macro **/
116 | #ifdef EVAL_ALIAS
117 | 1
118 | #else
119 | 0
120 | #endif
121 | ;
122 | static const int bourne_funcs = /** HAS_BOURNE_FUNCS macro **/
123 | #ifdef HAS_BOURNE_FUNCS
124 | 1
125 | #else
126 | 0
127 | #endif
128 | ;
129 | static const int bourne_alias = /** HAS_BOURNE_FUNCS macro **/
130 | #ifdef HAS_BOURNE_ALIAS
131 | 1
132 | #else
133 | 0
134 | #endif
135 | ;
136 |
137 | /** ************************************************************************ **/
138 | /** PROTOTYPES **/
139 | /** ************************************************************************ **/
140 |
141 | static void Clear_Global_Hash_Tables( void);
142 | static int Output_Modulefile_Aliases( Tcl_Interp *interp);
143 | static int output_set_variable( Tcl_Interp *interp, const char*,
144 | const char*);
145 | static int output_unset_variable( const char* var);
146 | static void output_function( const char*, const char*);
147 | static int output_set_alias( const char*, const char*);
148 | static int output_unset_alias( const char*, const char*);
149 | static int __IsLoaded( Tcl_Interp*, char*, char**, char*, int);
150 | static char *get_module_basename( char*);
151 | static char *chop( const char*);
152 | static void EscapeCshString(const char* in,
153 | char* out);
154 | static void EscapeShString(const char* in,
155 | char* out);
156 | static void EscapePerlString(const char* in,
157 | char* out);
158 |
159 |
160 | /*++++
161 | ** ** Function-Header ***************************************************** **
162 | ** **
163 | ** Function: store_hash_value **
164 | ** **
165 | ** Description: Keeps the old value of the variable around if it is **
166 | ** touched in the modulefile to enable undoing a **
167 | ** modulefile by resetting the evironment to it started.**
168 | ** **
169 | ** This is the same for unset_shell_variable() **
170 | ** **
171 | ** First Edition: 1992/10/14 **
172 | ** **
173 | ** Parameters: Tcl_HashTable *htable Hash table to be used**
174 | ** const char *key Attached key **
175 | ** const char *value Alias value **
176 | ** **
177 | ** Result: int TCL_OK Successfull completion **
178 | ** **
179 | ** Attached Globals: - **
180 | ** **
181 | ** ************************************************************************ **
182 | ++++*/
183 |
184 | int store_hash_value( Tcl_HashTable* htable,
185 | const char* key,
186 | const char* value)
187 | {
188 | int new; /** Return from Tcl_CreateHashEntry **/
189 | /** which indicates creation or ref- **/
190 | /** ference to an existing entry **/
191 | char *tmp; /** Temp pointer used for disalloc. **/
192 | Tcl_HashEntry *hentry; /** Hash entry reference **/
193 |
194 | #if WITH_DEBUGGING_UTIL_2
195 | ErrorLogger( NO_ERR_START, LOC, _proc_store_hash_value, NULL);
196 | #endif
197 |
198 | /**
199 | ** Create a hash entry for the key to be stored. If there exists one
200 | ** so far, its value has to be unlinked.
201 | ** All values in this hash are pointers to allocated memory areas.
202 | **/
203 |
204 | hentry = Tcl_CreateHashEntry( htable, (char*) key, &new);
205 | if( !new) {
206 | tmp = (char *) Tcl_GetHashValue( hentry);
207 | if( tmp)
208 | null_free((void *) &tmp);
209 | }
210 |
211 | /**
212 | ** Set up the new value. strdup allocates!
213 | **/
214 |
215 | if( value)
216 | Tcl_SetHashValue( hentry, (char*) strdup((char*) value));
217 | else
218 | Tcl_SetHashValue( hentry, (char*) NULL);
219 |
220 | return( TCL_OK);
221 |
222 | } /** End of 'store_hash_value' **/
223 |
224 | /*++++
225 | ** ** Function-Header ***************************************************** **
226 | ** **
227 | ** Function: clear_hash_value **
228 | ** **
229 | ** Description: Remove the specified shell variable from the passed **
230 | ** hash table **
231 | ** **
232 | ** First Edition: 1991/10/23 **
233 | ** **
234 | ** Parameters: Tcl_HashTable *htable Hash table to be used**
235 | ** const char *key Attached key **
236 | ** **
237 | ** Result: int TCL_OK Successfull completion **
238 | ** **
239 | ** Attached Globals: - **
240 | ** **
241 | ** ************************************************************************ **
242 | ++++*/
243 |
244 | int clear_hash_value( Tcl_HashTable *htable,
245 | const char *key)
246 | {
247 | char *tmp; /** Temp pointer used for dealloc. **/
248 | Tcl_HashEntry *hentry; /** Hash entry reference **/
249 |
250 | #if WITH_DEBUGGING_UTIL_2
251 | ErrorLogger( NO_ERR_START, LOC, _proc_clear_hash_value, NULL);
252 | #endif
253 |
254 | /**
255 | ** If I haven't already created an entry for keeping this environment
256 | ** variable's value, then just leave.
257 | ** Otherwise, remove this entry from the hash table.
258 | **/
259 |
260 | if( hentry = Tcl_FindHashEntry( htable, (char*) key) ) {
261 |
262 | tmp = (char*) Tcl_GetHashValue( hentry);
263 | if( tmp)
264 | null_free((void *) &tmp);
265 |
266 | Tcl_DeleteHashEntry( hentry);
267 | }
268 |
269 | return( TCL_OK);
270 |
271 | } /** End of 'clear_hash_value' **/
272 |
273 | /*++++
274 | ** ** Function-Header ***************************************************** **
275 | ** **
276 | ** Function: Clear_Global_Hash_Tables **
277 | ** **
278 | ** Description: Deletes and reinitializes our env. hash tables. **
279 | ** **
280 | ** First Edition: 1992/10/14 **
281 | ** **
282 | ** Parameters: - **
283 | ** Result: - **
284 | ** **
285 | ** Attached Globals: setenvHashTable, **
286 | ** unsetenvHashTable, **
287 | ** aliasSetHashTable, **
288 | ** aliasUnsetHashTable **
289 | ** **
290 | ** ************************************************************************ **
291 | ++++*/
292 |
293 | static void Clear_Global_Hash_Tables( void)
294 | {
295 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
296 | Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
297 | char *val = NULL; /** Stored value (is a pointer!) **/
298 |
299 | /**
300 | ** The following hash tables are to be initialized
301 | **/
302 |
303 | Tcl_HashTable *table[5],
304 | **table_ptr = table;
305 |
306 | table[0] = setenvHashTable;
307 | table[1] = unsetenvHashTable;
308 | table[2] = aliasSetHashTable;
309 | table[3] = aliasUnsetHashTable;
310 | table[4] = NULL;
311 |
312 | #if WITH_DEBUGGING_UTIL_2
313 | ErrorLogger( NO_ERR_START, LOC, _proc_Clear_Global_Hash_Tables, NULL);
314 | #endif
315 |
316 | /**
317 | ** Loop for all the hash tables named above. If there's no value stored
318 | ** in a hash table, skip to the next one.
319 | **/
320 |
321 | for( ; *table_ptr; table_ptr++) {
322 |
323 | if( ( hashEntry = Tcl_FirstHashEntry( *table_ptr, &searchPtr)) == NULL)
324 | continue;
325 |
326 | /**
327 | ** Otherwise remove all values stored in the table
328 | **/
329 |
330 | do {
331 | val = (char*) Tcl_GetHashValue( hashEntry);
332 | if( val)
333 | null_free((void *) &val);
334 | } while( hashEntry = Tcl_NextHashEntry( &searchPtr));
335 |
336 | /**
337 | ** Reinitialize the hash table by unlocking it from memory and
338 | ** thereafter initializing it again.
339 | **/
340 |
341 | Tcl_DeleteHashTable( *table_ptr);
342 | Tcl_InitHashTable( *table_ptr, TCL_STRING_KEYS);
343 |
344 | } /** for **/
345 |
346 | } /** End of 'Clear_Global_Hash_Tables' **/
347 |
348 | /*++++
349 | ** ** Function-Header ***************************************************** **
350 | ** **
351 | ** Function: Delete_Global_Hash_Tables **
352 | ** Delete_Hash_Tables **
353 | ** **
354 | ** Description: Deletes our environment hash tables. **
355 | ** **
356 | ** First Edition: 1992/10/14 **
357 | ** **
358 | ** Parameters: Tcl_HashTable **table_ptr NULL-Terminated list **
359 | ** of hash tables to be **
360 | ** deleted **
361 | ** Result: - **
362 | ** **
363 | ** Attached Globals: setenvHashTable, **
364 | ** unsetenvHashTable, **
365 | ** aliasSetHashTable, **
366 | ** aliasUnsetHashTable **
367 | ** **
368 | ** ************************************************************************ **
369 | ++++*/
370 |
371 | void Delete_Global_Hash_Tables( void) {
372 |
373 | /**
374 | ** The following hash tables are to be initialized
375 | **/
376 |
377 | Tcl_HashTable *table[5];
378 |
379 | table[0] = setenvHashTable;
380 | table[1] = unsetenvHashTable;
381 | table[2] = aliasSetHashTable;
382 | table[3] = aliasUnsetHashTable;
383 | table[4] = NULL;
384 |
385 | #if WITH_DEBUGGING_UTIL_2
386 | ErrorLogger( NO_ERR_START, LOC, _proc_Delete_Global_Hash_Tables, NULL);
387 | #endif
388 |
389 | Delete_Hash_Tables( table);
390 |
391 | } /** End of 'Delete_Global_Hash_Tables' **/
392 |
393 | void Delete_Hash_Tables( Tcl_HashTable **table_ptr)
394 | {
395 |
396 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
397 | Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
398 | char *val = NULL; /** Stored value (is a pointer!) **/
399 |
400 | #if WITH_DEBUGGING_UTIL_2
401 | ErrorLogger( NO_ERR_START, LOC, _proc_Delete_Hash_Tables, NULL);
402 | #endif
403 |
404 | /**
405 | ** Loop for all the hash tables named above. Remove all values stored in
406 | ** the table and then free up the whole table
407 | **/
408 | for( ; *table_ptr; table_ptr++) {
409 |
410 | if( ( hashEntry = Tcl_FirstHashEntry( *table_ptr, &searchPtr))) {
411 |
412 | /**
413 | ** Remove all values stored in the table
414 | **/
415 | do {
416 | val = (char*) Tcl_GetHashValue( hashEntry);
417 | if( val)
418 | null_free((void *) &val);
419 | } while( hashEntry = Tcl_NextHashEntry( &searchPtr));
420 |
421 | /**
422 | ** Remove internal hash control structures
423 | **/
424 | Tcl_DeleteHashTable( *table_ptr);
425 | }
426 |
427 | null_free((void *) table_ptr);
428 |
429 | } /** for **/
430 |
431 | #if WITH_DEBUGGING_UTIL_2
432 | ErrorLogger( NO_ERR_END, LOC, _proc_Delete_Hash_Tables, NULL);
433 | #endif
434 |
435 | } /** End of 'Delete_Hash_Tables' **/
436 |
437 | /*++++
438 | ** ** Function-Header ***************************************************** **
439 | ** **
440 | ** Function: Copy_Hash_Tables **
441 | ** **
442 | ** Description: Allocate new hash tables for the global environment, **
443 | ** initialize them and copy the contents of the current **
444 | ** tables into them. **
445 | ** **
446 | ** First Edition: 1991/10/23 **
447 | ** **
448 | ** Parameters: - **
449 | ** Result: Tcl_HashTable** Pointer to the new list of **
450 | ** hash tables **
451 | ** Attached Globals: setenvHashTable, **
452 | ** unsetenvHashTable, **
453 | ** aliasSetHashTable, **
454 | ** aliasUnsetHashTable **
455 | ** **
456 | ** ************************************************************************ **
457 | ++++*/
458 |
459 | Tcl_HashTable **Copy_Hash_Tables( void)
460 | {
461 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
462 | Tcl_HashEntry *oldHashEntry, /** Hash entries to be copied **/
463 | *newHashEntry;
464 | char *val = NULL, /** Stored value (is a pointer!) **/
465 | *key = NULL; /** Hash key **/
466 | int new; /** Tcl inidicator, if the new hash **/
467 | /** entry has been created or ref. **/
468 |
469 | Tcl_HashTable *oldTable[5],
470 | **o_ptr, **n_ptr,
471 | **newTable; /** Destination hash table **/
472 |
473 | oldTable[0] = setenvHashTable;
474 | oldTable[1] = unsetenvHashTable;
475 | oldTable[2] = aliasSetHashTable;
476 | oldTable[3] = aliasUnsetHashTable;
477 | oldTable[4] = NULL;
478 |
479 | #if WITH_DEBUGGING_UTIL_2
480 | ErrorLogger( NO_ERR_START, LOC, _proc_Copy_Hash_Tables, NULL);
481 | #endif
482 |
483 | /**
484 | ** Allocate storage for the new list of hash tables
485 | **/
486 | if( !(newTable = (Tcl_HashTable**) malloc( sizeof( oldTable))))
487 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
488 | goto unwind0;
489 |
490 | /**
491 | ** Now copy each hashtable out of the list
492 | **/
493 | for( o_ptr = oldTable, n_ptr = newTable; *o_ptr; o_ptr++, n_ptr++) {
494 |
495 | /**
496 | ** Allocate memory for a single hash table
497 | **/
498 | if( !(*n_ptr = (Tcl_HashTable*) malloc( sizeof( Tcl_HashTable))))
499 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
500 | goto unwind1;
501 |
502 | /**
503 | ** Initialize that guy and copy it from the old table
504 | **/
505 | Tcl_InitHashTable( *n_ptr, TCL_STRING_KEYS);
506 | if( oldHashEntry = Tcl_FirstHashEntry( *o_ptr, &searchPtr)) {
507 |
508 | /**
509 | ** Copy all entries if there are any
510 | **/
511 | do {
512 |
513 | key = (char*) Tcl_GetHashKey( *o_ptr, oldHashEntry);
514 | val = (char*) Tcl_GetHashValue( oldHashEntry);
515 |
516 | newHashEntry = Tcl_CreateHashEntry( *n_ptr, key, &new);
517 |
518 | if(val)
519 | Tcl_SetHashValue(newHashEntry, strdup(val));
520 | else
521 | Tcl_SetHashValue(newHashEntry, (char *) NULL);
522 |
523 | } while( oldHashEntry = Tcl_NextHashEntry( &searchPtr));
524 |
525 | } /** if **/
526 | } /** for **/
527 |
528 | /**
529 | ** Put a terminator at the end of the new table
530 | **/
531 | *n_ptr = NULL;
532 |
533 | #if WITH_DEBUGGING_UTIL_2
534 | ErrorLogger( NO_ERR_END, LOC, _proc_Copy_Hash_Tables, NULL);
535 | #endif
536 |
537 | return( newTable);
538 |
539 | unwind1:
540 | null_free((void *) &newTable);
541 | unwind0:
542 | return( NULL); /** -------- EXIT (FAILURE) -------> **/
543 | } /** End of 'Copy_Hash_Tables' **/
544 |
545 | /*++++
546 | ** ** Function-Header ***************************************************** **
547 | ** **
548 | ** Function: **
549 | ** **
550 | ** Description: Once a the loading or unloading of a modulefile **
551 | ** fails, any changes it has made to the environment **
552 | ** must be undone and reset to its previous state. This **
553 | ** function is responsible for unwinding any changes a **
554 | ** modulefile has made. **
555 | ** **
556 | ** First Edition: 1991/10/23 **
557 | ** **
558 | ** Parameters: Tcl_Interp *interp According TCL interp.**
559 | ** Tcl_HashTable **oldTables Hash tables storing **
560 | ** the former environm. **
561 | ** Result: **
562 | ** Attached Globals: **
563 | ** **
564 | ** ************************************************************************ **
565 | ++++*/
566 |
567 | int Unwind_Modulefile_Changes( Tcl_Interp *interp,
568 | Tcl_HashTable **oldTables )
569 | {
570 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
571 | Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
572 | char *val = NULL, /** Stored value (is a pointer!) **/
573 | *key; /** Tcl hash key **/
574 | int i; /** Loop counter **/
575 |
576 | #if WITH_DEBUGGING_UTIL_2
577 | ErrorLogger( NO_ERR_START, LOC, _proc_Unwind_Modulefile_Changes, NULL);
578 | #endif
579 |
580 | if( oldTables) {
581 |
582 | /**
583 | ** Use only entries 0 and 1 which do contain all changes to the
584 | ** shell varibles (setenv and unsetenv)
585 | **/
586 |
587 | /** ??? What about the aliases (table 2 and 3) ??? **/
588 |
589 | for( i = 0; i < 2; i++) {
590 | if( hashEntry = Tcl_FirstHashEntry( oldTables[i], &searchPtr)) {
591 |
592 | do {
593 | key = (char*) Tcl_GetHashKey( oldTables[i], hashEntry);
594 |
595 | /**
596 | ** The hashEntry will contain the appropriate value for the
597 | ** specified 'key' because it will have been aquired depending
598 | ** upon whether the unset or set table was used.
599 | **/
600 |
601 | val = (char*) Tcl_GetHashValue( hashEntry);
602 | if( val)
603 | Tcl_SetVar2( interp, "env", key, val, TCL_GLOBAL_ONLY);
604 |
605 | } while( hashEntry = Tcl_NextHashEntry( &searchPtr) );
606 |
607 | } /** if **/
608 | } /** for **/
609 |
610 | /**
611 | ** Delete and reset the hash tables now that the current contents have been
612 | ** flushed.
613 | **/
614 |
615 | Delete_Global_Hash_Tables();
616 |
617 | setenvHashTable = oldTables[0];
618 | unsetenvHashTable = oldTables[1];
619 | aliasSetHashTable = oldTables[2];
620 | aliasUnsetHashTable = oldTables[3];
621 |
622 | } else {
623 |
624 | Clear_Global_Hash_Tables();
625 |
626 | }
627 |
628 | return( TCL_OK);
629 |
630 | } /** End of 'Unwind_Modulefile_Changes' **/
631 |
632 | static int keycmp(const void *a, const void *b) {
633 | return strcmp(*(const char **) a, *(const char **) b);
634 | }
635 |
636 | /*++++
637 | ** ** Function-Header ***************************************************** **
638 | ** **
639 | ** Function: Output_Modulefile_Changes **
640 | ** **
641 | ** Description: Is used to flush out the changes of the current **
642 | ** modulefile in a manner depending upon whether the **
643 | ** modulefile was successfull or unsuccessfull. **
644 | ** **
645 | ** First Edition: 1991/10/23 **
646 | ** **
647 | ** Parameters: Tcl_Interp *interp The attached Tcl in- **
648 | ** terpreter **
649 | ** **
650 | ** Result: int TCL_OK Successful operation **
651 | ** **
652 | ** Attached Globals: setenvHashTable, **
653 | ** unsetenvHashTable, **
654 | ** aliasSetHashTable, via Output_Modulefile_Aliases**
655 | ** aliasUnsetHashTable via Output_Modulefile_Aliases**
656 | ** **
657 | ** ************************************************************************ **
658 | ++++*/
659 |
660 | int Output_Modulefile_Changes( Tcl_Interp *interp)
661 | {
662 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
663 | Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
664 | char *val = NULL, /** Stored value (is a pointer!) **/
665 | *key, /** Tcl hash key **/
666 | **list; /** list of keys **/
667 | int i,k; /** Loop counter **/
668 | size_t hcnt; /** count of hash entries **/
669 |
670 | /**
671 | ** The following hash tables do contain all changes to be made on
672 | ** shell variables
673 | **/
674 |
675 | Tcl_HashTable *table[2];
676 |
677 | table[0] = setenvHashTable;
678 | table[1] = unsetenvHashTable;
679 |
680 | #if WITH_DEBUGGING_UTIL_2
681 | ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Changes, NULL);
682 | #endif
683 |
684 | aliasfile = stdout;
685 |
686 | /**
687 | ** Scan both tables that are of interest for shell variables
688 | **/
689 |
690 | for(i = 0; i < 2; i++) {
691 | /* count hash */
692 | hcnt = countTclHash(table[i]);
693 |
694 | /* allocate array for keys */
695 | if( !(list = (char **) malloc(hcnt * sizeof(char *)))) {
696 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
697 | return(TCL_ERROR);/** ------- EXIT (FAILURE) ------> **/
698 | }
699 |
700 | /* collect keys */
701 | k = 0;
702 | if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr))
703 | do {
704 | key = (char*) Tcl_GetHashKey( table[i], hashEntry);
705 | list[k++] = strdup(key);
706 | } while( hashEntry = Tcl_NextHashEntry( &searchPtr));
707 | /* sort hash */
708 | if (hcnt > 1)
709 | qsort((void *) list, hcnt, sizeof(char *), keycmp);
710 |
711 | /* output key/values */
712 | for (k = 0; k < hcnt; ++k) {
713 | key = list[k];
714 | hashEntry = Tcl_FindHashEntry( table[i], key);
715 | /**
716 | ** The table list indicator is used in order to differ
717 | ** between the setenv and unsetenv operation
718 | **/
719 | if( i == 1) {
720 | output_unset_variable( (char*) key);
721 | } else {
722 | if(val=(char *) Tcl_GetVar2(interp,"env",
723 | key,TCL_GLOBAL_ONLY))
724 | output_set_variable(interp, (char*) key, val);
725 | }
726 | } /** for **/
727 | /* delloc list */
728 | for (k = 0; k < hcnt; ++k)
729 | free(list[k]);
730 | free(list);
731 | } /** for **/
732 |
733 | if( EOF == fflush( stdout))
734 | if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL))
735 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
736 |
737 | Output_Modulefile_Aliases( interp);
738 |
739 | /**
740 | ** Delete and reset the hash tables since the current contents have been
741 | ** flushed.
742 | **/
743 |
744 | Clear_Global_Hash_Tables();
745 | return( TCL_OK);
746 |
747 | } /* End of 'Output_Modulefile_Changes' */
748 |
749 | /*++++
750 | ** ** Function-Header ***************************************************** **
751 | ** **
752 | ** Function: Open_Aliasfile **
753 | ** **
754 | ** Description: Creates/opens or closes temporary file for sourcing **
755 | ** or aliases. **
756 | ** Passes back the filehandle and filename in global **
757 | ** variables. **
758 | ** **
759 | ** First Edition: 2005/09/26 R.K.Owen <rk@owen.sj.ca.us> **
760 | ** **
761 | ** Parameters: int action if != 0 to open else close **
762 | ** **
763 | ** Result: int TCL_OK Successful operation **
764 | ** **
765 | ** Attached Globals: aliasfile **
766 | ** aliasfilename **
767 | ** **
768 | ** ************************************************************************ **
769 | ++++*/
770 |
771 | static int Open_Aliasfile(int action)
772 | {
773 |
774 | if (action) {
775 | /**
776 | ** Open the file ...
777 | **/
778 | if( tmpfile_mod(&aliasfilename,&aliasfile))
779 | if(OK != ErrorLogger( ERR_OPEN, LOC, aliasfilename, "append", NULL))
780 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
781 | } else {
782 | if( EOF == fclose( aliasfile))
783 | if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfile, NULL))
784 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
785 | }
786 |
787 | return( TCL_OK);
788 |
789 | } /** End of 'Open_Aliasfile' **/
790 | /*++++
791 | ** ** Function-Header ***************************************************** **
792 | ** **
793 | ** Function: Output_Modulefile_Aliases **
794 | ** **
795 | ** Description: Is used to flush out the changes to the aliases of **
796 | ** the current modulefile. But, some shells don't work **
797 | ** well with having their alias information set via the **
798 | ** 'eval' command. So, what we'll do now is output the **
799 | ** aliases into a /tmp dotfile, have the shell source **
800 | ** the /tmp dotfile and then have the shell remove the **
801 | ** /tmp dotfile. **
802 | ** **
803 | ** First Edition: 1991/10/23 **
804 | ** **
805 | ** Parameters: Tcl_Interp *interp The attached Tcl in- **
806 | ** terpreter **
807 | ** **
808 | ** Result: int TCL_OK Successful operation **
809 | ** **
810 | ** Attached Globals: aliasSetHashTable, via Output_Modulefile_Aliases**
811 | ** aliasUnsetHashTable via Output_Modulefile_Aliases**
812 | ** **
813 | ** ************************************************************************ **
814 | ++++*/
815 |
816 | static int Output_Modulefile_Aliases( Tcl_Interp *interp)
817 | {
818 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
819 | Tcl_HashEntry *hashEntry; /** Result from Tcl hash search **/
820 | char *val = NULL, /** Stored value (is a pointer!) **/
821 | *key; /** Tcl hash key **/
822 | int i, /** Loop counter **/
823 | openfile = 0; /** whether using a file or not **/
824 | char *sourceCommand; /** Command used to source the alias **/
825 |
826 | /**
827 | ** The following hash tables do contain all changes to be made on
828 | ** shell aliases
829 | **/
830 | Tcl_HashTable *table[2];
831 |
832 | table[0] = aliasSetHashTable;
833 | table[1] = aliasUnsetHashTable;
834 |
835 | /**
836 | ** If configured so, all changes to aliases are written into a temporary
837 | ** file which is sourced by the invoking shell ...
838 | ** In this case a temporary filename has to be assigned for the alias
839 | ** source file. The file has to be opened as 'aliasfile'.
840 | ** The default for aliasfile, if no shell sourcing is used, is stdout.
841 | **/
842 |
843 | #if WITH_DEBUGGING_UTIL_2
844 | ErrorLogger( NO_ERR_START, LOC, _proc_Output_Modulefile_Aliases, NULL);
845 | #endif
846 |
847 | /**
848 | ** We only need to output stuff into a temporary file if we're setting
849 | ** stuff. We can unset variables and aliases by just using eval.
850 | **/
851 | if( hashEntry = Tcl_FirstHashEntry( aliasSetHashTable, &searchPtr)) {
852 |
853 | /**
854 | ** We must use an aliasfile if EVAL_ALIAS is not defined
855 | ** or the sh shell does not do aliases (HAS_BOURNE_ALIAS)
856 | ** and that the sh shell does do functions (HAS_BOURNE_FUNCS)
857 | **/
858 | if (!eval_alias
859 | || (!strcmp(shell_name,"sh") && !bourne_alias && bourne_funcs)) {
860 | if (OK != Open_Aliasfile(1))
861 | if(OK != ErrorLogger(ERR_OPEN,LOC,aliasfilename,"append",NULL))
862 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
863 | openfile = 1;
864 | }
865 | /**
866 | ** We only support sh and csh variants for aliases. If not either
867 | ** sh or csh print warning message and return
868 | **/
869 | if( !strcmp( shell_derelict, "csh")) {
870 | sourceCommand = "source %s%s";
871 | } else if( !strcmp( shell_derelict, "sh")) {
872 | sourceCommand = ". %s%s";
873 | } else {
874 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
875 | }
876 |
877 | if (openfile) {
878 | /**
879 | ** Only the source command has to be flushed to stdout. After
880 | ** sourcing the alias definition (temporary) file, the source
881 | ** file is to be removed.
882 | **/
883 | alias_separator = '\n';
884 |
885 | fprintf( stdout, sourceCommand, aliasfilename, shell_cmd_separator);
886 | fprintf( stdout, "/bin/rm -f %s%s",
887 | aliasfilename, shell_cmd_separator);
888 | } /** openfile **/
889 | } /** if( alias to set) **/
890 |
891 | /**
892 | ** Scan the hash tables involved in changing aliases
893 | **/
894 |
895 | for( i=0; i<2; i++) {
896 |
897 | if( hashEntry = Tcl_FirstHashEntry( table[i], &searchPtr)) {
898 |
899 | do {
900 | key = (char*) Tcl_GetHashKey( table[i], hashEntry);
901 | val = (char*) Tcl_GetHashValue( hashEntry);
902 |
903 | /**
904 | ** The hashtable list index is used to differ between aliases
905 | ** to be set and aliases to be reset
906 | **/
907 | if(i == 1) {
908 | output_unset_alias( key, val);
909 | } else {
910 | output_set_alias( key, val);
911 | }
912 |
913 | } while( hashEntry = Tcl_NextHashEntry( &searchPtr));
914 |
915 | } /** if **/
916 | } /** for **/
917 |
918 |
919 | if(openfile) {
920 | if( OK == Open_Aliasfile(0))
921 | if( OK != ErrorLogger( ERR_CLOSE, LOC, aliasfile, NULL))
922 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
923 |
924 | null_free((void *) &aliasfilename);
925 | }
926 |
927 | return( TCL_OK);
928 |
929 | } /** End of 'Output_Modulefile_Aliases' **/
930 |
931 | /*++++
932 | ** ** Function-Header ***************************************************** **
933 | ** **
934 | ** Function: output_set_variable **
935 | ** **
936 | ** Description: Outputs the command required to set a shell variable **
937 | ** according to the current shell **
938 | ** **
939 | ** First Edition: 1991/10/23 **
940 | ** **
941 | ** Parameters: Tcl_Interp *interp The attached Tcl interpreter **
942 | ** const char *var Name of the variable to be **
943 | ** set **
944 | ** const char *val Value to be assigned **
945 | ** **
946 | ** Result: int TCL_OK Finished successfull **
947 | ** TCL_ERROR Unknown shell type **
948 | ** **
949 | ** Attached Globals: shell_derelict **
950 | ** **
951 | ** ************************************************************************ **
952 | ++++*/
953 |
954 | static int output_set_variable( Tcl_Interp *interp,
955 | const char *var,
956 | const char *val)
957 | {
958 |
959 | /**
960 | ** Differ between the different kinds od shells at first
961 | **
962 | ** CSH
963 | **/
964 | chop( val);
965 | chop( var);
966 |
967 | #if WITH_DEBUGGING_UTIL_2
968 | ErrorLogger( NO_ERR_START, LOC, _proc_output_set_variable, " var='", var,
969 | "' val= '", val, "'", NULL);
970 | #endif
971 |
972 | if( !strcmp((char*) shell_derelict, "csh")) {
973 |
974 | #ifdef LMSPLIT_SIZE
975 |
976 | /**
977 | ** Many C Shells (specifically the Sun one) has a hard limit on
978 | ** the size of the environment variables around 1k. The
979 | ** _LMFILES_ variable can grow beyond 1000 characters. So, I'm
980 | ** going to break it up here since I can put it back together
981 | ** again when I use it.
982 | **
983 | ** You can set the split size using --with-split-size=<number>
984 | ** it should probably be <1000. I don't count the size of
985 | ** "setenv _LMFILES_xxx" so subtract this from your limit.
986 | **/
987 | if( !strcmp( var, "_LMFILES_")) {
988 | char formatted[ MOD_BUFSIZE];
989 | char *cptr;
990 | int lmfiles_len;
991 | int count = 0;
992 | char* escaped = stringer(NULL,strlen(val)*2+1,NULL);
993 | EscapeCshString(val,escaped);
994 |
995 | if(( lmfiles_len = strlen(escaped)) > LMSPLIT_SIZE) {
996 |
997 | char buffer[ LMSPLIT_SIZE + 1];
998 |
999 | /**
1000 | ** Break up the _LMFILES_ variable...
1001 | **/
1002 | while( lmfiles_len > LMSPLIT_SIZE) {
1003 |
1004 | strncpy( buffer, ( escaped + count*LMSPLIT_SIZE ),
1005 | LMSPLIT_SIZE);
1006 | buffer[ LMSPLIT_SIZE] = '\0';
1007 |
1008 | fprintf( stdout, "setenv %s%03d %s%s", var, count, buffer,
1009 | shell_cmd_separator);
1010 |
1011 | lmfiles_len -= LMSPLIT_SIZE;
1012 | count++;
1013 | }
1014 |
1015 | if( lmfiles_len) {
1016 | fprintf( stdout, "setenv %s%03d %s%s", var, count,
1017 | (escaped + count*LMSPLIT_SIZE), shell_cmd_separator);
1018 | count++;
1019 | }
1020 |
1021 | /**
1022 | ** Unset _LMFILES_ as indicator to use the multi-variable
1023 | ** _LMFILES_
1024 | **/
1025 | fprintf(stdout, "unsetenv %s%s", var, shell_cmd_separator);
1026 |
1027 | } else { /** if ( lmfiles_len = strlen(val)) > LMSPLIT_SIZE) **/
1028 |
1029 | fprintf(stdout, "setenv %s %s%s", var, escaped, shell_cmd_separator);
1030 | }
1031 |
1032 | /**
1033 | ** Unset the extra _LMFILES_%03d variables that may be set
1034 | **/
1035 | do {
1036 | sprintf( formatted, "_LMFILES_%03d", count++);
1037 | cptr = (char *) Tcl_GetVar2( interp, "env", formatted, TCL_GLOBAL_ONLY);
1038 | if( cptr) {
1039 | fprintf(stdout, "unsetenv %s%s", formatted, shell_cmd_separator);
1040 | }
1041 | } while( cptr);
1042 |
1043 | null_free((void *) &escaped);
1044 |
1045 | } else { /** if( var == "_LMFILES_") **/
1046 |
1047 | #endif /* not LMSPLIT_SIZE */
1048 |
1049 | char* escaped = stringer(NULL,strlen(val)*2+1,NULL);
1050 | EscapeCshString(val,escaped);
1051 | fprintf(stdout, "setenv %s %s %s", var, escaped, shell_cmd_separator);
1052 | null_free((void *) &escaped);
1053 | #ifdef LMSPLIT_SIZE
1054 | }
1055 | #endif /* not LMSPLIT_SIZE */
1056 |
1057 | /**
1058 | ** SH
1059 | **/
1060 | } else if( !strcmp((char*) shell_derelict, "sh")) {
1061 |
1062 | char* escaped = (char*)malloc(strlen(val)*2+1);
1063 | EscapeShString(val,escaped);
1064 |
1065 | fprintf( stdout, "%s=%s %sexport %s%s", var, escaped, shell_cmd_separator,
1066 | var, shell_cmd_separator);
1067 | free(escaped);
1068 |
1069 | /**
1070 | ** EMACS
1071 | **/
1072 | } else if( !strcmp((char*) shell_derelict, "emacs")) {
1073 | fprintf( stdout, "(setenv \"%s\" \'%s\')\n", var, val);
1074 |
1075 | /**
1076 | ** PERL
1077 | **/
1078 | } else if( !strcmp((char*) shell_derelict, "perl")) {
1079 | char* escaped = stringer(NULL,strlen(val)*2+1,NULL);
1080 | EscapePerlString(val,escaped);
1081 | fprintf(stdout, "$ENV{'%s'} = '%s'%s", var, escaped,
1082 | shell_cmd_separator);
1083 | null_free((void *) &escaped);
1084 |
1085 | /**
1086 | ** PYTHON
1087 | **/
1088 | } else if( !strcmp((char*) shell_derelict, "python")) {
1089 | fprintf( stdout, "os.environ['%s'] = '%s'\n", var, val);
1090 |
1091 | /**
1092 | ** SCM
1093 | **/
1094 | } else if ( !strcmp((char*) shell_derelict, "scm")) {
1095 | fprintf( stdout, "(putenv \"%s=%s\")\n", var, val);
1096 |
1097 | /**
1098 | ** MEL (Maya Extension Language)
1099 | **/
1100 | } else if ( !strcmp((char*) shell_derelict, "mel")) {
1101 | fprintf( stdout, "putenv \"%s\" \"%s\";", var, val);
1102 |
1103 | /**
1104 | ** Unknown shell type - print an error message and
1105 | ** return on error
1106 | **/
1107 | } else {
1108 | if( OK != ErrorLogger( ERR_DERELICT, LOC, shell_derelict, NULL))
1109 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
1110 | }
1111 |
1112 | /**
1113 | ** Return and acknowldge success
1114 | **/
1115 | return( TCL_ERROR);
1116 |
1117 | } /** End of 'output_set_variable' **/
1118 |
1119 | /*++++
1120 | ** ** Function-Header ***************************************************** **
1121 | ** **
1122 | ** Function: output_unset_variable **
1123 | ** **
1124 | ** Description: Outputs the command required to unset a shell **
1125 | ** variable according to the current shell **
1126 | ** **
1127 | ** First Edition: 1991/10/23 **
1128 | ** **
1129 | ** Parameters: const char *var Name of the variable to be **
1130 | ** unset **
1131 | ** **
1132 | ** Result: int TCL_OK Finished successfull **
1133 | ** TCL_ERROR Unknown shell type **
1134 | ** **
1135 | ** Attached Globals: shell_derelict **
1136 | ** **
1137 | ** ************************************************************************ **
1138 | ++++*/
1139 |
1140 | static int output_unset_variable( const char* var)
1141 | {
1142 | chop( var);
1143 |
1144 | #if WITH_DEBUGGING_UTIL_2
1145 | ErrorLogger( NO_ERR_START, LOC, _proc_output_unset_variable, NULL);
1146 | #endif
1147 |
1148 | /**
1149 | ** Display the 'unsetenv' command according to the current invoking shell.
1150 | **/
1151 | if( !strcmp( shell_derelict, "csh")) {
1152 | fprintf( stdout, "unsetenv %s%s", var, shell_cmd_separator);
1153 | } else if( !strcmp( shell_derelict, "sh")) {
1154 | fprintf( stdout, "unset %s%s", var, shell_cmd_separator);
1155 | } else if( !strcmp( shell_derelict, "emacs")) {
1156 | fprintf( stdout, "(setenv \"%s\" nil)\n", var);
1157 | } else if( !strcmp( shell_derelict, "perl")) {
1158 | fprintf( stdout, "delete $ENV{'%s'}%s", var, shell_cmd_separator);
1159 | } else if( !strcmp( shell_derelict, "python")) {
1160 | fprintf( stdout, "os.environ['%s'] = ''\ndel os.environ['%s']\n",var,var);
1161 | } else if( !strcmp( shell_derelict, "scm")) {
1162 | fprintf( stdout, "(putenv \"%s\")\n", var);
1163 | } else if( !strcmp( shell_derelict, "mel")) {
1164 | fprintf( stdout, "putenv \"%s\" \"\";", var);
1165 | } else {
1166 | if( OK != ErrorLogger( ERR_DERELICT, LOC, shell_derelict, NULL))
1167 | return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
1168 | }
1169 |
1170 | /**
1171 | ** Return and acknowldge success
1172 | **/
1173 | return( TCL_OK);
1174 |
1175 | } /** End of 'output_unset_variable' **/
1176 |
1177 | /*++++
1178 | ** ** Function-Header ***************************************************** **
1179 | ** **
1180 | ** Function: output_function **
1181 | ** **
1182 | ** Description: Actually turns the Modules set-alias information **
1183 | ** into a string that a shell can source. Previously, **
1184 | ** this routine just output the alias information to be **
1185 | ** eval'd by the shell. **
1186 | ** **
1187 | ** First Edition: 1991/10/23 **
1188 | ** **
1189 | ** Parameters: const char *var Name of the alias to be set **
1190 | ** const char *val Value to be assigned **
1191 | ** **
1192 | ** Result: - **
1193 | ** **
1194 | ** Attached Globals: aliasfile, The output file for alias commands. **
1195 | ** see 'Output_Modulefile_Aliases' **
1196 | ** alias_separator **
1197 | ** **
1198 | ** ************************************************************************ **
1199 | ++++*/
1200 |
1201 | static void output_function( const char *var,
1202 | const char *val)
1203 | {
1204 | const char *cptr = val;
1205 | int nobackslash = 1;
1206 |
1207 | #if WITH_DEBUGGING_UTIL_2
1208 | ErrorLogger( NO_ERR_START, LOC, _proc_output_function, NULL);
1209 | #endif
1210 |
1211 | /**
1212 | ** This opens a function ...
1213 | **/
1214 | fprintf( aliasfile, "%s() {%c", var, alias_separator);
1215 |
1216 | /**
1217 | ** ... now print the value. Print it as a single line and remove any
1218 | ** backslash
1219 | **/
1220 | while( *cptr) {
1221 |
1222 | if( *cptr == '\\') {
1223 | if( !nobackslash)
1224 | putc( *cptr, aliasfile);
1225 | else
1226 | nobackslash = 0;
1227 | cptr++;
1228 | continue;
1229 | } else
1230 | nobackslash = 1;
1231 |
1232 | putc(*cptr++, aliasfile);
1233 |
1234 | } /** while **/
1235 |
1236 | /**
1237 | ** Finally close the function
1238 | **/
1239 | fprintf( aliasfile, "%c}%c", alias_separator,alias_separator);
1240 |
1241 | } /** End of 'output_function' **/
1242 |
1243 | /*++++
1244 | ** ** Function-Header ***************************************************** **
1245 | ** **
1246 | ** Function: output_set_alias **
1247 | ** **
1248 | ** Description: Flush the commands required to set shell aliases de- **
1249 | ** pending on the current invoking shell **
1250 | ** **
1251 | ** First Edition: 1991/10/23 **
1252 | ** **
1253 | ** Parameters: const char *alias Name of the alias **
1254 | ** const char *val Value to be assigned **
1255 | ** **
1256 | ** Result: int TCL_OK Operation successfull **
1257 | ** **
1258 | ** Attached Globals: aliasfile, The alias command is written out to **
1259 | ** alias_separator Defined the command separator **
1260 | ** shell_derelict to determine the shell family **
1261 | ** shell_name to determine the real shell type **
1262 | ** **
1263 | ** ************************************************************************ **
1264 | ++++*/
1265 |
1266 | static int output_set_alias( const char *alias,
1267 | const char *val)
1268 | {
1269 | int nobackslash = 1; /** Controls whether backslashes are **/
1270 | /** to be print **/
1271 | const char *cptr = val; /** Scan the value char by char **/
1272 |
1273 | #if WITH_DEBUGGING_UTIL_2
1274 | ErrorLogger( NO_ERR_START, LOC, _proc_output_set_alias, NULL);
1275 | #endif
1276 |
1277 | /**
1278 | ** Check for the shell family
1279 | ** CSHs need to switch $* to \!* and $n to \!\!:n unless the $ has a
1280 | ** backslash before it
1281 | **/
1282 | if( !strcmp( shell_derelict, "csh")) {
1283 |
1284 | /**
1285 | ** On CSHs the command is 'alias <name> <value>'. Print the beginning
1286 | ** of the command and then print the value char by char.
1287 | **/
1288 | fprintf( aliasfile, "alias %s '", alias);
1289 |
1290 | while( *cptr) {
1291 |
1292 | /**
1293 | ** Convert $n to \!\!:n
1294 | **/
1295 | if( *cptr == '$' && nobackslash) {
1296 | cptr++;
1297 | if( *cptr == '*')
1298 | fprintf( aliasfile, "\\!");
1299 | else
1300 | fprintf( aliasfile, "\\!\\!:");
1301 | }
1302 |
1303 | /**
1304 | ** Recognize backslashes
1305 | **/
1306 | if( *cptr == '\\') {
1307 | if( !nobackslash)
1308 | putc( *cptr, aliasfile);
1309 | else
1310 | nobackslash = 0;
1311 | cptr++;
1312 | continue;
1313 | } else
1314 | nobackslash = 1;
1315 |
1316 | /**
1317 | ** print the read character
1318 | **/
1319 | putc( *cptr++, aliasfile);
1320 |
1321 | } /** while **/
1322 |
1323 | /**
1324 | ** Now close up the command using the alias command terminator as
1325 | ** defined in the global variable
1326 | **/
1327 | fprintf( aliasfile, "'%c", alias_separator);
1328 |
1329 | /**
1330 | ** Bourne shell family: The alias has to be translated into a
1331 | ** function using the function call 'output_function'
1332 | **/
1333 | } else if( !strcmp(shell_derelict, "sh")) {
1334 | /**
1335 | ** Shells supporting extended bourne shell syntax ....
1336 | **/
1337 | if( (!strcmp( shell_name, "sh") && bourne_alias)
1338 | || !strcmp( shell_name, "bash")
1339 | || !strcmp( shell_name, "zsh" )
1340 | || !strcmp( shell_name, "ksh")) {
1341 | /**
1342 | ** in this case we only have to write a function if the alias
1343 | ** take arguments. This is the case if the value has somewhere
1344 | ** a '$' in it without a '\' infront.
1345 | **/
1346 | while( *cptr) {
1347 | if( *cptr == '\\') {
1348 | if( nobackslash) {
1349 | nobackslash = 0;
1350 | }
1351 | } else {
1352 | if( *cptr == '$') {
1353 | if( nobackslash) {
1354 | output_function( alias, val);
1355 | return TCL_OK;
1356 | }
1357 | }
1358 | nobackslash = 1;
1359 | }
1360 | cptr++;
1361 | }
1362 |
1363 | /**
1364 | ** So, we can just output an alias with '\$' translated to '$'...
1365 | **/
1366 | fprintf( aliasfile, "alias %s='", alias);
1367 |
1368 | nobackslash = 1;
1369 | cptr = val;
1370 |
1371 | while( *cptr) {
1372 | if( *cptr == '\\') {
1373 | if( nobackslash) {
1374 | nobackslash = 0;
1375 | cptr++;
1376 | continue;
1377 | }
1378 | }
1379 | nobackslash = 1;
1380 |
1381 | putc(*cptr++, aliasfile);
1382 |
1383 | } /** while **/
1384 |
1385 | fprintf( aliasfile, "'%c", alias_separator);
1386 |
1387 | } else if( !strcmp( shell_name, "sh")
1388 | && bourne_funcs) {
1389 | /**
1390 | ** The bourne shell itself
1391 | ** need to write a function unless this sh doesn't support
1392 | ** functions (then just punt)
1393 | **/
1394 | output_function(alias, val);
1395 | }
1396 | /** ??? Unknown derelict ??? **/
1397 |
1398 | } /** if( sh ) **/
1399 |
1400 | return( TCL_OK);
1401 |
1402 | } /** End of 'output_set_alias' **/
1403 |
1404 | /*++++
1405 | ** ** Function-Header ***************************************************** **
1406 | ** **
1407 | ** Function: output_unset_alias **
1408 | ** **
1409 | ** Description: Flush the commands required to reset shell aliases **
1410 | ** depending on the current invoking shell **
1411 | ** **
1412 | ** First Edition: 1991/10/23 **
1413 | ** **
1414 | ** Parameters: const char *alias Name of the alias **
1415 | ** const char *val Value which has been **
1416 | ** assigned **
1417 | ** **
1418 | ** Result: int TCL_OK Operation successfull **
1419 | ** **
1420 | ** Attached Globals: aliasfile, The alias command is writte out to **
1421 | ** alias_separator Defined the command separator **
1422 | ** shell_derelict to determine the shell family **
1423 | ** shell_name to determine the real shell type **
1424 | ** **
1425 | ** ************************************************************************ **
1426 | ++++*/
1427 |
1428 | static int output_unset_alias( const char *alias,
1429 | const char *val)
1430 | {
1431 | int nobackslash = 1; /** Controls wether backslashes are **/
1432 | /** to be print **/
1433 | const char *cptr = val; /** Need to read the value char by char **/
1434 |
1435 | #if WITH_DEBUGGING_UTIL_2
1436 | ErrorLogger( NO_ERR_START, LOC, _proc_output_unset_alias, NULL);
1437 | #endif
1438 |
1439 | /**
1440 | ** Check for the shell family at first
1441 | ** Ahh! CSHs ... ;-)
1442 | **/
1443 | if( !strcmp( shell_derelict, "csh")) {
1444 | fprintf( aliasfile, "unalias %s%c", alias, alias_separator);
1445 |
1446 | /**
1447 | ** Hmmm ... bourne shell types ;-(
1448 | ** Need to unset a function in case of sh or if the alias took parameters
1449 | **/
1450 | } else if( !strcmp( shell_derelict, "sh")) {
1451 |
1452 | if( !strcmp( shell_name, "sh")) {
1453 | if (bourne_alias) {
1454 | fprintf(aliasfile, "unalias %s%c", alias, alias_separator);
1455 | } else if (bourne_funcs) {
1456 | fprintf(aliasfile,"unset -f %s%c", alias, alias_separator);
1457 | } /* else do nothing */
1458 | /**
1459 | ** BASH
1460 | **/
1461 | } else if( !strcmp( shell_name, "bash")) {
1462 |
1463 | /**
1464 | ** If we have what the old value should have been, then look to
1465 | ** see if it was a function or an alias because bash spits out an
1466 | ** error if you try to unalias a non-existent alias.
1467 | **/
1468 | if(val) {
1469 |
1470 | /**
1471 | ** Was it a function?
1472 | ** Yes, if it has arguments...
1473 | **/
1474 | while( *cptr) {
1475 | if( *cptr == '\\') {
1476 | if( nobackslash) {
1477 | nobackslash = 0;
1478 | }
1479 | } else {
1480 | if(*cptr == '$') {
1481 | if( nobackslash) {
1482 | fprintf(aliasfile, "unset -f %s%c", alias,
1483 | alias_separator);
1484 | return TCL_OK;
1485 | }
1486 | }
1487 | nobackslash = 1;
1488 | }
1489 | cptr++;
1490 | }
1491 |
1492 | /**
1493 | ** Well, it wasn't a function, so we'll put out an unalias...
1494 | **/
1495 | fprintf( aliasfile, "unalias %s%c", alias, alias_separator);
1496 |
1497 | } else { /** No value known (any more?) **/
1498 |
1499 | /**
1500 | ** We'll assume it was a function because the unalias command
1501 | ** in bash produces an error. It's possible that the alias
1502 | ** will not be cleared properly here because it was an
1503 | ** unset-alias command.
1504 | **/
1505 | fprintf( aliasfile, "unset -f %s%c", alias, alias_separator);
1506 | }
1507 |
1508 | /**
1509 | ** ZSH or KSH
1510 | ** Put out both because we it could be either a function or an
1511 | ** alias. This will catch both.
1512 | **/
1513 |
1514 | } else if( !strcmp( shell_name, "zsh")){
1515 |
1516 | fprintf(aliasfile, "unalias %s%c", alias, alias_separator);
1517 |
1518 | } else if( !strcmp( shell_name, "ksh")) {
1519 |
1520 | fprintf(aliasfile, "unalias %s%c", alias, alias_separator);
1521 | fprintf(aliasfile, "unset -f %s%c", alias, alias_separator);
1522 |
1523 | } /** if( bash, zsh, ksh) **/
1524 |
1525 | /** ??? Unknown derelict ??? **/
1526 |
1527 | } /** if( sh-family) **/
1528 |
1529 | return( TCL_OK);
1530 |
1531 | } /** End of 'output_unset_alias' **/
1532 |
1533 | /*++++
1534 | ** ** Function-Header ***************************************************** **
1535 | ** **
1536 | ** Function: getLMFILES **
1537 | ** **
1538 | ** Description: Read in the _LMFILES_ environment variable. This one **
1539 | ** may be split into several variables cause by limited **
1540 | ** variable space of some shells (esp. the SUN csh) **
1541 | ** **
1542 | ** First Edition: 1991/10/23 **
1543 | ** **
1544 | ** Parameters: Tcl_Interp *interp Attached Tcl interpreter **
1545 | ** **
1546 | ** Result: char* Value of the environment varibale _LMFILES_ **
1547 | ** **
1548 | ** Attached Globals: **
1549 | ** **
1550 | ** ************************************************************************ **
1551 | ++++*/
1552 |
1553 | char *getLMFILES( Tcl_Interp *interp)
1554 | {
1555 | static char *lmfiles = NULL; /** Buffer pointer for the value **/
1556 |
1557 | #if WITH_DEBUGGING_UTIL_2
1558 | ErrorLogger( NO_ERR_START, LOC, _proc_getLMFILES, NULL);
1559 | #endif
1560 |
1561 | /**
1562 | ** Try to read the variable _LMFILES_. If the according buffer pointer
1563 | ** contains a value, disallocate it before.
1564 | **/
1565 | if( lmfiles)
1566 | null_free((void *) &lmfiles);
1567 |
1568 | lmfiles = (char *) Tcl_GetVar2( interp, "env","_LMFILES_",TCL_GLOBAL_ONLY);
1569 |
1570 | /**
1571 | ** Now the pointer is NULL in case of the variable has not been defined.
1572 | ** In this case try to read in the splitted variable from _LMFILES_xxx
1573 | **/
1574 | if( !lmfiles) {
1575 |
1576 | char buffer[ MOD_BUFSIZE]; /** Used to set up the split variab- **/
1577 | /** les name **/
1578 | int count = 0; /** Split part count **/
1579 | int lmsize = 0; /** Total size of _LMFILES_ content **/
1580 | int old_lmsize; /** Size save buffer **/
1581 | int cptr_len; /** Size of the current split part **/
1582 | char *cptr; /** Split part read pointer **/
1583 |
1584 | /**
1585 | ** Set up the split part environment variable name and try to read it
1586 | ** in
1587 | **/
1588 | sprintf( buffer, "_LMFILES_%03d", count++);
1589 | cptr = (char *) Tcl_GetVar2( interp, "env", buffer, TCL_GLOBAL_ONLY);
1590 |
1591 | while( cptr) { /** Something available **/
1592 |
1593 | /**
1594 | ** Count up the variables length
1595 | **/
1596 | cptr_len = strlen( cptr);
1597 | old_lmsize = lmsize;
1598 | lmsize += cptr_len;
1599 |
1600 | /**
1601 | ** Reallocate the value's buffer and copy the current split
1602 | ** part at its end
1603 | **/
1604 | if((char *) NULL == (lmfiles =
1605 | (char*) realloc( lmfiles, lmsize * sizeof(char) + 1))) {
1606 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
1607 | return( NULL); /** ---- EXIT (FAILURE) ---> **/
1608 | }
1609 |
1610 | strncpy( lmfiles + old_lmsize, cptr, cptr_len);
1611 | *(lmfiles + old_lmsize + cptr_len) = '\0';
1612 |
1613 | /**
1614 | ** Read the next split part variable
1615 | **/
1616 | sprintf( buffer, "_LMFILES_%03d", count++);
1617 | cptr = (char *) Tcl_GetVar2( interp,"env",buffer, TCL_GLOBAL_ONLY);
1618 | }
1619 |
1620 | } else { /** if( lmfiles) **/
1621 |
1622 | /**
1623 | ** If the environvariable _LMFILES_ has been set, copy the contents
1624 | ** of the returned buffer into a free allocated one in order to
1625 | ** avoid side effects.
1626 | **/
1627 | char *tmp = strdup(lmfiles);
1628 |
1629 | if( !tmp)
1630 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
1631 | return( NULL); /** -------- EXIT (FAILURE) -------> **/
1632 |
1633 | /**
1634 | ** Set up lmfiles pointing to the new buffer in order to be able to
1635 | ** disallocate when invoked next time.
1636 | **/
1637 | lmfiles = tmp;
1638 |
1639 | } /** if( lmfiles) **/
1640 |
1641 | /**
1642 | ** Return the received value to the caller
1643 | **/
1644 | return( lmfiles);
1645 |
1646 | } /** end of 'getLMFILES' **/
1647 |
1648 | /*++++
1649 | ** ** Function-Header ***************************************************** **
1650 | ** **
1651 | ** Function: IsLoaded **
1652 | ** **
1653 | ** Description: Check wether the passed modulefile is cirrently **
1654 | ** loaded **
1655 | ** **
1656 | ** First Edition: 1991/10/23 **
1657 | ** **
1658 | ** Parameters: Tcl_Interp *interp According Tcl interp.**
1659 | ** char *modulename Name of the module to**
1660 | ** be searched for **
1661 | ** char **realname Buffer for the name **
1662 | ** and version of the **
1663 | ** module that has mat- **
1664 | ** ched the query **
1665 | ** char *filename Buffer to store the **
1666 | ** whole filename of a **
1667 | ** found loaded module **
1668 | ** **
1669 | ** Result: int 0 Requested module not loaded **
1670 | ** 1 module is loaded **
1671 | ** **
1672 | ** realname points to the name of the module that**
1673 | ** has matched the query. If this poin- **
1674 | ** differs form 'modulename' after this **
1675 | ** function has finished, the buffer for**
1676 | ** to store the module name in has been **
1677 | ** allocated here. **
1678 | ** if (char **) NULL is passed, no buf- **
1679 | ** fer will be allocated **
1680 | ** ??? Is this freed correctly by the caller ???**
1681 | ** **
1682 | ** filename will be filled with the full module **
1683 | ** file path of the module that has **
1684 | ** matched the query **
1685 | ** **
1686 | ** Attached Globals: **
1687 | ** **
1688 | ** ************************************************************************ **
1689 | ++++*/
1690 |
1691 | /**
1692 | ** Check all possibilities of module-versions
1693 | **/
1694 |
1695 | int IsLoaded( Tcl_Interp *interp,
1696 | char *modulename,
1697 | char **realname,
1698 | char *filename )
1699 | {
1700 | return( __IsLoaded( interp, modulename, realname, filename, 0));
1701 | }
1702 |
1703 | /**
1704 | ** Check only an exact match of the passed module and version
1705 | **/
1706 | int IsLoaded_ExactMatch( Tcl_Interp *interp,
1707 | char *modulename,
1708 | char **realname,
1709 | char *filename )
1710 | {
1711 | return( __IsLoaded( interp, modulename, realname, filename, 1));
1712 | }
1713 |
1714 | /**
1715 | ** The subroutine __IsLoaded finally checks for the requested module being
1716 | ** loaded or not.
1717 | **/
1718 | static int __IsLoaded( Tcl_Interp *interp,
1719 | char *modulename,
1720 | char **realname,
1721 | char *filename,
1722 | int exact)
1723 | {
1724 | char *l_modules = NULL; /** Internal module list buffer **/
1725 | char *l_modulefiles = NULL; /** Internal module file list buffer **/
1726 | char *loaded = NULL; /** Buffer for the module **/
1727 | char *basename = NULL; /** Pointer to module basename **/
1728 | char *loadedmodule_path = NULL; /** Pointer to one loaded module out **/
1729 | /** of the loaded modules list **/
1730 | int count = 0;
1731 |
1732 | /**
1733 | ** Get a list of loaded modules (environment variable 'LOADEDMODULES')
1734 | ** and the list of loaded module-files (env. var. __LMFILES__)
1735 | **/
1736 | char *loaded_modules = (char *) Tcl_GetVar2( interp, "env",
1737 | "LOADEDMODULES", TCL_GLOBAL_ONLY);
1738 | char *loaded_modulefiles = getLMFILES( interp);
1739 |
1740 | #if WITH_DEBUGGING_UTIL_2
1741 | ErrorLogger( NO_ERR_START, LOC, _proc___IsLoaded, NULL);
1742 | #endif
1743 |
1744 | /**
1745 | ** If no module is currently loaded ... the requested module is surely
1746 | ** not loaded, too ;-)
1747 | **/
1748 | if( !loaded_modules)
1749 | goto unwind0;
1750 |
1751 | /**
1752 | ** Copy the list of currently loaded modules into a new allocated array
1753 | ** for further handling. If this fails it will be assumed, that the
1754 | ** module is *NOT* loaded.
1755 | **/
1756 | if((char *) NULL == (l_modules = stringer(NULL,0,loaded_modules,NULL)))
1757 | if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
1758 | goto unwind0;
1759 |
1760 | /**
1761 | ** Copy the list of currently loaded modulefiles into a new allocated
1762 | ** array for further handling. If this failes it will be assumed, that
1763 | ** the module is *NOT* loaded.
1764 | **/
1765 | if(loaded_modulefiles)
1766 | if((char *) NULL == (l_modulefiles = stringer(NULL,0,
1767 | loaded_modulefiles,NULL)))
1768 | if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
1769 | goto unwind1;
1770 |
1771 | /**
1772 | ** Assume the modulename given was an exact match so there is no
1773 | ** difference to return -- this will change in the case it wasn't an
1774 | ** exact match below
1775 | **/
1776 | if( realname)
1777 | *realname = modulename;
1778 |
1779 | if( *l_modules) {
1780 |
1781 | /**
1782 | ** Get each single module which is loaded by splitting up at colons
1783 | ** The variable LOADEDMODULES contains a list of modulefile like the
1784 | ** following:
1785 | ** gnu/2.0:openwin/3.0
1786 | **/
1787 | loadedmodule_path = strtok( l_modules, ":");
1788 | while( loadedmodule_path) {
1789 |
1790 | if((char *) NULL == (loaded = stringer(NULL,0,
1791 | loadedmodule_path,NULL)))
1792 | if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
1793 | goto unwind2;
1794 |
1795 | /**
1796 | ** Get a modulefile without a version and check if this is the
1797 | ** requested one.
1798 | **/
1799 | if( !strcmp( loaded, modulename)) { /** FOUND **/
1800 |
1801 | null_free ((void *) &loaded);
1802 | break; /** leave the while loop **/
1803 |
1804 | } else if( !exact) { /** NOT FOUND **/
1805 |
1806 | /**
1807 | ** Try to more and more simplify the modulename by removing
1808 | ** all detail (version) information
1809 | **/
1810 | basename = get_module_basename( loaded);
1811 | while( basename && strcmp( basename, modulename)) {
1812 | basename = get_module_basename( basename);
1813 | }
1814 |
1815 | /**
1816 | ** Something left after splitting again? If yes the requested
1817 | ** module is found!
1818 | ** Since the name given was a basename, return the fully
1819 | ** loaded path
1820 | **/
1821 | if( basename) {
1822 | null_free ((void *) &loaded);
1823 | if( realname)
1824 | if((char *) NULL == (*realname = stringer(NULL,0,
1825 | loadedmodule_path,NULL)))
1826 | if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
1827 | goto unwind2;
1828 |
1829 | break; /** leave the while loop **/
1830 |
1831 | } /** if( basename) **/
1832 | } /** if not found with single basename **/
1833 |
1834 | /**
1835 | ** Get the next entry from the loaded modules list
1836 | **/
1837 | loadedmodule_path = strtok( NULL, ":");
1838 | count++;
1839 |
1840 | null_free ((void *) &loaded); /** Free what has been alloc. **/
1841 |
1842 | } /** while **/
1843 | } /** if( *l_modules) **/
1844 |
1845 | /**
1846 | ** If we found something locate it's associated modulefile
1847 | **/
1848 | if( loadedmodule_path) {
1849 | if( filename && l_modulefiles && *l_modulefiles) {
1850 |
1851 | /**
1852 | ** The position of the loaded module within the list of loaded
1853 | ** modules has been counted in 'count'. The position of the
1854 | ** associated modulefile should be the same. So tokenize the
1855 | ** list of modulefiles by the colon until the wanted position
1856 | ** is reached.
1857 | **/
1858 | char* modulefile_path = strtok(l_modulefiles, ":");
1859 |
1860 | while( count) {
1861 | if( !( modulefile_path = strtok( NULL, ":"))) {
1862 |
1863 | /**
1864 | ** Oops! Fewer entries in the list of loaded modulefiles
1865 | ** than in the list of loaded modules. This will
1866 | ** generally suggest that _LMFILES_ has become corrupted,
1867 | ** but it may just mean we're working intermittantly with
1868 | ** an old version. So, I'll just not touch filename which
1869 | ** means the search will continue using the old method of
1870 | ** looking through MODULEPATH.
1871 | */
1872 | goto success0;
1873 | }
1874 | count--;
1875 |
1876 | } /** while **/
1877 |
1878 | /**
1879 | ** Copy the result into the buffer passed from the caller
1880 | **/
1881 | strcpy( filename, modulefile_path);
1882 | }
1883 |
1884 | /**
1885 | ** FOUND.
1886 | ** free up everything which has been allocated and return on success
1887 | **/
1888 | goto success0;
1889 | }
1890 |
1891 | /**
1892 | ** NOT FOUND. Free up everything which has been alloc'd and return on
1893 | ** failure
1894 | **/
1895 |
1896 | unwind2:
1897 | if( l_modulefiles)
1898 | null_free((void *) &l_modulefiles);
1899 | unwind1:
1900 | null_free((void *) &l_modules);
1901 | unwind0:
1902 | return( 0); /** -------- EXIT (FAILURE) -------> **/
1903 |
1904 | success0:
1905 | if( l_modulefiles)
1906 | null_free((void *) &l_modulefiles);
1907 | null_free((void *) &l_modules);
1908 | return( 1); /** -------- EXIT (SUCCESS) -------> **/
1909 |
1910 | } /** End of '__IsLoaded' **/
1911 |
1912 | /*++++
1913 | ** ** Function-Header ***************************************************** **
1914 | ** **
1915 | ** Function: chk_marked_entry, set_marked_entry **
1916 | ** **
1917 | ** Description: When switching, the variables are marked with a mar- **
1918 | ** ker that is tested to see if the variable was changed**
1919 | ** in the second modulefile. If it was not, then the **
1920 | ** variable is unset. **
1921 | ** **
1922 | ** First Edition: 1992/10/25 **
1923 | ** **
1924 | ** Parameters: Tcl_HashTable *table Attached hash table **
1925 | ** char *var According variable name **
1926 | ** int val Value to be set. **
1927 | ** **
1928 | ** Result: int 0 Mark not set (or the value of the **
1929 | ** mark was 0 ;-) **
1930 | ** else Value of the mark that has been set **
1931 | ** with set_marked_entry. **
1932 | ** Attached Globals: - **
1933 | ** **
1934 | ** ************************************************************************ **
1935 | ++++*/
1936 |
1937 | intptr_t chk_marked_entry( Tcl_HashTable *table,
1938 | char *var)
1939 | {
1940 | Tcl_HashEntry *hentry;
1941 |
1942 | #if WITH_DEBUGGING_UTIL_2
1943 | ErrorLogger( NO_ERR_START, LOC, _proc_chk_marked_entry, NULL);
1944 | #endif
1945 |
1946 | if( hentry = Tcl_FindHashEntry( table, var))
1947 | return((intptr_t) Tcl_GetHashValue( hentry));
1948 | else
1949 | return 0;
1950 | }
1951 |
1952 | void set_marked_entry( Tcl_HashTable *table,
1953 | char *var,
1954 | intptr_t val)
1955 | {
1956 | Tcl_HashEntry *hentry;
1957 | int new;
1958 |
1959 | #if WITH_DEBUGGING_UTIL_2
1960 | ErrorLogger( NO_ERR_START, LOC, _proc_set_marked_entry, NULL);
1961 | #endif
1962 |
1963 | if( hentry = Tcl_CreateHashEntry( table, var, &new)) {
1964 | if( val)
1965 | Tcl_SetHashValue( hentry, val);
1966 | }
1967 |
1968 | /** ??? Shouldn't there be an error return in case of hash creation
1969 | failing ??? **/
1970 | }
1971 |
1972 | /*++++
1973 | ** ** Function-Header ***************************************************** **
1974 | ** **
1975 | ** Function: get_module_basename **
1976 | ** **
1977 | ** Description: Get the name of a module without its version. **
1978 | ** This function modifies the string passed in. **
1979 | ** **
1980 | ** First Edition: 1991/10/23 **
1981 | ** **
1982 | ** Parameters: char *modulename Full module name **
1983 | ** **
1984 | ** Result: char* Module name without version **
1985 | ** **
1986 | ** Attached Globals: **
1987 | ** **
1988 | ** ************************************************************************ **
1989 | ++++*/
1990 |
1991 | static char *get_module_basename( char *modulename)
1992 | {
1993 | char *version; /** Used to locate the version sep. **/
1994 |
1995 | #if WITH_DEBUGGING_UTIL_2
1996 | ErrorLogger( NO_ERR_START, LOC, _proc_get_module_basename, NULL);
1997 | #endif
1998 |
1999 | /**
2000 | ** Use strrchr to locate the very last version string on the module
2001 | ** name.
2002 | **/
2003 | if((version = strrchr( modulename, '/'))) {
2004 | *version = '\0';
2005 | } else {
2006 | modulename = NULL;
2007 | }
2008 |
2009 | /**
2010 | ** Return the *COPIED* string
2011 | **/
2012 | return( modulename);
2013 |
2014 | } /** End of 'get_module_basename' **/
2015 |
2016 | /*++++
2017 | ** ** Function-Header ***************************************************** **
2018 | ** **
2019 | ** Function: Update_LoadedList **
2020 | ** **
2021 | ** Description: Add or remove the passed modulename and filename to/ **
2022 | ** from LOADEDMODULES and _LMFILES_ **
2023 | ** **
2024 | ** First Edition: 1991/10/23 **
2025 | ** **
2026 | ** Parameters: Tcl_Interp *interp Attached Tcl Interp. **
2027 | ** char *modulename Name of the module **
2028 | ** char *filename Full path name of the**
2029 | ** related modulefile **
2030 | ** **
2031 | ** Result: int 1 Successfull operation **
2032 | ** **
2033 | ** Attached Globals: g_flags Controls whether the modulename **
2034 | ** should be added (M_XXXX) or removed **
2035 | ** (M_REMOVE) from the list of loaded **
2036 | ** modules **
2037 | ** **
2038 | ** ************************************************************************ **
2039 | ++++*/
2040 |
2041 | int Update_LoadedList( Tcl_Interp *interp,
2042 | char *modulename,
2043 | char *filename)
2044 | {
2045 | char *argv[4];
2046 | char *basename;
2047 | char *module;
2048 |
2049 | #if WITH_DEBUGGING_UTIL_2
2050 | ErrorLogger( NO_ERR_START, LOC, _proc_Update_LoadedList, NULL);
2051 | #endif
2052 |
2053 | /**
2054 | ** Apply changes to LOADEDMODULES first
2055 | **/
2056 | argv[1] = "LOADEDMODULES";
2057 | argv[2] = modulename;
2058 | argv[3] = NULL;
2059 |
2060 | if(g_flags & M_REMOVE) {
2061 | argv[0] = "remove-path";
2062 | cmdRemovePath( 0, interp, 3, (CONST84 char **) argv);
2063 | } else {
2064 | argv[0] = "append-path";
2065 | cmdSetPath( 0, interp, 3, (CONST84 char **) argv);
2066 | }
2067 |
2068 | /**
2069 | ** Apply changes to _LMFILES_ now
2070 | **/
2071 | argv[1] = "_LMFILES_";
2072 | argv[2] = filename;
2073 | argv[3] = NULL;
2074 |
2075 | if(g_flags & M_REMOVE) {
2076 | argv[0] = "remove-path";
2077 | cmdRemovePath( 0, interp, 3, (CONST84 char **) argv);
2078 | } else {
2079 | argv[0] = "append-path";
2080 | cmdSetPath( 0, interp, 3, (CONST84 char **) argv);
2081 | }
2082 |
2083 | /**
2084 | ** A module with just the basename might have been added and now we're
2085 | ** removing one of its versions. We'll want to look for the basename in
2086 | ** the path too.
2087 | **/
2088 | if( g_flags & M_REMOVE) {
2089 | module = strdup( modulename);
2090 | basename = module;
2091 | if( basename = get_module_basename( basename)) {
2092 | argv[2] = basename;
2093 | argv[0] = "remove-path";
2094 | cmdRemovePath( 0, interp, 3, (CONST84 char **) argv);
2095 | }
2096 | null_free((void *) &module);
2097 | }
2098 |
2099 | /**
2100 | ** Return on success
2101 | **/
2102 | return( 1);
2103 |
2104 | } /** End of 'Update_LoadedList' **/
2105 |
2106 | /*++++
2107 | ** ** Function-Header ***************************************************** **
2108 | ** **
2109 | ** Function: check_magic **
2110 | ** **
2111 | ** Description: Check the magic cookie of the file passed as para- **
2112 | ** meter if it is a valid module file **
2113 | ** Based on check_magic in Richard Elling's **
2114 | ** find_by_magic <Richard.Elling"@eng.auburn.edu> **
2115 | ** **
2116 | ** First Edition: 1991/10/23 **
2117 | ** **
2118 | ** Parameters: char *filename Name of the file to check **
2119 | ** char *magic_name Magic cookie **
2120 | ** int magic_len Length of the magic cookie **
2121 | ** **
2122 | ** Result: int 0 Magic cookie doesn't match or any **
2123 | ** I/O error **
2124 | ** 1 Success - Magic cookie has matched **
2125 | ** **
2126 | ** Attached Globals: - **
2127 | ** **
2128 | ** ************************************************************************ **
2129 | ++++*/
2130 |
2131 | int check_magic( char *filename,
2132 | char *magic_name,
2133 | int magic_len)
2134 | {
2135 | int fd; /** File descriptor for reading in **/
2136 | int read_len; /** Number of bytes read **/
2137 | char buf[BUFSIZ]; /** Read buffer **/
2138 |
2139 | #if WITH_DEBUGGING_UTIL_2
2140 | ErrorLogger( NO_ERR_START, LOC, _proc_check_magic, NULL);
2141 | #endif
2142 |
2143 | /**
2144 | ** Parameter check. The length of the magic cookie shouldn't exceed the
2145 | ** length of out read buffer
2146 | **/
2147 | if( magic_len > BUFSIZ)
2148 | return 0;
2149 |
2150 | /**
2151 | ** Open the file and read in as many bytes as required for checking the
2152 | ** magic cookie. If there's an I/O error (Unable to open the file or
2153 | ** less than magic_len have been read) return on failure.
2154 | **/
2155 | if( 0 > (fd = open( filename, O_RDONLY)))
2156 | if( OK != ErrorLogger( ERR_OPEN, LOC, filename, "reading", NULL))
2157 | return( 0); /** -------- EXIT (FAILURE) -------> **/
2158 |
2159 | read_len = read( fd, buf, magic_len);
2160 |
2161 | if( 0 > close(fd))
2162 | if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
2163 | return( 0); /** -------- EXIT (FAILURE) -------> **/
2164 |
2165 | if( read_len < magic_len)
2166 | return( 0);
2167 |
2168 | /**
2169 | ** Check the magic cookie now
2170 | **/
2171 | return( !strncmp( buf, magic_name, magic_len));
2172 |
2173 | } /** end of 'check_magic' **/
2174 |
2175 | /*++++
2176 | ** ** Function-Header ***************************************************** **
2177 | ** **
2178 | ** Function: cleanse_path **
2179 | ** **
2180 | ** Description: Copy the passed path into the new path buffer and **
2181 | ** devalue '.' and '+' **
2182 | ** **
2183 | ** First Edition: 1991/10/23 **
2184 | ** **
2185 | ** Parameters: const char *path Original path **
2186 | ** char *newpath Buffer for to copy the new **
2187 | ** path in **
2188 | ** int len Max length of the new path **
2189 | ** **
2190 | ** Result: newpath will be filled up with the new, de- **
2191 | ** valuated path **
2192 | ** **
2193 | ** Attached Globals: - **
2194 | ** **
2195 | ** ************************************************************************ **
2196 | ++++*/
2197 |
2198 | void cleanse_path( const char *path,
2199 | char *newpath,
2200 | int len)
2201 | {
2202 | unsigned int path_len = strlen( path); /** Length of the orig. path **/
2203 | int i, /** Read index **/
2204 | j; /** Write index **/
2205 |
2206 | #if WITH_DEBUGGING_UTIL_2
2207 | ErrorLogger( NO_ERR_START, LOC, _proc_cleanse_path, NULL);
2208 | #endif
2209 |
2210 | /**
2211 | ** Stopping at (len - 1) ensures that the newpath string can be
2212 | ** null-terminated below.
2213 | **/
2214 | for( i=0, j=0; i<path_len && j<(len - 1); i++, j++) {
2215 |
2216 | switch(*path) {
2217 | case '.':
2218 | case '+':
2219 | *newpath++ = '\\'; /** devalue '.' and '+' **/
2220 | j++;
2221 | break;
2222 | }
2223 |
2224 | /**
2225 | ** Flush the current character into the newpath buffer
2226 | **/
2227 | *newpath++ = *path++;
2228 |
2229 | } /** for **/
2230 |
2231 | /**
2232 | ** Put a string terminator at the newpaths end
2233 | **/
2234 | *newpath = '\0';
2235 |
2236 | } /** End of 'cleanse_path' **/
2237 |
2238 | /*++++
2239 | ** ** Function-Header ***************************************************** **
2240 | ** **
2241 | ** Function: chop **
2242 | ** **
2243 | ** Description: Remove '\n' characters from the passed string **
2244 | ** **
2245 | ** First Edition: 1991/10/23 **
2246 | ** **
2247 | ** Parameters: char *string String to be chopped **
2248 | ** **
2249 | ** Result: string The chopped string **
2250 | ** **
2251 | ** Attached Globals: - **
2252 | ** **
2253 | ** ************************************************************************ **
2254 | ++++*/
2255 |
2256 | static char *chop( const char *string)
2257 | {
2258 | char *s, *t; /** source and target pointers **/
2259 |
2260 | #if WITH_DEBUGGING_UTIL_2
2261 | ErrorLogger( NO_ERR_START, LOC, _proc_chop, NULL);
2262 | #endif
2263 |
2264 | /**
2265 | ** Remove '\n'
2266 | **/
2267 |
2268 | s = t = (char *) string;
2269 | while( *s) {
2270 | if( '\n' == *s)
2271 | s++;
2272 | else
2273 | *t++ = *s++;
2274 | }
2275 |
2276 | /**
2277 | ** Copy the trailing terminator and return
2278 | **/
2279 | *t++ = '\0';
2280 | return( (char *) string);
2281 |
2282 | } /** End of 'chop' **/
2283 |
2284 | #ifndef HAVE_STRDUP
2285 |
2286 | /*++++
2287 | ** ** Function-Header ***************************************************** **
2288 | ** **
2289 | ** Function: strdup **
2290 | ** **
2291 | ** Description: Makes new space to put a copy of the given string **
2292 | ** into and then copies the string into the new space. **
2293 | ** Just like the "standard" strdup(3). **
2294 | ** **
2295 | ** First Edition: 1991/10/23 **
2296 | ** **
2297 | ** Parameters: **
2298 | ** Result: **
2299 | ** Attached Globals: **
2300 | ** **
2301 | ** ************************************************************************ **
2302 | ++++*/
2303 |
2304 | char *strdup( char *str)
2305 | {
2306 | char* new;
2307 | if ((char *) NULL) == (new = stringer(NULL,0, str, NULL))
2308 | if( OK != ErrorLogger( ERR_STRING, LOC, filename, NULL))
2309 | return( (char*) NULL); /** -------- EXIT (FAILURE) -------> **/
2310 | return( new); /** -------- EXIT (SUCCESS) -------> **/
2311 | }
2312 | #endif /* HAVE_STRDUP */
2313 |
2314 | #ifndef HAVE_STRTOK
2315 |
2316 | /*++++
2317 | ** ** Function-Header ***************************************************** **
2318 | ** **
2319 | ** Function: strtok **
2320 | ** **
2321 | ** Description: Considers the string s1 to consist of a sequence of **
2322 | ** zero or more text tokens separated by spans of one **
2323 | ** or more characters from the separator string s2. **
2324 | ** Just like the "standard" strtok(3). **
2325 | ** **
2326 | ** Note: This function is from the Berkeley BSD distribution. **
2327 | ** It was modified to fit our needs! **
2328 | ** **
2329 | ** First Edition: 1991/10/23 **
2330 | ** **
2331 | ** Parameters: **
2332 | ** Result: **
2333 | ** Attached Globals: **
2334 | ** **
2335 | ** ************************************************************************ **
2336 | ++++*/
2337 |
2338 | /*
2339 | * Copyright (c) 1988 Regents of the University of California.
2340 | * All rights reserved.
2341 | *
2342 | * Redistribution and use in source and binary forms, with or without
2343 | * modification, are permitted provided that the following conditions
2344 | * are met:
2345 | * 1. Redistributions of source code must retain the above copyright
2346 | * notice, this list of conditions and the following disclaimer.
2347 | * 2. Redistributions in binary form must reproduce the above copyright
2348 | * notice, this list of conditions and the following disclaimer in the
2349 | * documentation and/or other materials provided with the distribution.
2350 | * 3. All advertising materials mentioning features or use of this software
2351 | * must display the following acknowledgement:
2352 | * This product includes software developed by the University of
2353 | * California, Berkeley and its contributors.
2354 | * 4. Neither the name of the University nor the names of its contributors
2355 | * may be used to endorse or promote products derived from this software
2356 | * without specific prior written permission.
2357 | *
2358 | * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
2359 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
2360 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
2361 | * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
2362 | * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
2363 | * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
2364 | * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
2365 | * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
2366 | * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
2367 | * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
2368 | * SUCH DAMAGE.
2369 | */
2370 |
2371 | char *strtok( char *s,
2372 | const char *delim)
2373 | {
2374 | register char *spanp;
2375 | register int c, sc;
2376 | char *tok;
2377 | static char *last;
2378 |
2379 |
2380 | if( s == NULL && (s = last) == NULL)
2381 | return (NULL);
2382 |
2383 | /*
2384 | * Skip (span) leading delimiters (s += strspn(s, delim), sort of).
2385 | */
2386 | cont:
2387 | c = *s++;
2388 | for( spanp = (char *)delim; (sc = *spanp++) != 0;) {
2389 | if (c == sc)
2390 | goto cont;
2391 | }
2392 |
2393 | if( !c) { /* no non-delimiter characters */
2394 | last = NULL;
2395 | return (NULL);
2396 | }
2397 | tok = s - 1;
2398 |
2399 | /*
2400 | * Scan token (scan for delimiters: s += strcspn(s, delim), sort of).
2401 | * Note that delim must have one NUL; we stop if we see that, too.
2402 | */
2403 | for (;;) {
2404 | c = *s++;
2405 | spanp = (char *)delim;
2406 | do {
2407 | if ((sc = *spanp++) == c) {
2408 | if (c == 0)
2409 | s = NULL;
2410 | else
2411 | s[-1] = 0;
2412 | last = s;
2413 | return (tok);
2414 | }
2415 | } while (sc != 0);
2416 | }
2417 | /* NOTREACHED */
2418 |
2419 | } /** End of 'strtok' **/
2420 | #endif
2421 |
2422 | /*++++
2423 | ** ** Function-Header ***************************************************** **
2424 | ** **
2425 | ** Function: chk4spch **
2426 | ** **
2427 | ** Description: goes through the given string and changes any non- **
2428 | ** printable characters to question marks. **
2429 | ** **
2430 | ** First Edition: 1991/10/23 **
2431 | ** **
2432 | ** Parameters: char *s String to be checke **
2433 | ** **
2434 | ** Result: *s Will be changed accordingly **
2435 | ** **
2436 | ** Attached Globals: - **
2437 | ** **
2438 | ** ************************************************************************ **
2439 | ++++*/
2440 |
2441 | void chk4spch(char* s)
2442 | {
2443 | for( ; *s; s++)
2444 | if( !isgraph( *s)) *s = '?';
2445 |
2446 | } /** End of 'chk4spch' **/
2447 |
2448 | /*++++
2449 | ** ** Function-Header ***************************************************** **
2450 | ** **
2451 | ** Function: xdup **
2452 | ** **
2453 | ** Description: will return a string with 1 level of environment **
2454 | ** variables expanded. The limit is MOD_BUFSIZE. **
2455 | ** An env.var. is denoted with either $name or ${name} **
2456 | ** \$ escapes the expansion and substitutes a '$' in **
2457 | ** its place. **
2458 | ** **
2459 | ** First Edition: 2000/01/21 R.K.Owen <rk@owen.sj.ca.us> **
2460 | ** **
2461 | ** Parameters: char *string Environment variable **
2462 | ** **
2463 | ** Result: char * An allocated string **
2464 | ** **
2465 | ** ************************************************************************ **
2466 | ++++*/
2467 |
2468 |
2469 | char *xdup(char const *string) {
2470 | char *result = NULL;
2471 | char *dollarptr;
2472 |
2473 | if (string == (char *)NULL) return result;
2474 |
2475 | /** need to work from copy of string **/
2476 | if (((char *) NULL) == (result = stringer(NULL,0, string, NULL)))
2477 | if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
2478 | return( (char*) NULL); /** -------- EXIT (FAILURE) -------> **/
2479 |
2480 | /** check for '$' else just pass strdup of it **/
2481 | if ((dollarptr = strchr(result, '$')) == (char *) NULL) {
2482 | return result;
2483 | } else {
2484 | /** found something **/
2485 | char const *envvar;
2486 | char buffer[MOD_BUFSIZE];
2487 | char oldbuffer[MOD_BUFSIZE];
2488 | size_t blen = 0; /** running buffer length **/
2489 | char *slashptr = result;/** where to continue parsing **/
2490 | char slashchr; /** store slash char **/
2491 | int brace; /** flag if ${name} **/
2492 | pid_t pid; /** the process id **/
2493 |
2494 | /** zero out buffers */
2495 | memset( buffer, '\0', MOD_BUFSIZE);
2496 | memset(oldbuffer, '\0', MOD_BUFSIZE);
2497 |
2498 | /** copy everything upto $ into old buffer **/
2499 | *dollarptr = '\0';
2500 | strncpy(oldbuffer, slashptr, MOD_BUFSIZE);
2501 | *dollarptr = '$';
2502 |
2503 | while (dollarptr) {
2504 | if (*oldbuffer) strncpy(buffer, oldbuffer, MOD_BUFSIZE);
2505 | blen = strlen(buffer);
2506 |
2507 | /** get the env.var. name **/
2508 | if (*(dollarptr + 1) == '{') {
2509 | brace = 1;
2510 | slashptr = strchr(dollarptr + 1, '}');
2511 | } else if (*(dollarptr + 1) == '$') {
2512 | slashptr = dollarptr + 2;
2513 | } else {
2514 | slashptr = dollarptr + 1
2515 | + strcspn(dollarptr + 1,"/:$\\");
2516 | brace = 0;
2517 | }
2518 | if (*slashptr) {
2519 | slashchr = *slashptr;
2520 | *slashptr = '\0';
2521 | } else slashptr = (char *)NULL;
2522 |
2523 | /** see if escaped **/
2524 | if ((result != dollarptr) && *(dollarptr - 1) == '\\') {
2525 | /** replace \ with 0 and copy rest of name **/
2526 | buffer[blen - 1] = '\0';
2527 | strncat(buffer, dollarptr, MOD_BUFSIZE-blen);
2528 | blen = strlen(buffer);
2529 | if(brace)
2530 | strncat(buffer,"}",MOD_BUFSIZE-blen-1);
2531 | } else {
2532 | if (! strcmp(dollarptr + 1 + brace, "$")) {
2533 | /** put in the process pid **/
2534 | pid = getpid();
2535 | sprintf(buffer + blen,"%ld",(long)pid);
2536 | } else {
2537 | /** get env.var. value **/
2538 | envvar = getenv(dollarptr + 1 + brace);
2539 |
2540 | /** cat value to rest of string **/
2541 | if (envvar) strncat(buffer,envvar,
2542 | MOD_BUFSIZE-blen-1);
2543 | }
2544 | }
2545 | blen = strlen(buffer);
2546 |
2547 | /** start at slashptr and find next $ **/
2548 | if (slashptr) {
2549 | *slashptr = slashchr;
2550 | dollarptr = strchr(slashptr, '$');
2551 | /** copy everything upto $ **/
2552 | if (dollarptr) *dollarptr = '\0';
2553 | strncat(buffer, slashptr + brace,
2554 | MOD_BUFSIZE -blen -1);
2555 | if (dollarptr) {
2556 | *dollarptr = '$';
2557 | strncpy(oldbuffer, buffer, MOD_BUFSIZE);
2558 | }
2559 | } else { /** no more to show **/
2560 | dollarptr = (char *)NULL;
2561 | }
2562 | }
2563 | null_free((void *) &result);
2564 | return strdup(buffer);
2565 | }
2566 |
2567 | } /** End of 'xdup' **/
2568 |
2569 | /*++++
2570 | ** ** Function-Header ***************************************************** **
2571 | ** **
2572 | ** Function: xgetenv **
2573 | ** **
2574 | ** Description: will return an expanded environment variable. **
2575 | ** However, it will only expand 1 level. **
2576 | ** See xdup() for details. **
2577 | ** **
2578 | ** First Edition: 2000/01/18 R.K.Owen <rk@owen.sj.ca.us> **
2579 | ** **
2580 | ** Parameters: char *var Environment variable **
2581 | ** **
2582 | ** Result: char * An allocated string **
2583 | ** **
2584 | ** Attached Globals: - **
2585 | ** **
2586 | ** ************************************************************************ **
2587 | ++++*/
2588 |
2589 | char *xgetenv(char const * var) {
2590 | char *result = NULL;
2591 |
2592 | if (var == (char *)NULL) return result;
2593 |
2594 | return xdup(getenv(var));
2595 |
2596 | } /** End of 'xgetenv' **/
2597 |
2598 | /*++++
2599 | ** ** Function-Header ***************************************************** **
2600 | ** **
2601 | ** Function: EscapeCshString(char* in,char* out) **
2602 | ** **
2603 | ** Description: will translate input string to escaped output string **
2604 | ** out must be allocated first **
2605 | ** **
2606 | ** First Edition: 2002/04/10 **
2607 | ** **
2608 | ** Parameters: char *in input **
2609 | ** char *out output **
2610 | ** **
2611 | ** Attached Globals: - **
2612 | ** **
2613 | ** ************************************************************************ **
2614 | ++++*/
2615 |
2616 | void EscapeCshString(const char* in,
2617 | char* out) {
2618 |
2619 | for(;*in;in++) {
2620 | if (*in == ' ' ||
2621 | *in == '\t'||
2622 | *in == '\\'||
2623 | *in == '{' ||
2624 | *in == '}' ||
2625 | *in == '|' ||
2626 | *in == '<' ||
2627 | *in == '>' ||
2628 | *in == '!' ||
2629 | *in == '#' ||
2630 | *in == '$' ||
2631 | *in == '^' ||
2632 | *in == '&' ||
2633 | *in == '*' ||
2634 | *in == '\''||
2635 | *in == '"' ||
2636 | *in == '(' ||
2637 | *in == ')') {
2638 | *out++ = '\\';
2639 | }
2640 | *out++ = *in;
2641 | }
2642 | *out = 0;
2643 | }
2644 |
2645 | void EscapeShString(const char* in,
2646 | char* out) {
2647 |
2648 | for(;*in;in++) {
2649 | if (*in == ' ' ||
2650 | *in == '\t'||
2651 | *in == '\\'||
2652 | *in == '{' ||
2653 | *in == '}' ||
2654 | *in == '|' ||
2655 | *in == '<' ||
2656 | *in == '>' ||
2657 | *in == '!' ||
2658 | *in == '#' ||
2659 | *in == '$' ||
2660 | *in == '^' ||
2661 | *in == '&' ||
2662 | *in == '*' ||
2663 | *in == '\''||
2664 | *in == '"' ||
2665 | *in == '(' ||
2666 | *in == ')') {
2667 | *out++ = '\\';
2668 | }
2669 | *out++ = *in;
2670 | }
2671 | *out = 0;
2672 | }
2673 |
2674 | void EscapePerlString(const char* in,
2675 | char* out) {
2676 |
2677 | for(;*in;in++) {
2678 | if (*in == '\\'||
2679 | *in == '\'') {
2680 | *out++ = '\\';
2681 | }
2682 | *out++ = *in;
2683 | }
2684 | *out = 0;
2685 | }
2686 |
2687 | /*++++
2688 | ** ** Function-Header ***************************************************** **
2689 | ** **
2690 | ** Function: tmpfile_mod **
2691 | ** **
2692 | ** Description: emulates tempnam and tmpnam and mktemp **
2693 | ** Atomically creates a unique temp file and opens it **
2694 | ** for writing. returns 0 on success, 1 on failure **
2695 | ** Filename and file handle are returned through **
2696 | ** argument pointers **
2697 | ** **
2698 | ** First Edition: 2002/04/22 **
2699 | ** **
2700 | ** Parameters: char **filename pointer to char* **
2701 | ** char **file pointer to FILE* **
2702 | ** **
2703 | ** Attached Globals: - **
2704 | ** **
2705 | ** ************************************************************************ **
2706 | ++++*/
2707 |
2708 | int tmpfile_mod(char** filename, FILE** file) {
2709 | char* filename2;
2710 | FILE* f = NULL;
2711 | int trial = 0;
2712 |
2713 | if ((char *) NULL == (filename2 =
2714 | stringer(NULL, strlen(TMP_DIR)+strlen("modulesource")+20, NULL)))
2715 | if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
2716 | return 1;
2717 |
2718 | do {
2719 | int fildes;
2720 |
2721 | sprintf(filename2,"%s/modulesource_%d",TMP_DIR,trial++);
2722 | fildes = open(filename2,O_WRONLY | O_CREAT | O_EXCL | O_TRUNC,0755);
2723 | #if 0
2724 | fprintf(stderr,"DEBUG: filename=%s fildes=%d\n",
2725 | filename2,fildes);
2726 | #endif
2727 | if (fildes >=0) {
2728 | *file = fdopen(fildes,"w");
2729 | *filename = filename2;
2730 | return 0;
2731 | }
2732 | } while (trial < 1000);
2733 |
2734 | null_free((void *) &filename2);
2735 | fprintf(stderr,
2736 | "FATAL: could not get a temp file! at %s(%d)",__FILE__,__LINE__);
2737 |
2738 | return 1;
2739 | }
2740 |
2741 |
2742 | /*++++
2743 | ** ** Function-Header ***************************************************** **
2744 | ** **
2745 | ** Function: stringer **
2746 | ** **
2747 | ** Description: Safely copies and concats series of strings **
2748 | ** until it hits a NULL argument. **
2749 | ** Either a buffer & length are given or if the buffer **
2750 | ** pointer is NULL then it will allocate memory to the **
2751 | ** given length. If the length is 0 then get the length **
2752 | ** from the series of strings. **
2753 | ** The resultant buffer is returned unless there **
2754 | ** is an error then NULL is returned. **
2755 | ** (Therefore, one of the main uses of stringer is to **
2756 | ** allocate string memory.) **
2757 | ** **
2758 | ** **
2759 | ** First Edition: 2001/08/08 R.K.Owen <rk@owen.sj.ca.us> **
2760 | ** **
2761 | ** Parameters: char *buffer string buffer (if not NULL) **
2762 | ** int len maximum length of buffer **
2763 | ** const char *str1 1st string to copy to buffer **
2764 | ** const char *str2 2nd string to cat to buffer **
2765 | ** ... **
2766 | ** const char *strN Nth string to cat to buffer **
2767 | ** const char *NULL end of arguments **
2768 | ** **
2769 | ** Result: char *buffer if successfull completion **
2770 | ** else NULL **
2771 | ** **
2772 | ** Attached Globals: - **
2773 | ** **
2774 | ** ************************************************************************ **
2775 | ++++*/
2776 |
2777 | char *stringer( char * buffer,
2778 | int len,
2779 | ... )
2780 | {
2781 | va_list argptr; /** stdarg argument ptr **/
2782 | char *ptr; /** argument string ptr **/
2783 | char *tbuf = buffer; /** tempory buffer ptr **/
2784 | int sumlen = 0; /** length of all the concat strings **/
2785 | char *(*strfn)(char*,const char*) = strcpy;
2786 | /** ptr to 1st string function **/
2787 |
2788 | #if WITH_DEBUGGING_UTIL_2
2789 | ErrorLogger( NO_ERR_START, LOC, _proc_stringer, NULL);
2790 | #endif
2791 |
2792 | /* get start of optional arguments and sum string lengths */
2793 | va_start(argptr, len);
2794 | while ((ptr = va_arg(argptr, char *))) {
2795 | sumlen += strlen(ptr);
2796 | }
2797 | va_end(argptr);
2798 |
2799 | /* can we even proceed? */
2800 | if (tbuf && (sumlen >= len || len < 0)) {
2801 | return (char *) NULL;
2802 | }
2803 |
2804 | /* do we need to allocate memory? */
2805 | if (tbuf == (char *) NULL) {
2806 | if (len == 0) {
2807 | len = sumlen + 1;
2808 | }
2809 | if ((char *) NULL == (tbuf = (char*) malloc(len))) {
2810 | if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
2811 | return (char *) NULL;
2812 | }
2813 | }
2814 |
2815 | /* concat all the strings to buffer */
2816 | va_start(argptr, len);
2817 | while ((ptr = va_arg(argptr, char *))) {
2818 | strfn(tbuf, ptr);
2819 | strfn = strcat;
2820 | }
2821 | va_end(argptr);
2822 |
2823 | /* got here successfully - return buffer */
2824 | return tbuf;
2825 |
2826 | } /** End of 'stringer' **/
2827 |
2828 | /*++++
2829 | ** ** Function-Header ***************************************************** **
2830 | ** **
2831 | ** Function: null_free **
2832 | ** **
2833 | ** Description: does a free and then nulls the pointer. **
2834 | ** **
2835 | ** first edition: 2000/08/24 r.k.owen <rk@owen.sj.ca.us> **
2836 | ** **
2837 | ** parameters: void **var allocated memory **
2838 | ** **
2839 | ** result: void (nothing) **
2840 | ** **
2841 | ** attached globals: - **
2842 | ** **
2843 | ** ************************************************************************ **
2844 | ++++*/
2845 |
2846 | void null_free(void ** var) {
2847 |
2848 | if (! *var) return; /* passed in a NULL ptr */
2849 |
2850 | #ifdef USE_FREE
2851 | free( *var);
2852 | #endif
2853 | *var = NULL;
2854 |
2855 | } /** End of 'null_free' **/
2856 |
2857 | /*++++
2858 | ** ** Function-Header ***************************************************** **
2859 | ** **
2860 | ** Function: countTclHash **
2861 | ** **
2862 | ** Description: returns the number of hash entries in a TclHash **
2863 | ** **
2864 | ** first edition: 2005/09/01 R.K.Owen <rk@owen.sj.ca.us> **
2865 | ** **
2866 | ** Parameters: Tcl_HashTable *table Hash to count **
2867 | ** **
2868 | ** Result: size_t Count of Hash Entries **
2869 | ** **
2870 | ** Attached Globals: - **
2871 | ** **
2872 | ** ************************************************************************ **
2873 | ++++*/
2874 |
2875 |
2876 | size_t countTclHash(Tcl_HashTable *table) {
2877 | size_t result = 0;
2878 | Tcl_HashSearch searchPtr; /** Tcl hash search handle **/
2879 |
2880 | if(Tcl_FirstHashEntry(table, &searchPtr)) {
2881 |
2882 | do {
2883 | result++;
2884 | } while(Tcl_NextHashEntry( &searchPtr));
2885 |
2886 | } /** if **/
2887 |
2888 | return result;
2889 | } /** End of 'countHashTable' **/