1 /* exp_main_sub.c - miscellaneous subroutines for Expect or Tk main() */
2
3 #include "expect_cf.h"
4 #include <stdio.h>
5 #include <errno.h>
6 #ifdef HAVE_INTTYPES_H
7 # include <inttypes.h>
8 #endif
9 #include <sys/types.h>
10
11 #ifdef HAVE_UNISTD_H
12 # include <unistd.h>
13 #endif
14
15 #ifdef HAVE_SYS_WAIT_H
16 #include <sys/wait.h>
17 #endif
18
19 #include "tcl.h"
20 #include "tclInt.h"
21 #include "exp_rename.h"
22 #include "exp_prog.h"
23 #include "exp_command.h"
24 #include "exp_tty_in.h"
25 #include "exp_log.h"
26 #include "exp_event.h"
27 #ifdef TCL_DEBUGGER
28 #include "tcldbg.h"
29 #endif
30
31 #ifndef EXP_VERSION
32 #define EXP_VERSION PACKAGE_VERSION
33 #endif
34 #ifdef __CENTERLINE__
35 #undef EXP_VERSION
36 #define EXP_VERSION "5.45.4" /* I give up! */
37 /* It is not necessary that number */
38 /* be accurate. It is just here to */
39 /* pacify Centerline which doesn't */
40 /* seem to be able to get it from */
41 /* the Makefile. */
42 #undef SCRIPTDIR
43 #define SCRIPTDIR "example/"
44 #undef EXECSCRIPTDIR
45 #define EXECSCRIPTDIR "example/"
46 #endif
47 char exp_version[] = PACKAGE_VERSION;
48 #define NEED_TCL_MAJOR 7
49 #define NEED_TCL_MINOR 5
50
51 char *exp_argv0 = "this program"; /* default program name */
52 void (*exp_app_exit)() = 0;
53 void (*exp_event_exit)() = 0;
54 FILE *exp_cmdfile = 0;
55 char *exp_cmdfilename = 0;
56 int exp_cmdlinecmds = FALSE;
57 int exp_interactive = FALSE;
58 int exp_buffer_command_input = FALSE;/* read in entire cmdfile at once */
59 int exp_fgets();
60
61 Tcl_Interp *exp_interp; /* for use by signal handlers who can't figure out */
62 /* the interpreter directly */
63 int exp_tcl_debugger_available = FALSE;
64
65 int exp_getpid;
66
67 int exp_strict_write = 0;
68
69
70 static void
usage(interp)71 usage(interp)
72 Tcl_Interp *interp;
73 {
74 char buffer [] = "exit 1";
75 expErrorLog("usage: expect [-div] [-c cmds] [[-f] cmdfile] [args]\r\n");
76
77 /* SF #439042 -- Allow overide of "exit" by user / script
78 */
79 Tcl_Eval(interp, buffer);
80 }
81
82 /* this clumsiness because pty routines don't know Tcl definitions */
83 /*ARGSUSED*/
84 static
85 void
exp_pty_exit_for_tcl(clientData)86 exp_pty_exit_for_tcl(clientData)
87 ClientData clientData;
88 {
89 exp_pty_exit();
90 }
91
92 static
93 void
exp_init_pty_exit()94 exp_init_pty_exit()
95 {
96 Tcl_CreateExitHandler(exp_pty_exit_for_tcl,(ClientData)0);
97 }
98
99 /* This can be called twice or even recursively - it's safe. */
100 void
exp_exit_handlers(clientData)101 exp_exit_handlers(clientData)
102 ClientData clientData;
103 {
104 extern int exp_forked;
105
106 Tcl_Interp *interp = (Tcl_Interp *)clientData;
107
108 /* use following checks to prevent recursion in exit handlers */
109 /* if this code ever supports multiple interps, these should */
110 /* become interp-specific */
111
112 static int did_app_exit = FALSE;
113 static int did_expect_exit = FALSE;
114
115 if (!did_expect_exit) {
116 did_expect_exit = TRUE;
117 /* called user-defined exit routine if one exists */
118 if (exp_onexit_action) {
119 int result = Tcl_GlobalEval(interp,exp_onexit_action);
120 if (result != TCL_OK) Tcl_BackgroundError(interp);
121 }
122 } else {
123 expDiagLogU("onexit handler called recursively - forcing exit\r\n");
124 }
125
126 if (exp_app_exit) {
127 if (!did_app_exit) {
128 did_app_exit = TRUE;
129 (*exp_app_exit)(interp);
130 } else {
131 expDiagLogU("application exit handler called recursively - forcing exit\r\n");
132 }
133 }
134
135 if (!exp_disconnected
136 && !exp_forked
137 && (exp_dev_tty != -1)
138 && isatty(exp_dev_tty)) {
139 if (exp_ioctled_devtty) {
140 exp_tty_set(interp,&exp_tty_original,exp_dev_tty,0);
141 }
142 }
143 /* all other files either don't need to be flushed or will be
144 implicitly closed at exit. Spawned processes are free to continue
145 running, however most will shutdown after seeing EOF on stdin.
146 Some systems also deliver SIGHUP and other sigs to idle processes
147 which will blow them away if not prepared.
148 */
149
150 exp_close_all(interp);
151 }
152
153 static int
history_nextid(interp)154 history_nextid(interp)
155 Tcl_Interp *interp;
156 {
157 /* unncessarily tricky coding - if nextid isn't defined,
158 maintain our own static version */
159
160 static int nextid = 0;
161 CONST char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
162 if (nextidstr) {
163 /* intentionally ignore failure */
164 (void) sscanf(nextidstr,"%d",&nextid);
165 }
166 return ++nextid;
167 }
168
169 /* this stupidity because Tcl needs commands in writable space */
170 static char prompt1[] = "prompt1";
171 static char prompt2[] = "prompt2";
172
173 static char *prompt2_default = "+> ";
174 static char prompt1_default[] = "expect%d.%d> ";
175
176 /*ARGSUSED*/
177 int
Exp_Prompt1ObjCmd(clientData,interp,objc,objv)178 Exp_Prompt1ObjCmd(clientData, interp, objc, objv)
179 ClientData clientData;
180 Tcl_Interp *interp;
181 int objc;
182 Tcl_Obj *CONST objv[]; /* Argument objects. */
183 {
184 static char buffer[200];
185
186 Interp *iPtr = (Interp *)interp;
187
188 sprintf(buffer,prompt1_default,iPtr->numLevels,history_nextid(interp));
189 Tcl_SetResult(interp,buffer,TCL_STATIC);
190 return(TCL_OK);
191 }
192
193 /*ARGSUSED*/
194 int
Exp_Prompt2ObjCmd(clientData,interp,objc,objv)195 Exp_Prompt2ObjCmd(clientData, interp, objc, objv)
196 ClientData clientData;
197 Tcl_Interp *interp;
198 int objc;
199 Tcl_Obj *CONST objv[];
200 {
201 Tcl_SetResult(interp,prompt2_default,TCL_STATIC);
202 return(TCL_OK);
203 }
204
205 /*ARGSUSED*/
206 static int
ignore_procs(interp,s)207 ignore_procs(interp,s)
208 Tcl_Interp *interp;
209 char *s; /* function name */
210 {
211 return ((s[0] == 'p') &&
212 (s[1] == 'r') &&
213 (s[2] == 'o') &&
214 (s[3] == 'm') &&
215 (s[4] == 'p') &&
216 (s[5] == 't') &&
217 ((s[6] == '1') ||
218 (s[6] == '2')) &&
219 (s[7] == '\0')
220 );
221 }
222
223 /* handle an error from Tcl_Eval or Tcl_EvalFile */
224 static void
handle_eval_error(interp,check_for_nostack)225 handle_eval_error(interp,check_for_nostack)
226 Tcl_Interp *interp;
227 int check_for_nostack;
228 {
229 char *msg;
230
231 /* if errorInfo has something, print it */
232 /* else use what's in the interp result */
233
234 msg = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY);
235 if (!msg) msg = Tcl_GetStringResult (interp);
236 else if (check_for_nostack) {
237 /* suppress errorInfo if generated via */
238 /* error ... -nostack */
239 if (0 == strncmp("-nostack",msg,8)) return;
240
241 /*
242 * This shouldn't be necessary, but previous test fails
243 * because of recent change John made - see eval_trap_action()
244 * in exp_trap.c for more info
245 */
246 if (exp_nostack_dump) {
247 exp_nostack_dump = FALSE;
248 return;
249 }
250 }
251
252 /* no \n at end, since ccmd will already have one. */
253 /* Actually, this is not true if command is last in */
254 /* file and has no newline after it, oh well */
255 expErrorLogU(exp_cook(msg,(int *)0));
256 expErrorLogU("\r\n");
257 }
258
259 /* user has pressed escape char from interact or somehow requested expect.
260 If a user-supplied command returns:
261
262 TCL_ERROR, assume user is experimenting and reprompt
263 TCL_OK, ditto
264 TCL_RETURN, return TCL_OK (assume user just wants to escape() to return)
265 EXP_TCL_RETURN, return TCL_RETURN
266 anything else return it
267 */
268 int
exp_interpreter(interp,eofObj)269 exp_interpreter(interp,eofObj)
270 Tcl_Interp *interp;
271 Tcl_Obj *eofObj;
272 {
273 Tcl_Obj *commandPtr = NULL;
274 int code;
275 int gotPartial;
276 Interp *iPtr = (Interp *)interp;
277 int tty_changed = FALSE;
278 exp_tty tty_old;
279 int was_raw, was_echo;
280
281 Tcl_Channel inChannel, outChannel;
282 ExpState *esPtr = expStdinoutGet();
283 /* int fd = fileno(stdin);*/
284
285 expect_key++;
286 commandPtr = Tcl_NewObj();
287 Tcl_IncrRefCount(commandPtr);
288
289 gotPartial = 0;
290 while (TRUE) {
291 if (Tcl_IsShared(commandPtr)) {
292 Tcl_DecrRefCount(commandPtr);
293 commandPtr = Tcl_DuplicateObj(commandPtr);
294 Tcl_IncrRefCount(commandPtr);
295 }
296 outChannel = expStdinoutGet()->channel;
297 if (outChannel) {
298 Tcl_Flush(outChannel);
299 }
300 if (!esPtr->open) {
301 code = EXP_EOF;
302 goto eof;
303 }
304
305 /* force terminal state */
306 tty_changed = exp_tty_cooked_echo(interp,&tty_old,&was_raw,&was_echo);
307
308 if (!gotPartial) {
309 code = Tcl_Eval(interp,prompt1);
310 if (code == TCL_OK) {
311 expStdoutLogU(Tcl_GetStringResult(interp),1);
312 }
313 else expStdoutLog(1,prompt1_default,iPtr->numLevels,history_nextid(interp));
314 } else {
315 code = Tcl_Eval(interp,prompt2);
316 if (code == TCL_OK) {
317 expStdoutLogU(Tcl_GetStringResult(interp),1);
318 }
319 else expStdoutLogU(prompt2_default,1);
320 }
321
322 esPtr->force_read = 1;
323 code = exp_get_next_event(interp,&esPtr,1,&esPtr,EXP_TIME_INFINITY,
324 esPtr->key);
325 /* check for code == EXP_TCLERROR? */
326
327 if (code != EXP_EOF) {
328 inChannel = expStdinoutGet()->channel;
329 code = Tcl_GetsObj(inChannel, commandPtr);
330 #ifdef SIMPLE_EVENT
331 if (code == -1 && errno == EINTR) {
332 if (Tcl_AsyncReady()) {
333 (void) Tcl_AsyncInvoke(interp,TCL_OK);
334 }
335 continue;
336 }
337 #endif
338 if (code < 0) code = EXP_EOF;
339 if ((code == 0) && Tcl_Eof(inChannel) && !gotPartial) code = EXP_EOF;
340 }
341
342 eof:
343 if (code == EXP_EOF) {
344 if (eofObj) {
345 code = Tcl_EvalObjEx(interp,eofObj,0);
346 } else {
347 code = TCL_OK;
348 }
349 goto done;
350 }
351
352 expDiagWriteObj(commandPtr);
353 /* intentionally always write to logfile */
354 if (expLogChannelGet()) {
355 Tcl_WriteObj(expLogChannelGet(),commandPtr);
356 }
357 /* no need to write to stdout, since they will see */
358 /* it just from it having been echoed as they are */
359 /* typing it */
360
361 /*
362 * Add the newline removed by Tcl_GetsObj back to the string.
363 */
364
365 if (Tcl_IsShared(commandPtr)) {
366 Tcl_DecrRefCount(commandPtr);
367 commandPtr = Tcl_DuplicateObj(commandPtr);
368 Tcl_IncrRefCount(commandPtr);
369 }
370 Tcl_AppendToObj(commandPtr, "\n", 1);
371 if (!TclObjCommandComplete(commandPtr)) {
372 gotPartial = 1;
373 continue;
374 }
375
376 Tcl_AppendToObj(commandPtr, "\n", 1);
377 if (!TclObjCommandComplete(commandPtr)) {
378 gotPartial = 1;
379 continue;
380 }
381
382 gotPartial = 0;
383
384 if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);
385
386 code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
387 Tcl_DecrRefCount(commandPtr);
388 commandPtr = Tcl_NewObj();
389 Tcl_IncrRefCount(commandPtr);
390 switch (code) {
391 char *str;
392
393 case TCL_OK:
394 str = Tcl_GetStringResult(interp);
395 if (*str != 0) {
396 expStdoutLogU(exp_cook(str,(int *)0),1);
397 expStdoutLogU("\r\n",1);
398 }
399 continue;
400 case TCL_ERROR:
401 handle_eval_error(interp,1);
402 /* since user is typing by hand, we expect lots */
403 /* of errors, and want to give another chance */
404 continue;
405 #define finish(x) {code = x; goto done;}
406 case TCL_BREAK:
407 case TCL_CONTINUE:
408 finish(code);
409 case EXP_TCL_RETURN:
410 finish(TCL_RETURN);
411 case TCL_RETURN:
412 finish(TCL_OK);
413 default:
414 /* note that ccmd has trailing newline */
415 expErrorLog("error %d: ",code);
416 expErrorLogU(Tcl_GetString(Tcl_GetObjResult(interp)));
417 expErrorLogU("\r\n");
418 continue;
419 }
420 }
421 /* cannot fall thru here, must jump to label */
422 done:
423 if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);
424
425 Tcl_DecrRefCount(commandPtr);
426 return(code);
427 }
428
429 /*ARGSUSED*/
430 int
Exp_ExpVersionObjCmd(clientData,interp,objc,objv)431 Exp_ExpVersionObjCmd(clientData, interp, objc, objv)
432 ClientData clientData;
433 Tcl_Interp *interp;
434 int objc;
435 Tcl_Obj *CONST objv[]; /* Argument objects. */
436 {
437 int emajor, umajor;
438 char *user_version; /* user-supplied version string */
439
440 if (objc == 1) {
441 Tcl_SetResult(interp,exp_version,TCL_STATIC);
442 return(TCL_OK);
443 }
444 if (objc > 3) {
445 exp_error(interp,"usage: expect_version [[-exit] version]");
446 return(TCL_ERROR);
447 }
448
449 user_version = Tcl_GetString (objv[objc==2?1:2]);
450 emajor = atoi(exp_version);
451 umajor = atoi(user_version);
452
453 /* first check major numbers */
454 if (emajor == umajor) {
455 int u, e;
456
457 /* now check minor numbers */
458 char *dot = strchr(user_version,'.');
459 if (!dot) {
460 exp_error(interp,"version number must include a minor version number");
461 return TCL_ERROR;
462 }
463
464 u = atoi(dot+1);
465 dot = strchr(exp_version,'.');
466 e = atoi(dot+1);
467 if (e >= u) return(TCL_OK);
468 }
469
470 if (objc == 2) {
471 exp_error(interp,"%s requires Expect version %s (but using %s)",
472 exp_argv0,user_version,exp_version);
473 return(TCL_ERROR);
474 }
475 expErrorLog("%s requires Expect version %s (but is using %s)\r\n",
476 exp_argv0,user_version,exp_version);
477
478 /* SF #439042 -- Allow overide of "exit" by user / script
479 */
480 {
481 char buffer [] = "exit 1";
482 Tcl_Eval(interp, buffer);
483 }
484 /*NOTREACHED, but keep compiler from complaining*/
485 return TCL_ERROR;
486 }
487
488 static char init_auto_path[] = "\
489 if {$exp_library != \"\"} {\n\
490 lappend auto_path $exp_library\n\
491 }\n\
492 if {$exp_exec_library != \"\"} {\n\
493 lappend auto_path $exp_exec_library\n\
494 }";
495
496 static void
DeleteCmdInfo(clientData,interp)497 DeleteCmdInfo (clientData, interp)
498 ClientData clientData;
499 Tcl_Interp *interp;
500 {
501 ckfree (clientData);
502 }
503
504
505 int
Expect_Init(interp)506 Expect_Init(interp)
507 Tcl_Interp *interp;
508 {
509 static int first_time = TRUE;
510
511 Tcl_CmdInfo* close_info = NULL;
512 Tcl_CmdInfo* return_info = NULL;
513
514 if (first_time) {
515 #ifndef USE_TCL_STUBS
516 int tcl_major = atoi(TCL_VERSION);
517 char *dot = strchr(TCL_VERSION,'.');
518 int tcl_minor = atoi(dot+1);
519
520 if (tcl_major < NEED_TCL_MAJOR ||
521 (tcl_major == NEED_TCL_MAJOR && tcl_minor < NEED_TCL_MINOR)) {
522
523 char bufa [20];
524 char bufb [20];
525 Tcl_Obj* s = Tcl_NewStringObj (exp_argv0,-1);
526
527 sprintf(bufa,"%d.%d",tcl_major,tcl_minor);
528 sprintf(bufb,"%d.%d",NEED_TCL_MAJOR,NEED_TCL_MINOR);
529
530 Tcl_AppendStringsToObj (s,
531 " compiled with Tcl ", bufa,
532 " but needs at least Tcl ", bufb,
533 "\n", NULL);
534 Tcl_SetObjResult (interp, s);
535 return TCL_ERROR;
536 }
537 #endif
538 }
539
540 #ifndef USE_TCL_STUBS
541 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
542 return TCL_ERROR;
543 }
544 #else
545 if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
546 return TCL_ERROR;
547 }
548 #endif
549
550 /*
551 * Save initial close and return for later use
552 */
553
554 close_info = (Tcl_CmdInfo*) ckalloc (sizeof (Tcl_CmdInfo));
555 if (Tcl_GetCommandInfo(interp, "close", close_info) == 0) {
556 ckfree ((char*) close_info);
557 return TCL_ERROR;
558 }
559 return_info = (Tcl_CmdInfo*) ckalloc (sizeof (Tcl_CmdInfo));
560 if (Tcl_GetCommandInfo(interp, "return", return_info) == 0){
561 ckfree ((char*) close_info);
562 ckfree ((char*) return_info);
563 return TCL_ERROR;
564 }
565 Tcl_SetAssocData (interp, EXP_CMDINFO_CLOSE, DeleteCmdInfo, (ClientData) close_info);
566 Tcl_SetAssocData (interp, EXP_CMDINFO_RETURN, DeleteCmdInfo, (ClientData) return_info);
567
568 /*
569 * Expect redefines close so we need to save the original (pre-expect)
570 * definition so it can be restored before exiting.
571 *
572 * Needed when expect is dynamically loaded after close has
573 * been redefined e.g. the virtual file system in tclkit
574 */
575 if (TclRenameCommand(interp, "close", "_close.pre_expect") != TCL_OK) {
576 return TCL_ERROR;
577 }
578
579 if (Tcl_PkgProvide(interp, "Expect", PACKAGE_VERSION) != TCL_OK) {
580 return TCL_ERROR;
581 }
582
583 Tcl_Preserve(interp);
584 Tcl_CreateExitHandler(Tcl_Release,(ClientData)interp);
585
586 if (first_time) {
587 exp_getpid = getpid();
588 exp_init_pty();
589 exp_init_pty_exit();
590 exp_init_tty(); /* do this only now that we have looked at */
591 /* original tty state */
592 exp_init_stdio();
593 exp_init_sig();
594 exp_init_event();
595 exp_init_trap();
596 exp_init_unit_random();
597 exp_init_spawn_ids(interp);
598 expChannelInit();
599 expDiagInit();
600 expLogInit();
601 expDiagLogPtrSet(expDiagLogU);
602 expErrnoMsgSet(Tcl_ErrnoMsg);
603
604 Tcl_CreateExitHandler(exp_exit_handlers,(ClientData)interp);
605
606 first_time = FALSE;
607 }
608
609 /* save last known interp for emergencies */
610 exp_interp = interp;
611
612 /* initialize commands */
613 exp_init_most_cmds(interp); /* add misc cmds to interpreter */
614 exp_init_expect_cmds(interp); /* add expect cmds to interpreter */
615 exp_init_main_cmds(interp); /* add main cmds to interpreter */
616 exp_init_trap_cmds(interp); /* add trap cmds to interpreter */
617 exp_init_tty_cmds(interp); /* add tty cmds to interpreter */
618 exp_init_interact_cmds(interp); /* add interact cmds to interpreter */
619
620 /* initialize variables */
621 exp_init_spawn_id_vars(interp);
622 expExpectVarsInit();
623
624 /*
625 * For each of the the Tcl variables, "expect_library",
626 *"exp_library", and "exp_exec_library", set the variable
627 * if it does not already exist. This mechanism allows the
628 * application calling "Expect_Init()" to set these varaibles
629 * to alternate locations from where Expect was built.
630 */
631
632 if (Tcl_GetVar(interp, "expect_library", TCL_GLOBAL_ONLY) == NULL) {
633 Tcl_SetVar(interp,"expect_library",SCRIPTDIR,0);/* deprecated */
634 }
635 if (Tcl_GetVar(interp, "exp_library", TCL_GLOBAL_ONLY) == NULL) {
636 Tcl_SetVar(interp,"exp_library",SCRIPTDIR,0);
637 }
638 if (Tcl_GetVar(interp, "exp_exec_library", TCL_GLOBAL_ONLY) == NULL) {
639 Tcl_SetVar(interp,"exp_exec_library",EXECSCRIPTDIR,0);
640 }
641
642 Tcl_Eval(interp,init_auto_path);
643 Tcl_ResetResult(interp);
644
645 #ifdef TCL_DEBUGGER
646 Dbg_IgnoreFuncs(interp,ignore_procs);
647 #endif
648
649 return TCL_OK;
650 }
651
652 static char sigint_init_default[80];
653 static char sigterm_init_default[80];
654 static char debug_init_default[] = "trap {exp_debug 1} SIGINT";
655
656 void
exp_parse_argv(interp,argc,argv)657 exp_parse_argv(interp,argc,argv)
658 Tcl_Interp *interp;
659 int argc;
660 char **argv;
661 {
662 char argc_rep[10]; /* enough space for storing literal rep of argc */
663
664 int sys_rc = TRUE; /* read system rc file */
665 int my_rc = TRUE; /* read personal rc file */
666
667 int c;
668 int rc;
669
670 extern int optind;
671 extern char *optarg;
672 char *args; /* ptr to string-rep of all args */
673 char *debug_init;
674
675 exp_argv0 = argv[0];
676
677 #ifdef TCL_DEBUGGER
678 Dbg_ArgcArgv(argc,argv,1);
679 #endif
680
681 /* initially, we must assume we are not interactive */
682 /* this prevents interactive weirdness courtesy of unknown via -c */
683 /* after handling args, we can change our mind */
684 Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
685
686 /* there's surely a system macro to do this but I don't know what it is */
687 #define EXP_SIG_EXIT(signalnumber) (0x80|signalnumber)
688
689 sprintf(sigint_init_default, "trap {exit %d} SIGINT", EXP_SIG_EXIT(SIGINT));
690 Tcl_Eval(interp,sigint_init_default);
691 sprintf(sigterm_init_default,"trap {exit %d} SIGTERM",EXP_SIG_EXIT(SIGTERM));
692 Tcl_Eval(interp,sigterm_init_default);
693
694 /*
695 * [#418892]. The '+' character in front of every other option
696 * declaration causes 'GNU getopt' to deactivate its
697 * non-standard behaviour and switch to POSIX. Other
698 * implementations of 'getopt' might recognize the option '-+'
699 * because of this, but the following switch will catch this
700 * and generate a usage message.
701 */
702
703 while ((c = getopt(argc, argv, "+b:c:dD:f:inN-v")) != EOF) {
704 switch(c) {
705 case '-':
706 /* getopt already handles -- internally, however */
707 /* this allows us to abort getopt when dash is at */
708 /* the end of another option which is required */
709 /* in order to allow things like -n- on #! line */
710 goto abort_getopt;
711 case 'c': /* command */
712 exp_cmdlinecmds = TRUE;
713 rc = Tcl_Eval(interp,optarg);
714 if (rc != TCL_OK) {
715 expErrorLogU(exp_cook(Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY),(int *)0));
716 expErrorLogU("\r\n");
717 }
718 break;
719 case 'd': expDiagToStderrSet(TRUE);
720 expDiagLog("expect version %s\r\n",exp_version);
721 break;
722 #ifdef TCL_DEBUGGER
723 case 'D':
724 exp_tcl_debugger_available = TRUE;
725 if (Tcl_GetInt(interp,optarg,&rc) != TCL_OK) {
726 expErrorLog("%s: -D argument must be 0 or 1\r\n",exp_argv0);
727
728 /* SF #439042 -- Allow overide of "exit" by user / script
729 */
730 {
731 char buffer [] = "exit 1";
732 Tcl_Eval(interp, buffer);
733 }
734 }
735
736 /* set up trap handler before Dbg_On so user does */
737 /* not have to see it at first debugger prompt */
738 if (0 == (debug_init = getenv("EXPECT_DEBUG_INIT"))) {
739 debug_init = debug_init_default;
740 }
741 Tcl_Eval(interp,debug_init);
742 if (rc == 1) Dbg_On(interp,0);
743 break;
744 #endif
745 case 'f': /* name of cmd file */
746 exp_cmdfilename = optarg;
747 break;
748 case 'b': /* read cmdfile one part at a time */
749 exp_cmdfilename = optarg;
750 exp_buffer_command_input = TRUE;
751 break;
752 case 'i': /* interactive */
753 exp_interactive = TRUE;
754 break;
755 case 'n': /* don't read personal rc file */
756 my_rc = FALSE;
757 break;
758 case 'N': /* don't read system-wide rc file */
759 sys_rc = FALSE;
760 break;
761 case 'v':
762 printf("expect version %s\n", exp_version);
763
764 /* SF #439042 -- Allow overide of "exit" by user / script
765 */
766 {
767 char buffer [] = "exit 0";
768 Tcl_Eval(interp, buffer);
769 }
770 break;
771 default: usage(interp);
772 }
773 }
774
775 abort_getopt:
776
777 for (c = 0;c<argc;c++) {
778 expDiagLog("argv[%d] = ",c);
779 expDiagLogU(argv[c]);
780 expDiagLogU(" ");
781 }
782 expDiagLogU("\r\n");
783
784 /* if user hasn't explicitly requested we be interactive */
785 /* look for a file or some other source of commands */
786 if (!exp_interactive) {
787 /* get cmd file name, if we haven't got it already */
788 if (!exp_cmdfilename && (optind < argc)) {
789 exp_cmdfilename = argv[optind];
790 optind++;
791
792 /*
793 * [#418892]. Skip a "--" found immediately
794 * behind the name of the script to
795 * execute. Don't try this if there are no
796 * arguments behind the "--" anymore. All
797 * other appearances of "--" are handled by
798 * the "getopt"-loop above.
799 */
800
801 if ((optind < argc) &&
802 (0 == strcmp ("--", argv[optind]))) {
803 optind++;
804 }
805 }
806
807 if (exp_cmdfilename) {
808 if (streq(exp_cmdfilename,"-")) {
809 exp_cmdfile = stdin;
810 exp_cmdfilename = 0;
811 } else if (exp_buffer_command_input) {
812 errno = 0;
813 exp_cmdfile = fopen(exp_cmdfilename,"r");
814 if (exp_cmdfile) {
815 exp_cmdfilename = 0;
816 expCloseOnExec(fileno(exp_cmdfile));
817 } else {
818 CONST char *msg;
819
820 if (errno == 0) {
821 msg = "could not read - odd file name?";
822 } else {
823 msg = Tcl_ErrnoMsg(errno);
824 }
825 expErrorLog("%s: %s\r\n",exp_cmdfilename,msg);
826
827 /* SF #439042 -- Allow overide of "exit" by user / script
828 */
829 {
830 char buffer [] = "exit 1";
831 Tcl_Eval(interp, buffer);
832 }
833 }
834 }
835 } else if (!exp_cmdlinecmds) {
836 if (isatty(0)) {
837 /* no other source of commands, force interactive */
838 exp_interactive = TRUE;
839 } else {
840 /* read cmds from redirected stdin */
841 exp_cmdfile = stdin;
842 }
843 }
844 }
845
846 if (exp_interactive) {
847 Tcl_SetVar(interp, "tcl_interactive","1",TCL_GLOBAL_ONLY);
848 }
849
850 /* collect remaining args and make into argc, argv0, and argv */
851 sprintf(argc_rep,"%d",argc-optind);
852 Tcl_SetVar(interp,"argc",argc_rep,0);
853 expDiagLog("set argc %s\r\n",argc_rep);
854
855 if (exp_cmdfilename) {
856 Tcl_SetVar(interp,"argv0",exp_cmdfilename,0);
857 expDiagLog("set argv0 \"%s\"\r\n",exp_cmdfilename);
858 } else {
859 Tcl_SetVar(interp,"argv0",exp_argv0,0);
860 expDiagLog("set argv0 \"%s\"\r\n",exp_argv0);
861 }
862
863 args = Tcl_Merge(argc-optind,argv+optind);
864 expDiagLogU("set argv \"");
865 expDiagLogU(args);
866 expDiagLogU("\"\r\n");
867 Tcl_SetVar(interp,"argv",args,0);
868 Tcl_Free(args);
869
870 exp_interpret_rcfiles(interp,my_rc,sys_rc);
871 }
872
873 static void
print_result(interp)874 print_result (interp)
875 Tcl_Interp* interp;
876 {
877 char* msg = Tcl_GetStringResult (interp);
878 if (msg[0] != 0) {
879 expErrorLogU(msg);
880 expErrorLogU("\r\n");
881 }
882 }
883
884 static void
run_exit(interp)885 run_exit (interp)
886 Tcl_Interp* interp;
887 {
888 /* SF #439042 -- Allow overide of "exit" by user / script
889 */
890 char buffer [] = "exit 1";
891 Tcl_Eval(interp, buffer);
892 }
893
894 /* read rc files */
895 void
exp_interpret_rcfiles(interp,my_rc,sys_rc)896 exp_interpret_rcfiles(interp,my_rc,sys_rc)
897 Tcl_Interp *interp;
898 int my_rc;
899 int sys_rc;
900 {
901 int rc;
902
903 if (sys_rc) {
904 char file[200];
905 int fd;
906
907 sprintf(file,"%s/expect.rc",SCRIPTDIR);
908 if (-1 != (fd = open(file,0))) {
909 if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) {
910 expErrorLog("error executing system initialization file: %s\r\n",file);
911 if (rc != TCL_ERROR)
912 expErrorLog("Tcl_Eval = %d\r\n",rc);
913 print_result (interp);
914 run_exit (interp);
915 }
916 close(fd);
917 }
918 }
919 if (my_rc) {
920 char file[200];
921 char *home;
922 int fd;
923 char *getenv();
924
925 if ((NULL != (home = getenv("DOTDIR"))) ||
926 (NULL != (home = getenv("HOME")))) {
927 sprintf(file,"%s/.expect.rc",home);
928 if (-1 != (fd = open(file,0))) {
929 if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) {
930 expErrorLog("error executing file: %s\r\n",file);
931 if (rc != TCL_ERROR)
932 expErrorLog("Tcl_Eval = %d\r\n",rc);
933 print_result (interp);
934 run_exit (interp);
935 }
936 close(fd);
937 }
938 }
939 }
940 }
941
942 int
exp_interpret_cmdfilename(interp,filename)943 exp_interpret_cmdfilename(interp,filename)
944 Tcl_Interp *interp;
945 char *filename;
946 {
947 int rc;
948
949 expDiagLog("executing commands from command file %s\r\n",filename);
950
951 Tcl_ResetResult(interp);
952 if (TCL_OK != (rc = Tcl_EvalFile(interp,filename))) {
953 /* EvalFile doesn't bother to copy error to errorInfo */
954 /* so force it */
955 Tcl_AddErrorInfo(interp, "");
956 handle_eval_error(interp,0);
957 }
958 return rc;
959 }
960
961 int
exp_interpret_cmdfile(interp,fp)962 exp_interpret_cmdfile(interp,fp)
963 Tcl_Interp *interp;
964 FILE *fp;
965 {
966 int rc = 0;
967 int gotPartial;
968 int eof;
969
970 Tcl_DString dstring;
971 Tcl_DStringInit(&dstring);
972
973 expDiagLogU("executing commands from command file\r\n");
974
975 gotPartial = 0;
976 eof = FALSE;
977 while (1) {
978 char line[BUFSIZ];/* buffer for partial Tcl command */
979 char *ccmd; /* pointer to complete Tcl command */
980
981 if (fgets(line,BUFSIZ,fp) == NULL) {
982 if (!gotPartial) break;
983 eof = TRUE;
984 }
985 ccmd = Tcl_DStringAppend(&dstring,line,-1);
986 if (!Tcl_CommandComplete(ccmd) && !eof) {
987 gotPartial = 1;
988 continue; /* continue collecting command */
989 }
990 gotPartial = 0;
991
992 rc = Tcl_Eval(interp,ccmd);
993 Tcl_DStringFree(&dstring);
994 if (rc != TCL_OK) {
995 handle_eval_error(interp,0);
996 break;
997 }
998 if (eof) break;
999 }
1000 Tcl_DStringFree(&dstring);
1001 return rc;
1002 }
1003
1004 static struct exp_cmd_data cmd_data[] = {
1005 {"exp_version", Exp_ExpVersionObjCmd, 0, 0, 0},
1006 {"prompt1", Exp_Prompt1ObjCmd, 0, 0, EXP_NOPREFIX},
1007 {"prompt2", Exp_Prompt2ObjCmd, 0, 0, EXP_NOPREFIX},
1008 {0}};
1009
1010 void
exp_init_main_cmds(interp)1011 exp_init_main_cmds(interp)
1012 Tcl_Interp *interp;
1013 {
1014 exp_create_commands(interp,cmd_data);
1015 }
1016
1017 /*
1018 * Local Variables:
1019 * mode: c
1020 * c-basic-offset: 4
1021 * fill-column: 78
1022 * End:
1023 */
1024