1 /*****
2 ** ** Module Header ******************************************************* **
3 ** **
4 ** Modules Revision 3.0 **
5 ** Providing a flexible user environment **
6 ** **
7 ** File: init.c **
8 ** First Edition: 1991/10/23 **
9 ** **
10 ** Authors: John Furlan, jlf@behere.com **
11 ** Jens Hamisch, jens@strawberry.com **
12 ** R.K. Owen, rk@owen.sj.ca.us **
13 ** **
14 ** Description: The initialization routines for Tcl Modules. **
15 ** Primarily the setup of the different Tcl module **
16 ** commands and the global hash tables are initialized **
17 ** here. The initial storage of the begining **
18 ** environment is here as well. **
19 ** **
20 ** Exports: EM_CreateInterp **
21 ** Initialize_Tcl **
22 ** Module_Tcl_ExitCmd **
23 ** InitializeModuleCommands **
24 ** Setup_Environment **
25 ** TieStdout **
26 ** UnTieStdout **
27 ** SetStartupFiles **
28 ** **
29 ** Notes: **
30 ** **
31 ** ************************************************************************ **
32 ****/
33
34 /** ** Copyright *********************************************************** **
35 ** **
36 ** Copyright 1991-1994 by John L. Furlan. **
37 ** see LICENSE.GPL, which must be provided, for details **
38 ** **
39 ** ************************************************************************ **/
40
41 static char Id[] = "@(#)$Id: 11ddb35d2d209f617c8dc81f80af2de8935e44e2 $";
42 static void *UseId[] = { &UseId, Id };
43
44 /** ************************************************************************ **/
45 /** HEADERS **/
46 /** ************************************************************************ **/
47
48 #include "modules_def.h"
49
50 #ifdef HAS_TCLXLIBS
51 # include "tclExtend.h"
52 #endif /* HAS_TCLXLIBS */
53
54 /** ************************************************************************ **/
55 /** LOCAL DATATYPES **/
56 /** ************************************************************************ **/
57
58 /** not applicable **/
59
60 /** ************************************************************************ **/
61 /** CONSTANTS **/
62 /** ************************************************************************ **/
63
64 /** not applicable **/
65
66 /** ************************************************************************ **/
67 /** MACROS **/
68 /** ************************************************************************ **/
69
70 /** not applicable **/
71
72 /** ************************************************************************ **/
73 /** LOCAL DATA **/
74 /** ************************************************************************ **/
75
76 static char module_name[] = "init.c"; /** File name of this module **/
77
78 #if WITH_DEBUGGING_CALLBACK
79 static char _proc_Module_Tcl_ExitCmd[] = "Module_Tcl_ExitCmd";
80 #endif
81 #if WITH_DEBUGGING_INIT
82 static char _proc_InitializeModuleCommands[] = "InitializeModuleCommands";
83 static char _proc_EM_CreateInterp[] = "EM_CreateInterp";
84 static char _proc_EM_DeleteInterp[] = "EM_DeleteInterp";
85 static char _proc_Initialize_Tcl[] = "Initialize_Tcl";
86 static char _proc_Setup_Environment[] = "Setup_Environment";
87 #endif
88 #if WITH_DEBUGGING_UTIL_2
89 static char _proc_TieStdout[] = "TieStdout";
90 static char _proc_UnTieStdout[] = "UnTieStdout";
91 #endif
92 #if WITH_DEBUGGING_UTIL
93 static char _proc_SetStartupFiles[] = "SetStartupFiles";
94 #endif
95 #if WITH_DEBUGGING_UTIL_3
96 static char _proc_set_shell_properties[] = "set_shell_properties";
97 #endif
98
99 /** These are the recognized startup files that the given shells
100 ** use. If your site uses a different set, make the modifications here.
101 ** Give the names and the order they should be searched. The lists
102 ** must be null terminated.
103 **/
104
105 /** CSH **/
106 static char *cshStartUps[] = {
107 ".modules", ".cshrc" DOT_EXT, ".csh_variables", ".login" DOT_EXT, NULL
108 };
109 /** TCSH **/
110
111 static char *tcshStartUps[] = {
112 ".modules", ".tcshrc", ".cshrc" DOT_EXT, ".csh_variables",
113 ".login" DOT_EXT, NULL
114 };
115
116 /** SH and KSH **/
117 /** KSH uses whatever is pointed to by $ENV, which is usually named .kshenv
118 ** (TODO) have it read $ENV and use the value
119 **/
120
121 static char *shStartUps[] = {
122 ".modules", ".profile" DOT_EXT, ".kshenv" DOT_EXT, NULL
123 };
124
125 /** BASH **/
126 /** BASH uses whatever is pointed to by $ENV, for non-interactive shells
127 ** and for POSIX compliance
128 ** (TODO) have it read $ENV and use the value
129 **/
130
131 static char *bashStartUps[] = {
132 ".modules", ".bash_profile", ".bash_login",
133 ".profile" DOT_EXT, ".bashrc" DOT_EXT, NULL
134 };
135
136 /** ZSH **/
137
138 static char *zshStartUps[] = {
139 ".modules", ".zshrc" DOT_EXT, ".zshenv" DOT_EXT, ".zlogin" DOT_EXT, NULL
140 };
141
142 /** All the remaining "shells" are not supposed to use startup files **/
143
144 static char *genericStartUps[] = {
145 NULL
146 };
147
148 /** The shell properties matrix - global pointers are set to elements of
149 ** this array
150 **/
151 static char *shellprops [][4] = {
152 /* shell derelict init cmd sep */
153 {"csh", "csh", "csh", ";"},
154 {"tcsh", "csh", "csh", ";"},
155 {"sh", "sh", "sh", ";"},
156 {"ksh", "sh", "ksh", ";"},
157 {"bash", "sh", "bash", ";"},
158 {"zsh", "sh", "zsh", ";"},
159 {"perl", "perl", "perl", ";"},
160 {"python", "python", "python", "\n"},
161 {"ruby", "ruby", "ruby", "\n"},
162 {"scm", "scm", NULL, "\n"},
163 {"scheme", "scm", NULL, "\n"},
164 {"guile", "scm", NULL, "\n"},
165 {"mel", "mel", NULL, ";"},
166 {"cmake", "cmake", "cmake", "\n"},
167 {NULL, NULL, NULL, NULL},
168 };
169
170 /** ************************************************************************ **/
171 /** PROTOTYPES **/
172 /** ************************************************************************ **/
173
174 static char *set_shell_properties( const char *name);
175
176
177 /*++++
178 ** ** Function-Header ***************************************************** **
179 ** **
180 ** Function: Module_Tcl_ExitCmd **
181 ** **
182 ** Description: Error (???) exit routine **
183 ** **
184 ** First Edition: 1991/10/23 **
185 ** **
186 ** Parameters: ClientData client_data **
187 ** Tcl_Interp* interp The attached Tcl **
188 ** interpreter **
189 ** int argc Number of arguments **
190 ** char *argv[] Array of arguments **
191 ** to the module command**
192 ** **
193 ** Result: int TCL_ERROR Exit on error **
194 ** **
195 ** Attached Globals: **
196 ** **
197 ** ************************************************************************ **
198 ++++*/
199
Module_Tcl_ExitCmd(ClientData client_data,Tcl_Interp * interp,int argc,CONST84 char * argv[])200 int Module_Tcl_ExitCmd( ClientData client_data,
201 Tcl_Interp *interp,
202 int argc,
203 CONST84 char *argv[])
204 {
205 char *buffer; /** Buffer for sprintf **/
206 int value; /** Return value from exit command **/
207
208 #if WITH_DEBUGGING_CALLBACK
209 ErrorLogger( NO_ERR_START, LOC, _proc_Module_Tcl_ExitCmd, NULL);
210 #endif
211
212 /**
213 ** Check the number of arguments. The exit command may take no or one
214 ** parameter. So the following is legal:
215 ** exit;
216 ** exit value;
217 **/
218 if((argc != 1) && (argc != 2))
219 if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], "?returnCode?", NULL))
220 goto unwind0;
221
222 /**
223 ** If the exit command comes with an paramter, set up the TCL result.
224 ** Otherwise the result is 0.
225 **/
226 if( argc == 1) {
227 value = 0;
228 } else if( Tcl_GetInt( interp, argv[1], &value) != TCL_OK) {
229 if( OK != ErrorLogger( ERR_PARAM, LOC, argv[1], NULL))
230 goto unwind0;
231 }
232
233 /**
234 ** Allocate memory
235 **/
236 if((char *) NULL == (buffer = stringer(NULL,25,NULL)))
237 if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
238 goto unwind0;
239
240 sprintf( buffer, "EXIT %d", value);
241 Tcl_SetResult( interp, buffer, NULL);
242
243 /**
244 ** Exit from this module command.
245 ** ??? Why hardcoded on error ???
246 **/
247 #if WITH_DEBUGGING_CALLBACK
248 ErrorLogger( NO_ERR_END, LOC, _proc_Module_Tcl_ExitCmd, NULL);
249 #endif
250
251 unwind0:
252 return( TCL_ERROR);
253
254 } /** End of 'Module_Tcl_ExitCmd' **/
255
256 /*++++
257 ** ** Function-Header ***************************************************** **
258 ** **
259 ** Function: EM_CreateInterp **
260 ** **
261 ** Description: Create a Tcl interpreter and set some default **
262 ** attributes for each interpreter. **
263 ** **
264 ** First Edition: 2011/09/26 **
265 ** **
266 ** Parameters: - **
267 ** **
268 ** Result: Tcl_Interp **interp New Tcl interpr. **
269 ** **
270 ** Attached Globals: - **
271 ** **
272 ** ************************************************************************ **
273 ++++*/
274
EM_CreateInterp(void)275 Tcl_Interp *EM_CreateInterp(void) {
276 Tcl_Interp *interp;
277
278 #if WITH_DEBUGGING_INIT
279 ErrorLogger( NO_ERR_START, LOC, _proc_EM_CreateInterp, NULL);
280 #endif
281
282 interp = Tcl_CreateInterp();
283 /*
284 * avoid freeing storage when in use
285 */
286 Tcl_Preserve(interp);
287
288 return interp;
289
290 } /** End of 'EM_CreateInterp' **/
291
292 /*++++
293 ** ** Function-Header ***************************************************** **
294 ** **
295 ** Function: EM_DeleteInterp **
296 ** **
297 ** Description: Delete a Tcl interpreter and set some default **
298 ** attributes for each interpreter. **
299 ** **
300 ** First Edition: 2011/09/26 **
301 ** **
302 ** Parameters: Tcl_Interp **interp Tcl interpr to **
303 ** delete **
304 ** **
305 ** Result : - **
306 ** **
307 ** Attached Globals: - **
308 ** **
309 ** ************************************************************************ **
310 ++++*/
311
EM_DeleteInterp(Tcl_Interp * interp)312 void EM_DeleteInterp(Tcl_Interp *interp) {
313
314 #if WITH_DEBUGGING_INIT
315 ErrorLogger( NO_ERR_START, LOC, _proc_EM_DeleteInterp, NULL);
316 #endif
317
318 /*
319 * avoid freeing storage when in use, now release
320 */
321 Tcl_Release(interp);
322
323 Tcl_DeleteInterp(interp);
324
325 } /** End of 'EM_DeleteInterp' **/
326
327 /*++++
328 ** ** Function-Header ***************************************************** **
329 ** **
330 ** Function: Initialize_Tcl **
331 ** **
332 ** Description: This procedure is called from 'main' in order to ini-**
333 ** tialize the whole thing. The arguments specified on **
334 ** the invoking command line are passed to here. **
335 ** **
336 ** First Edition: 1991/10/23 **
337 ** **
338 ** Parameters: Tcl_Interp **interp Buffer to store the **
339 ** Tcl interpr. handle **
340 ** int argc Number od args and **
341 ** char *argv[] arg. array from the **
342 ** shell command line **
343 ** char *environ[] Process environment **
344 ** **
345 ** Result: int **
346 ** **
347 ** Attached Globals: *Ptr will be initialized **
348 ** *HashTable will be allocated and initialized **
349 ** **
350 ** ************************************************************************ **
351 ++++*/
352
Initialize_Tcl(Tcl_Interp ** interp,int argc,char * argv[],char * environ[])353 int Initialize_Tcl( Tcl_Interp **interp,
354 int argc,
355 char *argv[],
356 char *environ[])
357 {
358 int Result = TCL_ERROR;
359 char * tmp;
360
361 #if WITH_DEBUGGING_INIT
362 ErrorLogger( NO_ERR_START, LOC, _proc_Initialize_Tcl, NULL);
363 #endif
364
365 /**
366 ** Check the command syntax. Since this is already done
367 ** Less than 3 parameters isn't valid. Invocation should be
368 ** 'modulecmd <shell> <command>'
369 **/
370 if(argc < 2)
371 if( OK != ErrorLogger( ERR_USAGE, LOC, argv[0], " shellname", NULL))
372 goto unwind0;
373
374 /**
375 ** Check the first parameter to modulcmd for a known shell type
376 ** and set the shell properties
377 **/
378 if( !set_shell_properties( argv[1]))
379 if( OK != ErrorLogger( ERR_SHELL, LOC, argv[1], NULL))
380 goto unwind0;
381
382 /**
383 ** Create a Tcl interpreter in order to proceed the command. Initialize
384 ** this interpreter and set up pointers to all Tcl Module commands
385 ** (InitializeModuleCommands)
386 **/
387
388 #ifdef __CYGWIN__
389 /* ABr, 12/10/01: from Cygwin stuff */
390 Tcl_FindExecutable( argv[0] ) ;
391 #endif
392
393 *interp = EM_CreateInterp();
394
395 if( TCL_OK != (Result = InitializeModuleCommands( *interp)))
396 goto unwind0;
397
398 /**
399 ** Now set up the hash-tables for shell environment modifications.
400 ** For a description of these tables have a look at main.c, where
401 ** they're defined. The tables have to be allocated and thereafter
402 ** initialized. Exit from the whole program in case allocation fails.
403 **/
404 if( ( ! ( setenvHashTable =
405 (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
406 ( ! ( unsetenvHashTable =
407 (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
408 ( ! ( aliasSetHashTable =
409 (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
410 ( ! ( aliasUnsetHashTable =
411 (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
412 ( ! ( markVariableHashTable =
413 (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ||
414 ( ! ( markAliasHashTable =
415 (Tcl_HashTable*) module_malloc( sizeof(Tcl_HashTable))) ) ) {
416
417 if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
418 goto unwind0;
419 }
420
421 Tcl_InitHashTable( setenvHashTable, TCL_STRING_KEYS);
422 Tcl_InitHashTable( unsetenvHashTable, TCL_STRING_KEYS);
423 Tcl_InitHashTable( aliasSetHashTable, TCL_STRING_KEYS);
424 Tcl_InitHashTable( aliasUnsetHashTable, TCL_STRING_KEYS);
425 Tcl_InitHashTable( markVariableHashTable, TCL_STRING_KEYS);
426 Tcl_InitHashTable( markAliasHashTable, TCL_STRING_KEYS);
427
428 #ifdef BEGINENV
429 # if BEGINENV == 99
430 /**
431 ** Check for the existence of the environment variable
432 ** "MODULESBEGINENV". This signals that for this
433 ** configuration that the user wants to record the initial
434 ** environment as seen for the first time by the module
435 ** command into the filename given in the MODULESBEGINENV
436 ** environment variable (which can have one level of
437 ** variable expansion). Whether it's the first time or not
438 ** is moderated by the existence of environment variable
439 ** _MODULESBEGINENV_ or not.
440 **
441 ** The update command will use this information to reinitialize the
442 ** environment and then reload every modulefile that has been loaded
443 ** since as stored in the LOADEDMODULES environment variable in order.
444 **/
445 if( (tmp = xgetenv( "MODULESBEGINENV")) ) {
446 /* MODULESBEGINENV is set ... use it */
447
448 if( !getenv( "_MODULESBEGINENV_") ) {
449 FILE* file;
450 if( (file = fopen(tmp, "w+")) ) {
451 int i=0;
452 while( environ[i]) {
453 fprintf( file, "%s\n", environ[i++]);
454 }
455 moduleSetenv( *interp, "_MODULESBEGINENV_", tmp, 1);
456 fclose( file);
457 } else
458 if( OK != ErrorLogger( ERR_OPEN, LOC,
459 TCL_RESULT(*interp), "append", NULL))
460 goto unwind0;
461
462 null_free((void *) &tmp);
463 }
464 }
465 # else
466 /**
467 ** Check for the existence of the
468 ** environment variable "_MODULESBEGINENV_". If it is set, then
469 ** do nothing, otherwise, Store every environment variable into
470 ** ~/.modulesbeginenv. This will be used to store the environment
471 ** variables exactly as it was when Modules saw it for the very first
472 ** time.
473 **
474 ** The update command will use this information to reinitialize the
475 ** environment and then reload every modulefile that has been loaded
476 ** since as stored in the LOADEDMODULES environment variable in order.
477 **/
478 if( !getenv( "_MODULESBEGINENV_") ) {
479 /* use .modulesbeginenv */
480
481 FILE* file;
482
483 char savefile[] = "/.modulesbeginenv";
484 char *buffer;
485
486 tmp = getenv("HOME");
487 if((char *) NULL == (tmp = getenv("HOME")))
488 if( OK != ErrorLogger( ERR_HOME, LOC, NULL))
489 goto unwind0;
490
491 if((char *) NULL == (buffer = stringer(NULL,0,tmp,savefile,NULL)))
492 if( OK != ErrorLogger( ERR_STRING, LOC, NULL))
493 goto unwind0;
494
495 if( file = fopen(buffer, "w+")) {
496 int i=0;
497 while( environ[i]) {
498 fprintf( file, "%s\n", environ[i++]);
499 }
500 moduleSetenv( *interp, "_MODULESBEGINENV_", buffer, 1);
501 fclose( file);
502 } else
503 if( OK != ErrorLogger( ERR_OPEN, LOC,
504 TCL_RESULT(*interp), "append", NULL))
505 goto unwind0;
506
507 null_free((void *) &buffer);
508 }
509 # endif
510 #endif
511
512 /**
513 ** Exit to the main program
514 **/
515 return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
516
517 unwind0:
518 return( Result); /** -------- EXIT (FAILURE) -------> **/
519
520 } /** End of 'Initialize_Tcl' **/
521
522 /*++++
523 ** ** Function-Header ***************************************************** **
524 ** **
525 ** Function: InitializeModuleCommands **
526 ** **
527 ** Description: Initialization of the passed Tcl interpreter. At **
528 ** first the standard Tcl and (if required) TclX initi- **
529 ** alization is called. Thereafter all module commands **
530 ** callback function are defined. **
531 ** **
532 ** First Edition: 1991/10/23 **
533 ** **
534 ** Parameters: Tcl_Interp *interp The Tcl Interpreter **
535 ** to be initilized **
536 ** **
537 ** Result: int TCL_OK All done, Success **
538 ** TCL_ERROR Failure anywhere **
539 ** **
540 ** Attached Globals: - **
541 ** **
542 ** ************************************************************************ **
543 ++++*/
544
InitializeModuleCommands(Tcl_Interp * interp)545 int InitializeModuleCommands( Tcl_Interp* interp)
546 {
547
548 #if WITH_DEBUGGING_INIT
549 ErrorLogger( NO_ERR_START, LOC, _proc_InitializeModuleCommands, NULL);
550 #endif
551
552 /**
553 ** General initialization of the Tcl interpreter
554 **/
555 if( Tcl_Init( interp) == TCL_ERROR)
556 if( OK != ErrorLogger( ERR_INIT_TCL, LOC, NULL))
557 goto unwind0;
558
559 #ifdef HAS_TCLXLIBS
560
561 /**
562 ** Extended Tcl initialization if configured so ...
563 **/
564
565 #if (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 3)
566 if( Tclx_Init( interp) == TCL_ERROR)
567 #elif (TCL_MAJOR_VERSION > 7 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION > 5)
568 if( Tclxcmd_Init( interp) == TCL_ERROR)
569 #else
570 if( TclXCmd_Init( interp) == TCL_ERROR)
571 #endif
572 {
573 if( OK != ErrorLogger( ERR_INIT_TCLX, LOC, NULL))
574 goto unwind0;
575 }
576
577 #endif /* HAS_TCLXLIBS */
578
579 #ifdef AUTOLOADPATH
580
581 /**
582 ** Extend autoload path
583 **/
584 if( TCL_OK != Tcl_Eval( interp,
585 "if [info exists auto_path] { "
586 "set auto_path [linsert $auto_path 0 " AUTOLOADPATH
587 "]} else {"
588 "set auto_path \"" AUTOLOADPATH "\" }"))
589 if( OK != ErrorLogger( ERR_INIT_ALPATH, LOC, NULL))
590 goto unwind0;
591
592 #endif /* AUTOLOADPATH */
593
594 /**
595 ** Now for each module command a callback routine has to be specified
596 **/
597 Tcl_CreateCommand( interp, "exit", Module_Tcl_ExitCmd,
598 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
599
600 Tcl_CreateCommand( interp, "setenv", cmdSetEnv,
601 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
602 Tcl_CreateCommand( interp, "unsetenv", cmdUnsetEnv,
603 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
604
605 Tcl_CreateCommand( interp, "prepend-path", cmdSetPath,
606 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
607 Tcl_CreateCommand( interp, "append-path", cmdSetPath,
608 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
609 Tcl_CreateCommand( interp, "remove-path", cmdRemovePath,
610 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
611
612 Tcl_CreateCommand( interp, "module-info", cmdModuleInfo,
613 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
614 Tcl_CreateCommand( interp, "module", cmdModule,
615 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
616
617 Tcl_CreateCommand( interp, "module-whatis", cmdModuleWhatis,
618 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
619 Tcl_CreateCommand( interp, "module-verbosity", cmdModuleVerbose,
620 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
621 Tcl_CreateCommand( interp, "module-user", cmdModuleUser,
622 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
623 Tcl_CreateCommand( interp, "module-log", cmdModuleLog,
624 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
625 Tcl_CreateCommand( interp, "module-trace", cmdModuleTrace,
626 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
627
628 Tcl_CreateCommand( interp, "module-alias", cmdModuleAlias,
629 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
630 Tcl_CreateCommand( interp, "module-version", cmdModuleVersion,
631 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
632
633 Tcl_CreateCommand( interp, "set-alias", cmdSetAlias,
634 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
635 Tcl_CreateCommand( interp, "unset-alias", cmdSetAlias,
636 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
637
638 Tcl_CreateCommand( interp, "conflict", cmdConflict,
639 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
640 Tcl_CreateCommand( interp, "prereq", cmdPrereq,
641 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
642
643 Tcl_CreateCommand( interp, "is-loaded", cmdIsLoaded,
644 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
645
646 Tcl_CreateCommand( interp, "chdir", cmdChDir,
647 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
648 Tcl_CreateCommand( interp, "system", cmdSystem,
649 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
650 Tcl_CreateCommand( interp, "uname", cmdUname,
651 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
652
653 Tcl_CreateCommand( interp, "x-resource", cmdXResource,
654 (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
655
656 return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
657
658 unwind0:
659 return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
660
661 } /** End of 'InitializeModuleCommands' **/
662
663 /*++++
664 ** ** Function-Header ***************************************************** **
665 ** **
666 ** Function: Setup_Environment **
667 ** **
668 ** Description:Define all variables to be found in the current **
669 ** shell environment as Tcl variables in the passed **
670 ** Tcl interpreter. **
671 ** Assign as value 0 to all of them. ??? Why ??? **
672 ** **
673 ** First Edition: 1991/10/23 **
674 ** **
675 ** Parameters: Tcl_Interp *interp Attched Tcl interpr. **
676 ** **
677 ** Result: int TCL_ERROR Variable could not be set up **
678 ** 0 Success ??? TCL_OK ??? **
679 ** **
680 ** Attached Globals: environ **
681 ** **
682 ** ************************************************************************ **
683 ++++*/
684
Setup_Environment(Tcl_Interp * interp)685 int Setup_Environment( Tcl_Interp* interp)
686 {
687
688 int i, /** loop counter **/
689 envsize = 0; /** Total size of the environment **/
690 char *eq; /** Temp. val. used for location the **/
691 /** Equal sign. **/
692 char *loaded; /** The currently loaded modules **/
693
694 #if WITH_DEBUGGING_INIT
695 ErrorLogger( NO_ERR_START, LOC, _proc_Setup_Environment, NULL);
696 #endif
697
698 /**
699 ** Scan the whole environment value by value.
700 ** Count its size
701 **/
702 for( i = 0; environ[i]; i++) {
703
704 envsize += strlen( environ[i]) + 1;
705
706 /**
707 ** Locate the equal sign and terminate the string at its position.
708 **/
709 eq = environ[i];
710 while( *eq++ != '=' && *eq);
711 *(eq - 1) = '\0';
712
713 /**
714 ** Now set up a Tcl variable of the same name and value as the
715 ** environment variable
716 **/
717 if( Tcl_SetVar( interp, environ[i], eq, 0) == (char *) NULL)
718 if( OK != ErrorLogger( ERR_SET_VAR, LOC, environ[i], NULL))
719 goto unwind0;
720
721 /**
722 ** Reinstall the changed environment
723 **/
724 *(eq - 1) = '=';
725
726 } /** for **/
727
728 /**
729 ** Reconstruct the _LMFILES_ environment variable
730 **/
731 loaded = getLMFILES( interp);
732 if( loaded)
733 if( !(EMSetEnv( interp, "_LMFILES_", loaded)))
734 if( OK != ErrorLogger( ERR_SET_VAR, LOC, environ[i], NULL))
735 goto unwind0;
736
737 return( TCL_OK); /** -------- EXIT (SUCCESS) -------> **/
738
739 unwind0:
740 return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
741
742 } /** end of 'Setup_Environment' **/
743
744 /*++++
745 ** ** Function-Header ***************************************************** **
746 ** **
747 ** Function: TieStdout, UnTieStdout **
748 ** **
749 ** Description: TieStdout closes the 'stdout' handle and reopens it **
750 ** as 'stderr'. The original 'stdout' handle is passed **
751 ** back to the caller. **
752 ** UnTieStdout reverts this by reopening 'stdout' as the**
753 ** handle passed as parameter **
754 ** **
755 ** First Edition: 1991/10/23 **
756 ** **
757 ** Parameters: int saved_stdout Handle to be used for rein- **
758 ** stalling stdout **
759 ** **
760 ** Result: int The (just reinstalled or saved) stdout handle**
761 ** **
762 ** Attached Globals: - **
763 ** **
764 ** ************************************************************************ **
765 ++++*/
766
TieStdout(void)767 int TieStdout( void) {
768 int save;
769
770 #if WITH_DEBUGGING_UTIL_2
771 ErrorLogger( NO_ERR_START, LOC, _proc_TieStdout, NULL);
772 #endif
773
774 if( 0 > (save = dup(1)))
775 if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
776 goto unwind0;
777
778 if( 0 > close( 1))
779 if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
780 goto unwind0;
781
782 /**
783 ** dup used the very first closed handle for duplication. Since stdout
784 ** has just been closed, this will be reopened as stderr here.
785 **/
786 if( 0 > (dup(2)))
787 if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
788 goto unwind0;
789
790 return( save); /** ------- EXIT (RESULT) --------> **/
791
792 unwind0:
793 return( -1); /** ------- EXIT (FAILURE) --------> **/
794 }
795
UnTieStdout(int saved_stdout)796 int UnTieStdout( int saved_stdout) {
797
798 int retval;
799
800 #if WITH_DEBUGGING_UTIL_2
801 ErrorLogger( NO_ERR_START, LOC, _proc_UnTieStdout, NULL);
802 #endif
803
804 if( 0 > close( 1))
805 if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
806 goto unwind0;
807
808 if( 0 > (retval = dup( saved_stdout)))
809 if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
810 goto unwind0;
811
812 return( retval);
813
814 unwind0:
815 return( -1); /** ------- EXIT (FAILURE) --------> **/
816 }
817
818 /*++++
819 ** ** Function-Header ***************************************************** **
820 ** **
821 ** Function: SetStartupFiles **
822 ** **
823 ** Description: Collects all startupfiles used by the various shells **
824 ** in the array 'shell_startups'. This function does not**
825 ** care if the startup file do not exist! **
826 ** **
827 ** First Edition: 1991/10/23 **
828 ** **
829 ** Parameters: shell_name the shell being used **
830 ** Result: shell_startups NULL terminated list of startup files**
831 ** for the shell **
832 ** returns NULL if an error **
833 ** Attached Globals: - **
834 ** **
835 ** ************************************************************************ **
836 ++++*/
837
SetStartupFiles(char * shell_name)838 char **SetStartupFiles(char *shell_name)
839 {
840
841 #if WITH_DEBUGGING_UTIL
842 ErrorLogger( NO_ERR_START, LOC, _proc_SetStartupFiles, NULL);
843 #endif
844
845 /**
846 ** CSH
847 **/
848 if( (strcmp( "csh", shell_name) == 0)) {
849
850 return cshStartUps;
851
852 /**
853 ** TCSH
854 **/
855 } else if((strcmp("tcsh", shell_name) == 0)) {
856
857 return tcshStartUps;
858
859 /**
860 ** SH and KSH
861 ** ??? What's about .environ ???
862 **/
863 } else if((strcmp("sh", shell_name) == 0) ||
864 (strcmp("ksh", shell_name) == 0)) {
865
866 return shStartUps;
867
868 /**
869 ** BASH
870 ** ??? doesn't this guy use the SH startups, too ???
871 **/
872 } else if((strcmp("bash", shell_name) == 0)) {
873
874 return bashStartUps;
875
876 /**
877 ** ZSH
878 **/
879 } else if((strcmp("zsh", shell_name) == 0)) {
880
881 return zshStartUps;
882
883 /**
884 ** All of the remainig "shells" are not supposed to used startup
885 ** files
886 **/
887 } else {
888
889 return genericStartUps;
890 }
891
892 } /** End of 'SetStartupFiles' **/
893
894 /*++++
895 ** ** Function-Header ***************************************************** **
896 ** **
897 ** Function: set_shell_properties **
898 ** **
899 ** Description: Normalize the current calling shell to one of the **
900 ** basic shells defining the variable and alias syntax **
901 ** **
902 ** First Edition: 1991/10/23 **
903 ** **
904 ** Parameters: const char *name Invoking shell name **
905 ** **
906 ** Result: char* Shell derelict name **
907 ** **
908 ** Attached Globals: shell_derelict **
909 ** shell_cmd_separator **
910 ** **
911 ** ************************************************************************ **
912 ++++*/
913
set_shell_properties(const char * name)914 static char *set_shell_properties( const char *name)
915 {
916
917 #if WITH_DEBUGGING_UTIL_3
918 ErrorLogger( NO_ERR_START, LOC, _proc_set_shell_properties, NULL);
919 #endif
920
921 /**
922 ** Loop through the shell properties matrix until a match is found
923 **/
924 int i = 0;
925
926 while (shellprops[i][0]) {
927 if( !strcmp(name,shellprops[i][0])) { /* found match */
928 shell_name = shellprops[i][0];
929 shell_derelict = shellprops[i][1];
930 shell_init = shellprops[i][2];
931 shell_cmd_separator = shellprops[i][3];
932 return ((char *) name);
933 }
934 i++;
935 }
936
937 shell_name = NULL;
938 shell_derelict = NULL;
939 shell_init = NULL;
940 shell_cmd_separator = NULL;
941 /**
942 ** Oops! Undefined shell name ...
943 **/
944 return( NULL);
945
946 } /** End of 'set_shell_properties' **/
947