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