exp_main_sub.c

   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.0"                /* 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
  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
  86 exp_pty_exit_for_tcl(clientData)
  87 ClientData clientData;
  88 {
  89   exp_pty_exit();
  90 }
  91
  92 static
  93 void
  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
 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
 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
 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
 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
 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
 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
 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
 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
 497 DeleteCmdInfo (clientData, interp)
 498      ClientData clientData;
 499      Tcl_Interp *interp;
 500 {
 501   ckfree (clientData);
 502 }
 503
 504
 505 int
 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
 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
 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
 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
 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
 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
 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
1011 exp_init_main_cmds(interp)
1012 Tcl_Interp *interp;
1013 {
1014         exp_create_commands(interp,cmd_data);
1015 }
1016 \f
1017 /*
1018  * Local Variables:
1019  * mode: c
1020  * c-basic-offset: 4
1021  * fill-column: 78
1022  * End:
1023  */