1/* expect.c - expect commands 2 3Written by: Don Libes, NIST, 2/6/90 4 5Design and implementation of this program was paid for by U.S. tax 6dollars. Therefore it is public domain. However, the author and NIST 7would appreciate credit if this program or parts of it are used. 8 9*/ 10 11#include <sys/types.h> 12#include <stdio.h> 13#include <signal.h> 14#include <errno.h> 15#include <ctype.h> /* for isspace */ 16#include <time.h> /* for time(3) */ 17 18#include "expect_cf.h" 19 20#ifdef HAVE_SYS_WAIT_H 21#include <sys/wait.h> 22#endif 23 24#ifdef HAVE_UNISTD_H 25# include <unistd.h> 26#endif 27 28#include "tclInt.h" 29 30#include "string.h" 31 32#include "exp_rename.h" 33#include "exp_prog.h" 34#include "exp_command.h" 35#include "exp_log.h" 36#include "exp_event.h" 37#include "exp_tty_in.h" 38#include "exp_tstamp.h" /* this should disappear when interact */ 39 /* loses ref's to it */ 40#ifdef TCL_DEBUGGER 41#include "tcldbg.h" 42#endif 43 44#include "retoglob.c" /* RE 2 GLOB translator C variant */ 45 46/* initial length of strings that we can guarantee patterns can match */ 47int exp_default_match_max = 2000; 48#define INIT_EXPECT_TIMEOUT_LIT "10" /* seconds */ 49#define INIT_EXPECT_TIMEOUT 10 /* seconds */ 50int exp_default_parity = TRUE; 51int exp_default_rm_nulls = TRUE; 52int exp_default_close_on_eof = TRUE; 53 54/* user variable names */ 55#define EXPECT_TIMEOUT "timeout" 56#define EXPECT_OUT "expect_out" 57 58extern int Exp_StringCaseMatch _ANSI_ARGS_((Tcl_UniChar *string, int strlen, 59 Tcl_UniChar *pattern,int plen, 60 int nocase,int *offset)); 61 62typedef struct ThreadSpecificData { 63 int timeout; 64} ThreadSpecificData; 65 66static Tcl_ThreadDataKey dataKey; 67 68/* 69 * addr of these placeholders appear as clientData in ExpectCmd * when called 70 * as expect_user and expect_tty. It would be nicer * to invoked 71 * expDevttyGet() but C doesn't allow this in an array initialization, sigh. 72 */ 73static ExpState StdinoutPlaceholder; 74static ExpState DevttyPlaceholder; 75 76/* 1 ecase struct is reserved for each case in the expect command. Note that 77 * eof/timeout don't use any of theirs, but the algorithm is simpler this way. 78 */ 79 80struct ecase { /* case for expect command */ 81 struct exp_i *i_list; 82 Tcl_Obj *pat; /* original pattern spec */ 83 Tcl_Obj *body; /* ptr to body to be executed upon match */ 84 Tcl_Obj *gate; /* For PAT_RE, a gate-keeper glob pattern 85 * which is quicker to match and reduces 86 * the number of calls into expensive RE 87 * matching. Optional. 88 */ 89#define PAT_EOF 1 90#define PAT_TIMEOUT 2 91#define PAT_DEFAULT 3 92#define PAT_FULLBUFFER 4 93#define PAT_GLOB 5 /* glob-style pattern list */ 94#define PAT_RE 6 /* regular expression */ 95#define PAT_EXACT 7 /* exact string */ 96#define PAT_NULL 8 /* ASCII 0 */ 97#define PAT_TYPES 9 /* used to size array of pattern type descriptions */ 98 int use; /* PAT_XXX */ 99 int simple_start; /* offset (chars) from start of buffer denoting where a 100 * glob or exact match begins */ 101 int transfer; /* if false, leave matched chars in input stream */ 102 int indices; /* if true, write indices */ 103 int iread; /* if true, reread indirects */ 104 int timestamp; /* if true, write timestamps */ 105#define CASE_UNKNOWN 0 106#define CASE_NORM 1 107#define CASE_LOWER 2 108 int Case; /* convert case before doing match? */ 109}; 110 111/* descriptions of the pattern types, used for debugging */ 112char *pattern_style[PAT_TYPES]; 113 114struct exp_cases_descriptor { 115 int count; 116 struct ecase **cases; 117}; 118 119/* This describes an Expect command */ 120static 121struct exp_cmd_descriptor { 122 int cmdtype; /* bg, before, after */ 123 int duration; /* permanent or temporary */ 124 int timeout_specified_by_flag; /* if -timeout flag used */ 125 int timeout; /* timeout period if flag used */ 126 struct exp_cases_descriptor ecd; 127 struct exp_i *i_list; 128} exp_cmds[4]; 129 130/* note that exp_cmds[FG] is just a fake, the real contents is stored in some 131 * dynamically-allocated variable. We use exp_cmds[FG] mostly as a well-known 132 * address and also as a convenience and so we allocate just a few of its 133 * fields that we need. 134 */ 135 136static void 137exp_cmd_init( 138 struct exp_cmd_descriptor *cmd, 139 int cmdtype, 140 int duration) 141{ 142 cmd->duration = duration; 143 cmd->cmdtype = cmdtype; 144 cmd->ecd.cases = 0; 145 cmd->ecd.count = 0; 146 cmd->i_list = 0; 147} 148 149static int i_read_errno;/* place to save errno, if i_read() == -1, so it 150 doesn't get overwritten before we get to read it */ 151 152#ifdef SIMPLE_EVENT 153static int alarm_fired; /* if alarm occurs */ 154#endif 155 156void exp_background_channelhandlers_run_all(); 157 158/* exp_indirect_updateX is called by Tcl when an indirect variable is set */ 159static char *exp_indirect_update1( /* 1-part Tcl variable names */ 160 Tcl_Interp *interp, 161 struct exp_cmd_descriptor *ecmd, 162 struct exp_i *exp_i); 163static char *exp_indirect_update2( /* 2-part Tcl variable names */ 164 ClientData clientData, 165 Tcl_Interp *interp, /* Interpreter containing variable. */ 166 char *name1, /* Name of variable. */ 167 char *name2, /* Second part of variable name. */ 168 int flags); /* Information about what happened. */ 169 170#ifdef SIMPLE_EVENT 171/*ARGSUSED*/ 172static RETSIGTYPE 173sigalarm_handler(int n) /* unused, for compatibility with STDC */ 174{ 175 alarm_fired = TRUE; 176} 177#endif /*SIMPLE_EVENT*/ 178 179/* free up everything in ecase */ 180static void 181free_ecase( 182 Tcl_Interp *interp, 183 struct ecase *ec, 184 int free_ilist) /* if we should free ilist */ 185{ 186 if (ec->i_list->duration == EXP_PERMANENT) { 187 if (ec->pat) { Tcl_DecrRefCount(ec->pat); } 188 if (ec->gate) { Tcl_DecrRefCount(ec->gate); } 189 if (ec->body) { Tcl_DecrRefCount(ec->body); } 190 } 191 192 if (free_ilist) { 193 ec->i_list->ecount--; 194 if (ec->i_list->ecount == 0) { 195 exp_free_i(interp,ec->i_list,exp_indirect_update2); 196 } 197 } 198 199 ckfree((char *)ec); /* NEW */ 200} 201 202/* free up any argv structures in the ecases */ 203static void 204free_ecases( 205 Tcl_Interp *interp, 206 struct exp_cmd_descriptor *eg, 207 int free_ilist) /* if true, free ilists */ 208{ 209 int i; 210 211 if (!eg->ecd.cases) return; 212 213 for (i=0;i<eg->ecd.count;i++) { 214 free_ecase(interp,eg->ecd.cases[i],free_ilist); 215 } 216 ckfree((char *)eg->ecd.cases); 217 218 eg->ecd.cases = 0; 219 eg->ecd.count = 0; 220} 221 222 223#if 0 224/* no standard defn for this, and some systems don't even have it, so avoid */ 225/* the whole quagmire by calling it something else */ 226static char *exp_strdup(char *s) 227{ 228 char *news = ckalloc(strlen(s) + 1); 229 strcpy(news,s); 230 return(news); 231} 232#endif 233 234/* return TRUE if string appears to be a set of arguments 235 The intent of this test is to support the ability of commands to have 236 all their args braced as one. This conflicts with the possibility of 237 actually intending to have a single argument. 238 The bad case is in expect which can have a single argument with embedded 239 \n's although it's rare. Examples that this code should handle: 240 \n FALSE (pattern) 241 \n\n FALSE 242 \n \n \n FALSE 243 foo FALSE 244 foo\n FALSE 245 \nfoo\n TRUE (set of args) 246 \nfoo\nbar TRUE 247 248 Current test is very cheap and almost always right :-) 249*/ 250int 251exp_one_arg_braced(Tcl_Obj *objPtr) /* INTL */ 252{ 253 int seen_nl = FALSE; 254 char *p = Tcl_GetString(objPtr); 255 256 for (;*p;p++) { 257 if (*p == '\n') { 258 seen_nl = TRUE; 259 continue; 260 } 261 262 if (!isspace(*p)) { /* INTL: ISO space */ 263 return(seen_nl); 264 } 265 } 266 return FALSE; 267} 268 269/* called to execute a command of only one argument - a hack to commands */ 270/* to be called with all args surrounded by an outer set of braces */ 271/* Returns a list object containing the new set of arguments */ 272/* Caller then has to either reinvoke itself, or better, simply replace 273 * its current argumnts */ 274/*ARGSUSED*/ 275Tcl_Obj* 276exp_eval_with_one_arg( 277 ClientData clientData, 278 Tcl_Interp *interp, 279 Tcl_Obj *CONST objv[]) /* Argument objects. */ 280{ 281 Tcl_Obj* res = Tcl_NewListObj (1,objv); 282 283#define NUM_STATIC_OBJS 20 284 Tcl_Token *tokenPtr; 285 CONST char *p; 286 CONST char *next; 287 int rc; 288 int bytesLeft, numWords; 289 Tcl_Parse parse; 290 291 /* 292 * Prepend the command name and the -nobrace switch so we can 293 * reinvoke without recursing. 294 */ 295 296 Tcl_ListObjAppendElement (interp, res, Tcl_NewStringObj("-nobrace", -1)); 297 298 p = Tcl_GetStringFromObj(objv[1], &bytesLeft); 299 300 /* 301 * Treat the pattern/action block like a series of Tcl commands. 302 * For each command, parse the command words, perform substititions 303 * on each word, and add the words to an array of values. We don't 304 * actually evaluate the individual commands, just the substitutions. 305 */ 306 307 do { 308 if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) 309 != TCL_OK) { 310 rc = TCL_ERROR; 311 goto done; 312 } 313 numWords = parse.numWords; 314 if (numWords > 0) { 315 /* 316 * Generate an array of objects for the words of the command. 317 */ 318 319 /* 320 * For each word, perform substitutions then store the 321 * result in the objs array. 322 */ 323 324 for (tokenPtr = parse.tokenPtr; numWords > 0; 325 numWords--, tokenPtr += (tokenPtr->numComponents + 1)) { 326 /* FUTURE: Save token information, do substitution later */ 327 328 Tcl_Obj* w = Tcl_EvalTokens(interp, tokenPtr+1, 329 tokenPtr->numComponents); 330 /* w has refCount 1 here, if not NULL */ 331 if (w == NULL) { 332 Tcl_DecrRefCount (res); 333 res = NULL; 334 goto done; 335 336 } 337 Tcl_ListObjAppendElement (interp, res, w); 338 Tcl_DecrRefCount (w); /* Local reference goes away */ 339 } 340 } 341 342 /* 343 * Advance to the next command in the script. 344 */ 345 next = parse.commandStart + parse.commandSize; 346 bytesLeft -= next - p; 347 p = next; 348 Tcl_FreeParse(&parse); 349 } while (bytesLeft > 0); 350 351 done: 352 return res; 353} 354 355static void 356ecase_clear(struct ecase *ec) 357{ 358 ec->i_list = 0; 359 ec->pat = 0; 360 ec->body = 0; 361 ec->transfer = TRUE; 362 ec->simple_start = 0; 363 ec->indices = FALSE; 364 ec->iread = FALSE; 365 ec->timestamp = FALSE; 366 ec->Case = CASE_NORM; 367 ec->use = PAT_GLOB; 368 ec->gate = NULL; 369} 370 371static struct ecase * 372ecase_new(void) 373{ 374 struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase)); 375 376 ecase_clear(ec); 377 return ec; 378} 379 380/* 381 382parse_expect_args parses the arguments to expect or its variants. 383It normally returns TCL_OK, and returns TCL_ERROR for failure. 384(It can't return i_list directly because there is no way to differentiate 385between clearing, say, expect_before and signalling an error.) 386 387eg (expect_global) is initialized to reflect the arguments parsed 388eg->ecd.cases is an array of ecases 389eg->ecd.count is the # of ecases 390eg->i_list is a linked list of exp_i's which represent the -i info 391 392Each exp_i is chained to the next so that they can be easily free'd if 393necessary. Each exp_i has a reference count. If the -i is not used 394(e.g., has no following patterns), the ref count will be 0. 395 396Each ecase points to an exp_i. Several ecases may point to the same exp_i. 397Variables named by indirect exp_i's are read for the direct values. 398 399If called from a foreground expect and no patterns or -i are given, a 400default exp_i is forced so that the command "expect" works right. 401 402The exp_i chain can be broken by the caller if desired. 403 404*/ 405 406static int 407parse_expect_args( 408 Tcl_Interp *interp, 409 struct exp_cmd_descriptor *eg, 410 ExpState *default_esPtr, /* suggested ExpState if called as expect_user or _tty */ 411 int objc, 412 Tcl_Obj *CONST objv[]) /* Argument objects. */ 413{ 414 int i; 415 char *string; 416 struct ecase ec; /* temporary to collect args */ 417 418 eg->timeout_specified_by_flag = FALSE; 419 420 ecase_clear(&ec); 421 422 /* Allocate an array to store the ecases. Force array even if 0 */ 423 /* cases. This will often be too large (i.e., if there are flags) */ 424 /* but won't affect anything. */ 425 426 eg->ecd.cases = (struct ecase **)ckalloc(sizeof(struct ecase *) * (1+(objc/2))); 427 428 eg->ecd.count = 0; 429 430 for (i = 1;i<objc;i++) { 431 int index; 432 string = Tcl_GetString(objv[i]); 433 if (string[0] == '-') { 434 static char *flags[] = { 435 "-glob", "-regexp", "-exact", "-notransfer", "-nocase", 436 "-i", "-indices", "-iread", "-timestamp", "-timeout", 437 "-nobrace", "--", (char *)0 438 }; 439 enum flags { 440 EXP_ARG_GLOB, EXP_ARG_REGEXP, EXP_ARG_EXACT, 441 EXP_ARG_NOTRANSFER, EXP_ARG_NOCASE, EXP_ARG_SPAWN_ID, 442 EXP_ARG_INDICES, EXP_ARG_IREAD, EXP_ARG_TIMESTAMP, 443 EXP_ARG_DASH_TIMEOUT, EXP_ARG_NOBRACE, EXP_ARG_DASH 444 }; 445 446 /* 447 * Allow abbreviations of switches and report an error if we 448 * get an invalid switch. 449 */ 450 451 if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0, 452 &index) != TCL_OK) { 453 return TCL_ERROR; 454 } 455 switch ((enum flags) index) { 456 case EXP_ARG_GLOB: 457 case EXP_ARG_DASH: 458 i++; 459 /* assignment here is not actually necessary */ 460 /* since cases are initialized this way above */ 461 /* ec.use = PAT_GLOB; */ 462 if (i >= objc) { 463 Tcl_WrongNumArgs(interp, 1, objv,"-glob pattern"); 464 return TCL_ERROR; 465 } 466 goto pattern; 467 case EXP_ARG_REGEXP: 468 i++; 469 if (i >= objc) { 470 Tcl_WrongNumArgs(interp, 1, objv,"-regexp regexp"); 471 return TCL_ERROR; 472 } 473 ec.use = PAT_RE; 474 475 /* 476 * Try compiling the expression so we can report 477 * any errors now rather then when we first try to 478 * use it. 479 */ 480 481 if (!(Tcl_GetRegExpFromObj(interp, objv[i], 482 TCL_REG_ADVANCED))) { 483 goto error; 484 } 485 486 /* Derive a gate keeper glob pattern which reduces the amount 487 * of RE matching. 488 */ 489 490 { 491 Tcl_Obj* g; 492 Tcl_UniChar* str; 493 int strlen; 494 495 str = Tcl_GetUnicodeFromObj (objv[i], &strlen); 496 g = exp_retoglob (str, strlen); 497 498 if (g) { 499 ec.gate = g; 500 501 expDiagLog("Gate keeper glob pattern for '%s'",Tcl_GetString(objv[i])); 502 expDiagLog(" is '%s'. Activating booster.\n",Tcl_GetString(g)); 503 } else { 504 /* Ignore errors, fall back to regular RE matching */ 505 expDiagLog("Gate keeper glob pattern for '%s'",Tcl_GetString(objv[i])); 506 expDiagLog(" is '%s'. Not usable, disabling the",Tcl_GetString(Tcl_GetObjResult (interp))); 507 expDiagLog(" performance booster.\n"); 508 } 509 } 510 511 goto pattern; 512 case EXP_ARG_EXACT: 513 i++; 514 if (i >= objc) { 515 Tcl_WrongNumArgs(interp, 1, objv, "-exact string"); 516 return TCL_ERROR; 517 } 518 ec.use = PAT_EXACT; 519 goto pattern; 520 case EXP_ARG_NOTRANSFER: 521 ec.transfer = 0; 522 break; 523 case EXP_ARG_NOCASE: 524 ec.Case = CASE_LOWER; 525 break; 526 case EXP_ARG_SPAWN_ID: 527 i++; 528 if (i>=objc) { 529 Tcl_WrongNumArgs(interp, 1, objv, "-i spawn_id"); 530 goto error; 531 } 532 ec.i_list = exp_new_i_complex(interp, 533 Tcl_GetString(objv[i]), 534 eg->duration, exp_indirect_update2); 535 if (!ec.i_list) goto error; 536 ec.i_list->cmdtype = eg->cmdtype; 537 538 /* link new i_list to head of list */ 539 ec.i_list->next = eg->i_list; 540 eg->i_list = ec.i_list; 541 break; 542 case EXP_ARG_INDICES: 543 ec.indices = TRUE; 544 break; 545 case EXP_ARG_IREAD: 546 ec.iread = TRUE; 547 break; 548 case EXP_ARG_TIMESTAMP: 549 ec.timestamp = TRUE; 550 break; 551 case EXP_ARG_DASH_TIMEOUT: 552 i++; 553 if (i>=objc) { 554 Tcl_WrongNumArgs(interp, 1, objv, "-timeout seconds"); 555 goto error; 556 } 557 if (Tcl_GetIntFromObj(interp, objv[i], 558 &eg->timeout) != TCL_OK) { 559 goto error; 560 } 561 eg->timeout_specified_by_flag = TRUE; 562 break; 563 case EXP_ARG_NOBRACE: 564 /* nobrace does nothing but take up space */ 565 /* on the command line which prevents */ 566 /* us from re-expanding any command lines */ 567 /* of one argument that looks like it should */ 568 /* be expanded to multiple arguments. */ 569 break; 570 } 571 /* 572 * Keep processing arguments, we aren't ready for the 573 * pattern yet. 574 */ 575 continue; 576 } else { 577 /* 578 * We have a pattern or keyword. 579 */ 580 581 static char *keywords[] = { 582 "timeout", "eof", "full_buffer", "default", "null", 583 (char *)NULL 584 }; 585 enum keywords { 586 EXP_ARG_TIMEOUT, EXP_ARG_EOF, EXP_ARG_FULL_BUFFER, 587 EXP_ARG_DEFAULT, EXP_ARG_NULL 588 }; 589 590 /* 591 * Match keywords exactly, otherwise they are patterns. 592 */ 593 594 if (Tcl_GetIndexFromObj(interp, objv[i], keywords, "keyword", 595 1 /* exact */, &index) != TCL_OK) { 596 Tcl_ResetResult(interp); 597 goto pattern; 598 } 599 switch ((enum keywords) index) { 600 case EXP_ARG_TIMEOUT: 601 ec.use = PAT_TIMEOUT; 602 break; 603 case EXP_ARG_EOF: 604 ec.use = PAT_EOF; 605 break; 606 case EXP_ARG_FULL_BUFFER: 607 ec.use = PAT_FULLBUFFER; 608 break; 609 case EXP_ARG_DEFAULT: 610 ec.use = PAT_DEFAULT; 611 break; 612 case EXP_ARG_NULL: 613 ec.use = PAT_NULL; 614 break; 615 } 616pattern: 617 /* if no -i, use previous one */ 618 if (!ec.i_list) { 619 /* if no -i flag has occurred yet, use default */ 620 if (!eg->i_list) { 621 if (default_esPtr != EXP_SPAWN_ID_BAD) { 622 eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); 623 } else { 624 default_esPtr = expStateCurrent(interp,0,0,1); 625 if (!default_esPtr) goto error; 626 eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); 627 } 628 } 629 ec.i_list = eg->i_list; 630 } 631 ec.i_list->ecount++; 632 633 /* save original pattern spec */ 634 /* keywords such as "-timeout" are saved as patterns here */ 635 /* useful for debugging but not otherwise used */ 636 637 ec.pat = objv[i]; 638 if (eg->duration == EXP_PERMANENT) { 639 Tcl_IncrRefCount(ec.pat); 640 if (ec.gate) { 641 Tcl_IncrRefCount(ec.gate); 642 } 643 } 644 645 i++; 646 if (i < objc) { 647 ec.body = objv[i]; 648 if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.body); 649 } else { 650 ec.body = NULL; 651 } 652 653 *(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec; 654 655 /* clear out for next set */ 656 ecase_clear(&ec); 657 658 eg->ecd.count++; 659 } 660 } 661 662 /* if no patterns at all have appeared force the current */ 663 /* spawn id to be added to list anyway */ 664 665 if (eg->i_list == 0) { 666 if (default_esPtr != EXP_SPAWN_ID_BAD) { 667 eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); 668 } else { 669 default_esPtr = expStateCurrent(interp,0,0,1); 670 if (!default_esPtr) goto error; 671 eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); 672 } 673 } 674 675 return(TCL_OK); 676 677 error: 678 /* very hard to free case_master_list here if it hasn't already */ 679 /* been attached to a case, ugh */ 680 681 /* note that i_list must be avail to free ecases! */ 682 free_ecases(interp,eg,0); 683 684 if (eg->i_list) 685 exp_free_i(interp,eg->i_list,exp_indirect_update2); 686 return(TCL_ERROR); 687} 688 689#define EXP_IS_DEFAULT(x) ((x) == EXP_TIMEOUT || (x) == EXP_EOF) 690 691static char yes[] = "yes\r\n"; 692static char no[] = "no\r\n"; 693 694/* this describes status of a successful match */ 695struct eval_out { 696 struct ecase *e; /* ecase that matched */ 697 ExpState *esPtr; /* ExpState that matched */ 698 Tcl_UniChar* matchbuf; /* Buffer that matched, */ 699 int matchlen; /* and #chars that matched, or 700 * #chars in buffer at EOF */ 701 /* This points into the esPtr->input.buffer ! */ 702}; 703 704 705 706 707/* 708 *---------------------------------------------------------------------- 709 * 710 * string_case_first -- 711 * 712 * Find the first instance of a pattern in a string. 713 * 714 * Results: 715 * Returns the pointer to the first instance of the pattern 716 * in the given string, or NULL if no match was found. 717 * 718 * Side effects: 719 * None. 720 * 721 *---------------------------------------------------------------------- 722 */ 723 724Tcl_UniChar * 725string_case_first( /* INTL */ 726 register Tcl_UniChar *string, /* String (unicode). */ 727 int length, /* length of above string */ 728 register char *pattern) /* Pattern, which may contain 729 * special characters (utf8). */ 730{ 731 Tcl_UniChar *s; 732 char *p; 733 int offset; 734 register int consumed = 0; 735 Tcl_UniChar ch1, ch2; 736 Tcl_UniChar *bufend = string + length; 737 738 while ((*string != 0) && (string < bufend)) { 739 s = string; 740 p = pattern; 741 while ((*s) && (s < bufend)) { 742 ch1 = *s++; 743 consumed++; 744 offset = TclUtfToUniChar(p, &ch2); 745 if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { 746 break; 747 } 748 p += offset; 749 } 750 if (*p == '\0') { 751 return string; 752 } 753 string++; 754 consumed++; 755 } 756 return NULL; 757} 758 759Tcl_UniChar * 760string_first( /* INTL */ 761 register Tcl_UniChar *string, /* String (unicode). */ 762 int length, /* length of above string */ 763 register char *pattern) /* Pattern, which may contain 764 * special characters (utf8). */ 765{ 766 Tcl_UniChar *s; 767 char *p; 768 int offset; 769 register int consumed = 0; 770 Tcl_UniChar ch1, ch2; 771 Tcl_UniChar *bufend = string + length; 772 773 while ((*string != 0) && (string < bufend)) { 774 s = string; 775 p = pattern; 776 while ((*s) && (s < bufend)) { 777 ch1 = *s++; 778 consumed++; 779 offset = TclUtfToUniChar(p, &ch2); 780 if (ch1 != ch2) { 781 break; 782 } 783 p += offset; 784 } 785 if (*p == '\0') { 786 return string; 787 } 788 string++; 789 consumed++; 790 } 791 return NULL; 792} 793 794Tcl_UniChar * 795string_first_char( /* INTL */ 796 register Tcl_UniChar *string, /* String. */ 797 register Tcl_UniChar pattern) 798{ 799 /* unicode based Tcl_UtfFindFirst */ 800 801 Tcl_UniChar find; 802 803 while (1) { 804 find = *string; 805 if (find == pattern) { 806 return string; 807 } 808 if (*string == '\0') { 809 return NULL; 810 } 811 string ++; 812 } 813 return NULL; 814} 815 816/* like eval_cases, but handles only a single cases that needs a real */ 817/* string match */ 818/* returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCLERRROR */ 819static int 820eval_case_string( 821 Tcl_Interp *interp, 822 struct ecase *e, 823 ExpState *esPtr, 824 struct eval_out *o, /* 'output' - i.e., final case of interest */ 825/* next two args are for debugging, when they change, reprint buffer */ 826 ExpState **last_esPtr, 827 int *last_case, 828 char *suffix) 829{ 830 Tcl_RegExp re; 831 Tcl_RegExpInfo info; 832 Tcl_Obj* buf; 833 Tcl_UniChar *str; 834 int numchars, flags, dummy, globmatch; 835 int result; 836 837 str = esPtr->input.buffer; 838 numchars = esPtr->input.use; 839 840 /* if ExpState or case changed, redisplay debug-buffer */ 841 if ((esPtr != *last_esPtr) || e->Case != *last_case) { 842 expDiagLog("\r\nexpect%s: does \"",suffix); 843 expDiagLogU(expPrintifyUni(str,numchars)); 844 expDiagLog("\" (spawn_id %s) match %s ",esPtr->name,pattern_style[e->use]); 845 *last_esPtr = esPtr; 846 *last_case = e->Case; 847 } 848 849 if (e->use == PAT_RE) { 850 expDiagLog("\""); 851 expDiagLogU(expPrintify(Tcl_GetString(e->pat))); 852 expDiagLog("\"? "); 853 854 if (e->gate) { 855 int plen; 856 Tcl_UniChar* pat = Tcl_GetUnicodeFromObj(e->gate,&plen); 857 858 expDiagLog("Gate \""); 859 expDiagLogU(expPrintify(Tcl_GetString(e->gate))); 860 expDiagLog("\"? gate="); 861 862 globmatch = Exp_StringCaseMatch(str, numchars, pat, plen, 863 (e->Case == CASE_NORM) ? 0 : 1, 864 &dummy); 865 } else { 866 expDiagLog("(No Gate, RE only) gate="); 867 868 /* No gate => RE matching always */ 869 globmatch = 1; 870 } 871 if (globmatch < 0) { 872 expDiagLogU(no); 873 /* i.e. no match */ 874 } else { 875 expDiagLog("yes re="); 876 877 if (e->Case == CASE_NORM) { 878 flags = TCL_REG_ADVANCED; 879 } else { 880 flags = TCL_REG_ADVANCED | TCL_REG_NOCASE; 881 } 882 883 re = Tcl_GetRegExpFromObj(interp, e->pat, flags); 884 885 /* ZZZ: Future optimization: Avoid copying */ 886 buf = Tcl_NewUnicodeObj (str, numchars); 887 Tcl_IncrRefCount (buf); 888 result = Tcl_RegExpExecObj(interp, re, buf, 0 /* offset */, 889 -1 /* nmatches */, 0 /* eflags */); 890 Tcl_DecrRefCount (buf); 891 if (result > 0) { 892 o->e = e; 893 894 /* 895 * Retrieve the byte offset of the end of the 896 * matched string. 897 */ 898 899 Tcl_RegExpGetInfo(re, &info); 900 o->matchlen = info.matches[0].end; 901 o->matchbuf = str; 902 o->esPtr = esPtr; 903 expDiagLogU(yes); 904 return(EXP_MATCH); 905 } else if (result == 0) { 906 expDiagLogU(no); 907 } else { /* result < 0 */ 908 return(EXP_TCLERROR); 909 } 910 } 911 } else if (e->use == PAT_GLOB) { 912 int match; /* # of chars that matched */ 913 914 expDiagLog("\""); 915 expDiagLogU(expPrintify(Tcl_GetString(e->pat))); 916 expDiagLog("\"? "); 917 if (str) { 918 int plen; 919 Tcl_UniChar* pat = Tcl_GetUnicodeFromObj(e->pat,&plen); 920 921 match = Exp_StringCaseMatch(str,numchars, pat, plen, 922 (e->Case == CASE_NORM) ? 0 : 1, 923 &e->simple_start); 924 if (match != -1) { 925 o->e = e; 926 o->matchlen = match; 927 o->matchbuf = str; 928 o->esPtr = esPtr; 929 expDiagLogU(yes); 930 return(EXP_MATCH); 931 } 932 } 933 expDiagLogU(no); 934 } else if (e->use == PAT_EXACT) { 935 int patLength; 936 char *pat = Tcl_GetStringFromObj(e->pat, &patLength); 937 Tcl_UniChar *p; 938 939 if (e->Case == CASE_NORM) { 940 p = string_first(str, numchars, pat); /* NEW function in this file, see above */ 941 } else { 942 p = string_case_first(str, numchars, pat); 943 } 944 945 expDiagLog("\""); 946 expDiagLogU(expPrintify(Tcl_GetString(e->pat))); 947 expDiagLog("\"? "); 948 if (p) { 949 e->simple_start = p - str; 950 o->e = e; 951 o->matchlen = patLength; 952 o->matchbuf = str; 953 o->esPtr = esPtr; 954 expDiagLogU(yes); 955 return(EXP_MATCH); 956 } else expDiagLogU(no); 957 } else if (e->use == PAT_NULL) { 958 CONST Tcl_UniChar *p; 959 expDiagLogU("null? "); 960 p = string_first_char (str, 0); /* NEW function in this file, see above */ 961 962 if (p) { 963 o->e = e; 964 o->matchlen = p-str; /* #chars */ 965 o->matchbuf = str; 966 o->esPtr = esPtr; 967 expDiagLogU(yes); 968 return EXP_MATCH; 969 } 970 expDiagLogU(no); 971 } else if (e->use == PAT_FULLBUFFER) { 972 expDiagLogU(Tcl_GetString(e->pat)); 973 expDiagLogU("? "); 974 /* this must be the same test as in expIRead */ 975 /* We drop one third when are at least 2/3 full */ 976 /* condition is (size >= max*2/3) <=> (size*3 >= max*2) */ 977 if (((expSizeGet(esPtr)*3) >= (esPtr->input.max*2)) && (numchars > 0)) { 978 o->e = e; 979 o->matchlen = numchars; 980 o->matchbuf = str; 981 o->esPtr = esPtr; 982 expDiagLogU(yes); 983 return(EXP_FULLBUFFER); 984 } else { 985 expDiagLogU(no); 986 } 987 } 988 return(EXP_NOMATCH); 989} 990 991/* sets o.e if successfully finds a matching pattern, eof, timeout or deflt */ 992/* returns original status arg or EXP_TCLERROR */ 993static int 994eval_cases( 995 Tcl_Interp *interp, 996 struct exp_cmd_descriptor *eg, 997 ExpState *esPtr, 998 struct eval_out *o, /* 'output' - i.e., final case of interest */ 999/* next two args are for debugging, when they change, reprint buffer */ 1000 ExpState **last_esPtr, 1001 int *last_case, 1002 int status, 1003 ExpState *(esPtrs[]), 1004 int mcount, 1005 char *suffix) 1006{ 1007 int i; 1008 ExpState *em; /* ExpState of ecase */ 1009 struct ecase *e; 1010 1011 if (o->e || status == EXP_TCLERROR || eg->ecd.count == 0) return(status); 1012 1013 if (status == EXP_TIMEOUT) { 1014 for (i=0;i<eg->ecd.count;i++) { 1015 e = eg->ecd.cases[i]; 1016 if (e->use == PAT_TIMEOUT || e->use == PAT_DEFAULT) { 1017 o->e = e; 1018 break; 1019 } 1020 } 1021 return(status); 1022 } else if (status == EXP_EOF) { 1023 for (i=0;i<eg->ecd.count;i++) { 1024 e = eg->ecd.cases[i]; 1025 if (e->use == PAT_EOF || e->use == PAT_DEFAULT) { 1026 struct exp_state_list *slPtr; 1027 1028 for (slPtr=e->i_list->state_list; slPtr ;slPtr=slPtr->next) { 1029 em = slPtr->esPtr; 1030 if (expStateAnyIs(em) || em == esPtr) { 1031 o->e = e; 1032 return(status); 1033 } 1034 } 1035 } 1036 } 1037 return(status); 1038 } 1039 1040 /* the top loops are split from the bottom loop only because I can't */ 1041 /* split'em further. */ 1042 1043 /* The bufferful condition does not prevent a pattern match from */ 1044 /* occurring and vice versa, so it is scanned with patterns */ 1045 for (i=0;i<eg->ecd.count;i++) { 1046 struct exp_state_list *slPtr; 1047 int j; 1048 1049 e = eg->ecd.cases[i]; 1050 if (e->use == PAT_TIMEOUT || 1051 e->use == PAT_DEFAULT || 1052 e->use == PAT_EOF) continue; 1053 1054 for (slPtr = e->i_list->state_list; slPtr; slPtr = slPtr->next) { 1055 em = slPtr->esPtr; 1056 /* if em == EXP_SPAWN_ID_ANY, then user is explicitly asking */ 1057 /* every case to be checked against every ExpState */ 1058 if (expStateAnyIs(em)) { 1059 /* test against each spawn_id */ 1060 for (j=0;j<mcount;j++) { 1061 status = eval_case_string(interp,e,esPtrs[j],o, 1062 last_esPtr,last_case,suffix); 1063 if (status != EXP_NOMATCH) return(status); 1064 } 1065 } else { 1066 /* reject things immediately from wrong spawn_id */ 1067 if (em != esPtr) continue; 1068 1069 status = eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix); 1070 if (status != EXP_NOMATCH) return(status); 1071 } 1072 } 1073 } 1074 return(EXP_NOMATCH); 1075} 1076 1077static void 1078ecases_remove_by_expi( 1079 Tcl_Interp *interp, 1080 struct exp_cmd_descriptor *ecmd, 1081 struct exp_i *exp_i) 1082{ 1083 int i; 1084 1085 /* delete every ecase dependent on it */ 1086 for (i=0;i<ecmd->ecd.count;) { 1087 struct ecase *e = ecmd->ecd.cases[i]; 1088 if (e->i_list == exp_i) { 1089 free_ecase(interp,e,0); 1090 1091 /* shift remaining elements down */ 1092 /* but only if there are any left */ 1093 if (i+1 != ecmd->ecd.count) { 1094 memcpy(&ecmd->ecd.cases[i], 1095 &ecmd->ecd.cases[i+1], 1096 ((ecmd->ecd.count - i) - 1) * 1097 sizeof(struct exp_cmd_descriptor *)); 1098 } 1099 ecmd->ecd.count--; 1100 if (0 == ecmd->ecd.count) { 1101 ckfree((char *)ecmd->ecd.cases); 1102 ecmd->ecd.cases = 0; 1103 } 1104 } else { 1105 i++; 1106 } 1107 } 1108} 1109 1110/* remove exp_i from list */ 1111static void 1112exp_i_remove( 1113 Tcl_Interp *interp, 1114 struct exp_i **ei, /* list to remove from */ 1115 struct exp_i *exp_i) /* element to remove */ 1116{ 1117 /* since it's in middle of list, free exp_i by hand */ 1118 for (;*ei; ei = &(*ei)->next) { 1119 if (*ei == exp_i) { 1120 *ei = exp_i->next; 1121 exp_i->next = 0; 1122 exp_free_i(interp,exp_i,exp_indirect_update2); 1123 break; 1124 } 1125 } 1126} 1127 1128/* remove exp_i from list and remove any dependent ecases */ 1129static void 1130exp_i_remove_with_ecases( 1131 Tcl_Interp *interp, 1132 struct exp_cmd_descriptor *ecmd, 1133 struct exp_i *exp_i) 1134{ 1135 ecases_remove_by_expi(interp,ecmd,exp_i); 1136 exp_i_remove(interp,&ecmd->i_list,exp_i); 1137} 1138 1139/* remove ecases tied to a single direct spawn id */ 1140static void 1141ecmd_remove_state( 1142 Tcl_Interp *interp, 1143 struct exp_cmd_descriptor *ecmd, 1144 ExpState *esPtr, 1145 int direct) 1146{ 1147 struct exp_i *exp_i, *next; 1148 struct exp_state_list **slPtr; 1149 1150 for (exp_i=ecmd->i_list;exp_i;exp_i=next) { 1151 next = exp_i->next; 1152 1153 if (!(direct & exp_i->direct)) continue; 1154 1155 for (slPtr = &exp_i->state_list;*slPtr;) { 1156 if (esPtr == ((*slPtr)->esPtr)) { 1157 struct exp_state_list *tmp = *slPtr; 1158 *slPtr = (*slPtr)->next; 1159 exp_free_state_single(tmp); 1160 1161 /* if last bg ecase, disarm spawn id */ 1162 if ((ecmd->cmdtype == EXP_CMD_BG) && (!expStateAnyIs(esPtr))) { 1163 esPtr->bg_ecount--; 1164 if (esPtr->bg_ecount == 0) { 1165 exp_disarm_background_channelhandler(esPtr); 1166 esPtr->bg_interp = 0; 1167 } 1168 } 1169 1170 continue; 1171 } 1172 slPtr = &(*slPtr)->next; 1173 } 1174 1175 /* if left with no ExpStates (and is direct), get rid of it */ 1176 /* and any dependent ecases */ 1177 if (exp_i->direct == EXP_DIRECT && !exp_i->state_list) { 1178 exp_i_remove_with_ecases(interp,ecmd,exp_i); 1179 } 1180 } 1181} 1182 1183/* this is called from exp_close to clean up the ExpState */ 1184void 1185exp_ecmd_remove_state_direct_and_indirect( 1186 Tcl_Interp *interp, 1187 ExpState *esPtr) 1188{ 1189 ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BEFORE],esPtr,EXP_DIRECT|EXP_INDIRECT); 1190 ecmd_remove_state(interp,&exp_cmds[EXP_CMD_AFTER],esPtr,EXP_DIRECT|EXP_INDIRECT); 1191 ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BG],esPtr,EXP_DIRECT|EXP_INDIRECT); 1192 1193 /* force it - explanation in exp_tk.c where this func is defined */ 1194 exp_disarm_background_channelhandler_force(esPtr); 1195} 1196 1197/* arm a list of background ExpState's */ 1198static void 1199state_list_arm( 1200 Tcl_Interp *interp, 1201 struct exp_state_list *slPtr) 1202{ 1203 /* for each spawn id in list, arm if necessary */ 1204 for (;slPtr;slPtr=slPtr->next) { 1205 ExpState *esPtr = slPtr->esPtr; 1206 if (expStateAnyIs(esPtr)) continue; 1207 1208 if (esPtr->bg_ecount == 0) { 1209 exp_arm_background_channelhandler(esPtr); 1210 esPtr->bg_interp = interp; 1211 } 1212 esPtr->bg_ecount++; 1213 } 1214} 1215 1216/* return TRUE if this ecase is used by this fd */ 1217static int 1218exp_i_uses_state( 1219 struct exp_i *exp_i, 1220 ExpState *esPtr) 1221{ 1222 struct exp_state_list *fdp; 1223 1224 for (fdp = exp_i->state_list;fdp;fdp=fdp->next) { 1225 if (fdp->esPtr == esPtr) return 1; 1226 } 1227 return 0; 1228} 1229 1230static void 1231ecase_append( 1232 Tcl_Interp *interp, 1233 struct ecase *ec) 1234{ 1235 if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer"); 1236 if (ec->indices) Tcl_AppendElement(interp,"-indices"); 1237 if (!ec->Case) Tcl_AppendElement(interp,"-nocase"); 1238 1239 if (ec->use == PAT_RE) Tcl_AppendElement(interp,"-re"); 1240 else if (ec->use == PAT_GLOB) Tcl_AppendElement(interp,"-gl"); 1241 else if (ec->use == PAT_EXACT) Tcl_AppendElement(interp,"-ex"); 1242 Tcl_AppendElement(interp,Tcl_GetString(ec->pat)); 1243 Tcl_AppendElement(interp,ec->body?Tcl_GetString(ec->body):""); 1244} 1245 1246/* append all ecases that match this exp_i */ 1247static void 1248ecase_by_exp_i_append( 1249 Tcl_Interp *interp, 1250 struct exp_cmd_descriptor *ecmd, 1251 struct exp_i *exp_i) 1252{ 1253 int i; 1254 for (i=0;i<ecmd->ecd.count;i++) { 1255 if (ecmd->ecd.cases[i]->i_list == exp_i) { 1256 ecase_append(interp,ecmd->ecd.cases[i]); 1257 } 1258 } 1259} 1260 1261static void 1262exp_i_append( 1263 Tcl_Interp *interp, 1264 struct exp_i *exp_i) 1265{ 1266 Tcl_AppendElement(interp,"-i"); 1267 if (exp_i->direct == EXP_INDIRECT) { 1268 Tcl_AppendElement(interp,exp_i->variable); 1269 } else { 1270 struct exp_state_list *fdp; 1271 1272 /* if more than one element, add braces */ 1273 if (exp_i->state_list->next) { 1274 Tcl_AppendResult(interp," {",(char *)0); 1275 } 1276 1277 for (fdp = exp_i->state_list;fdp;fdp=fdp->next) { 1278 char buf[25]; /* big enough for a small int */ 1279 sprintf(buf,"%ld", (long)fdp->esPtr); 1280 Tcl_AppendElement(interp,buf); 1281 } 1282 1283 if (exp_i->state_list->next) { 1284 Tcl_AppendResult(interp,"} ",(char *)0); 1285 } 1286} 1287} 1288 1289/* return current setting of the permanent expect_before/after/bg */ 1290int 1291expect_info( 1292 Tcl_Interp *interp, 1293 struct exp_cmd_descriptor *ecmd, 1294 int objc, 1295 Tcl_Obj *CONST objv[]) /* Argument objects. */ 1296{ 1297 struct exp_i *exp_i; 1298 int i; 1299 int direct = EXP_DIRECT|EXP_INDIRECT; 1300 char *iflag = 0; 1301 int all = FALSE; /* report on all fds */ 1302 ExpState *esPtr = 0; 1303 1304 static char *flags[] = {"-i", "-all", "-noindirect", (char *)0}; 1305 enum flags {EXP_ARG_I, EXP_ARG_ALL, EXP_ARG_NOINDIRECT}; 1306 1307 /* start with 2 to skip over "cmdname -info" */ 1308 for (i = 2;i<objc;i++) { 1309 /* 1310 * Allow abbreviations of switches and report an error if we 1311 * get an invalid switch. 1312 */ 1313 1314 int index; 1315 if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0, 1316 &index) != TCL_OK) { 1317 return TCL_ERROR; 1318 } 1319 switch ((enum flags) index) { 1320 case EXP_ARG_I: 1321 i++; 1322 if (i >= objc) { 1323 Tcl_WrongNumArgs(interp, 1, objv,"-i spawn_id"); 1324 return TCL_ERROR; 1325 } 1326 break; 1327 case EXP_ARG_ALL: 1328 all = TRUE; 1329 break; 1330 case EXP_ARG_NOINDIRECT: 1331 direct &= ~EXP_INDIRECT; 1332 break; 1333 } 1334 } 1335 1336 if (all) { 1337 /* avoid printing out -i when redundant */ 1338 struct exp_i *previous = 0; 1339 1340 for (i=0;i<ecmd->ecd.count;i++) { 1341 if (previous != ecmd->ecd.cases[i]->i_list) { 1342 exp_i_append(interp,ecmd->ecd.cases[i]->i_list); 1343 previous = ecmd->ecd.cases[i]->i_list; 1344 } 1345 ecase_append(interp,ecmd->ecd.cases[i]); 1346 } 1347 return TCL_OK; 1348 } 1349 1350 if (!iflag) { 1351 if (!(esPtr = expStateCurrent(interp,0,0,0))) { 1352 return TCL_ERROR; 1353 } 1354 } else if (!(esPtr = expStateFromChannelName(interp,iflag,0,0,0,"dummy"))) { 1355 /* not a valid ExpState so assume it is an indirect variable */ 1356 Tcl_ResetResult(interp); 1357 for (i=0;i<ecmd->ecd.count;i++) { 1358 if (ecmd->ecd.cases[i]->i_list->direct == EXP_INDIRECT && 1359 streq(ecmd->ecd.cases[i]->i_list->variable,iflag)) { 1360 ecase_append(interp,ecmd->ecd.cases[i]); 1361 } 1362 } 1363 return TCL_OK; 1364 } 1365 1366 /* print ecases of this direct_fd */ 1367 for (exp_i=ecmd->i_list;exp_i;exp_i=exp_i->next) { 1368 if (!(direct & exp_i->direct)) continue; 1369 if (!exp_i_uses_state(exp_i,esPtr)) continue; 1370 ecase_by_exp_i_append(interp,ecmd,exp_i); 1371 } 1372 1373 return TCL_OK; 1374} 1375 1376/* Exp_ExpectGlobalObjCmd is invoked to process expect_before/after/background */ 1377/*ARGSUSED*/ 1378int 1379Exp_ExpectGlobalObjCmd( 1380 ClientData clientData, 1381 Tcl_Interp *interp, 1382 int objc, 1383 Tcl_Obj *CONST objv[]) /* Argument objects. */ 1384{ 1385 int result = TCL_OK; 1386 struct exp_i *exp_i, **eip; 1387 struct exp_state_list *slPtr; /* temp for interating over state_list */ 1388 struct exp_cmd_descriptor eg; 1389 int count; 1390 Tcl_Obj* new_cmd = NULL; 1391 1392 struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData; 1393 1394 if ((objc == 2) && exp_one_arg_braced(objv[1])) { 1395 /* expect {...} */ 1396 1397 new_cmd = exp_eval_with_one_arg(clientData,interp,objv); 1398 if (!new_cmd) return TCL_ERROR; 1399 } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { 1400 /* expect -brace {...} ... fake command line for reparsing */ 1401 1402 Tcl_Obj *new_objv[2]; 1403 new_objv[0] = objv[0]; 1404 new_objv[1] = objv[2]; 1405 1406 new_cmd = exp_eval_with_one_arg(clientData,interp,new_objv); 1407 if (!new_cmd) return TCL_ERROR; 1408 } 1409 1410 if (new_cmd) { 1411 /* Replace old arguments with result of the reparse */ 1412 Tcl_ListObjGetElements (interp, new_cmd, &objc, (Tcl_Obj***) &objv); 1413 } 1414 1415 if (objc > 1 && (Tcl_GetString(objv[1])[0] == '-')) { 1416 if (exp_flageq("info",Tcl_GetString(objv[1])+1,4)) { 1417 int res = expect_info(interp,ecmd,objc,objv); 1418 if (new_cmd) { Tcl_DecrRefCount (new_cmd); } 1419 return res; 1420 } 1421 } 1422 1423 exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT); 1424 1425 if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD, 1426 objc,objv)) { 1427 if (new_cmd) { Tcl_DecrRefCount (new_cmd); } 1428 return TCL_ERROR; 1429 } 1430 1431 /* 1432 * visit each NEW direct exp_i looking for spawn ids. 1433 * When found, remove them from any OLD exp_i's. 1434 */ 1435 1436 /* visit each exp_i */ 1437 for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) { 1438 if (exp_i->direct == EXP_INDIRECT) continue; 1439 /* for each spawn id, remove it from ecases */ 1440 for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { 1441 ExpState *esPtr = slPtr->esPtr; 1442 1443 /* validate all input descriptors */ 1444 if (!expStateAnyIs(esPtr)) { 1445 if (!expStateCheck(interp,esPtr,1,1,"expect")) { 1446 result = TCL_ERROR; 1447 goto cleanup; 1448 } 1449 } 1450 1451 /* remove spawn id from exp_i */ 1452 ecmd_remove_state(interp,ecmd,esPtr,EXP_DIRECT); 1453 } 1454 } 1455 1456 /* 1457 * For each indirect variable, release its old ecases and 1458 * clean up the matching spawn ids. 1459 * Same logic as in "expect_X delete" command. 1460 */ 1461 1462 for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) { 1463 struct exp_i **old_i; 1464 1465 if (exp_i->direct == EXP_DIRECT) continue; 1466 1467 for (old_i = &ecmd->i_list;*old_i;) { 1468 struct exp_i *tmp; 1469 1470 if (((*old_i)->direct == EXP_DIRECT) || 1471 (!streq((*old_i)->variable,exp_i->variable))) { 1472 old_i = &(*old_i)->next; 1473 continue; 1474 } 1475 1476 ecases_remove_by_expi(interp,ecmd,*old_i); 1477 1478 /* unlink from middle of list */ 1479 tmp = *old_i; 1480 *old_i = tmp->next; 1481 tmp->next = 0; 1482 exp_free_i(interp,tmp,exp_indirect_update2); 1483 } 1484 1485 /* if new one has ecases, update it */ 1486 if (exp_i->ecount) { 1487 /* Note: The exp_indirect_ functions are Tcl_VarTraceProc's, and 1488 * are used as such in other places of Expect. We cannot use a 1489 * Tcl_Obj* as return value :( 1490 */ 1491 char *msg = exp_indirect_update1(interp,ecmd,exp_i); 1492 if (msg) { 1493 /* unusual way of handling error return */ 1494 /* because of Tcl's variable tracing */ 1495 Tcl_SetResult (interp, msg, TCL_VOLATILE); 1496 result = TCL_ERROR; 1497 goto indirect_update_abort; 1498 } 1499 } 1500 } 1501 /* empty i_lists have to be removed from global eg.i_list */ 1502 /* before returning, even if during error */ 1503 indirect_update_abort: 1504 1505 /* 1506 * New exp_i's that have 0 ecases indicate fd/vars to be deleted. 1507 * Now that the deletions have been done, discard the new exp_i's. 1508 */ 1509 1510 for (exp_i=eg.i_list;exp_i;) { 1511 struct exp_i *next = exp_i->next; 1512 1513 if (exp_i->ecount == 0) { 1514 exp_i_remove(interp,&eg.i_list,exp_i); 1515 } 1516 exp_i = next; 1517 } 1518 if (result == TCL_ERROR) goto cleanup; 1519 1520 /* 1521 * arm all new bg direct fds 1522 */ 1523 1524 if (ecmd->cmdtype == EXP_CMD_BG) { 1525 for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) { 1526 if (exp_i->direct == EXP_DIRECT) { 1527 state_list_arm(interp,exp_i->state_list); 1528 } 1529 } 1530 } 1531 1532 /* 1533 * now that old ecases are gone, add new ecases and exp_i's (both 1534 * direct and indirect). 1535 */ 1536 1537 /* append ecases */ 1538 1539 count = ecmd->ecd.count + eg.ecd.count; 1540 if (eg.ecd.count) { 1541 int start_index; /* where to add new ecases in old list */ 1542 1543 if (ecmd->ecd.count) { 1544 /* append to end */ 1545 ecmd->ecd.cases = (struct ecase **)ckrealloc((char *)ecmd->ecd.cases, count * sizeof(struct ecase *)); 1546 start_index = ecmd->ecd.count; 1547 } else { 1548 /* append to beginning */ 1549 ecmd->ecd.cases = (struct ecase **)ckalloc(eg.ecd.count * sizeof(struct ecase *)); 1550 start_index = 0; 1551 } 1552 memcpy(&ecmd->ecd.cases[start_index],eg.ecd.cases, 1553 eg.ecd.count*sizeof(struct ecase *)); 1554 ecmd->ecd.count = count; 1555 } 1556 1557 /* append exp_i's */ 1558 for (eip = &ecmd->i_list;*eip;eip = &(*eip)->next) { 1559 /* empty loop to get to end of list */ 1560 } 1561 /* *exp_i now points to end of list */ 1562 1563 *eip = eg.i_list; /* connect new list to end of current list */ 1564 1565 cleanup: 1566 if (result == TCL_ERROR) { 1567 /* in event of error, free any unreferenced ecases */ 1568 /* but first, split up i_list so that exp_i's aren't */ 1569 /* freed twice */ 1570 1571 for (exp_i=eg.i_list;exp_i;) { 1572 struct exp_i *next = exp_i->next; 1573 exp_i->next = 0; 1574 exp_i = next; 1575 } 1576 free_ecases(interp,&eg,1); 1577 } else { 1578 if (eg.ecd.cases) ckfree((char *)eg.ecd.cases); 1579 } 1580 1581 if (ecmd->cmdtype == EXP_CMD_BG) { 1582 exp_background_channelhandlers_run_all(); 1583 } 1584 1585 if (new_cmd) { Tcl_DecrRefCount (new_cmd); } 1586 return(result); 1587} 1588 1589/* adjusts file according to user's size request */ 1590void 1591expAdjust(ExpState *esPtr) 1592{ 1593 int new_msize, excess; 1594 Tcl_UniChar *string; 1595 1596 /* 1597 * Resize buffer to user's request * 3 + 1. 1598 * 1599 * x3: in case the match straddles two bufferfuls, and to allow 1600 * reading a bufferful even when we reach near fullness of two. 1601 * (At shuffle time this means we look for 2/3 full buffer and 1602 * drop a 1/3, i.e. half of that). 1603 * 1604 * NOTE: The unmodified expect got the same effect by comparing 1605 * apples and oranges in shuffle mgmt, i.e bytes vs. chars, 1606 * and automatically extending the buffer (Tcl_Obj string) 1607 * to hold that much. 1608 * 1609 * +1: for trailing null. 1610 */ 1611 1612 new_msize = esPtr->umsize * 3 + 1; 1613 1614 if (new_msize != esPtr->input.max) { 1615 1616 if (esPtr->input.use > new_msize) { 1617 /* 1618 * too much data, forget about data at beginning of buffer 1619 */ 1620 1621 string = esPtr->input.buffer; 1622 excess = esPtr->input.use - new_msize; /* #chars */ 1623 1624 memcpy (string, string + excess, new_msize * sizeof (Tcl_UniChar)); 1625 esPtr->input.use = new_msize; 1626 1627 } else { 1628 /* 1629 * too little data - length < new_mbytes 1630 * Make larger if the max is also too small. 1631 */ 1632 1633 if (esPtr->input.max < new_msize) { 1634 esPtr->input.buffer = (Tcl_UniChar*) \ 1635 Tcl_Realloc ((char*)esPtr->input.buffer, 1636 new_msize * sizeof (Tcl_UniChar)); 1637 } 1638 } 1639 1640 esPtr->key = expect_key++; 1641 esPtr->input.max = new_msize; 1642 } 1643} 1644 1645#if OBSOLETE 1646/* Strip parity */ 1647static void 1648expParityStrip( 1649 Tcl_Obj *obj, 1650 int offsetBytes) 1651{ 1652 char *p, ch; 1653 1654 int changed = FALSE; 1655 1656 for (p = Tcl_GetString(obj) + offsetBytes;*p;p++) { 1657 ch = *p & 0x7f; 1658 if (ch != *p) changed = TRUE; 1659 else *p &= 0x7f; 1660 } 1661 1662 if (changed) { 1663 /* invalidate the unicode rep */ 1664 if (obj->typePtr->freeIntRepProc) { 1665 obj->typePtr->freeIntRepProc(obj); 1666 } 1667 } 1668} 1669 1670/* This function is only used when debugging. It checks when a string's 1671 internal UTF is sane and whether an offset into the string appears to 1672 be at a UTF boundary. 1673*/ 1674static void 1675expValid( 1676 Tcl_Obj *obj, 1677 int offset) 1678{ 1679 char *s, *end; 1680 int len; 1681 1682 s = Tcl_GetStringFromObj(obj,&len); 1683 1684 if (offset > len) { 1685 printf("offset (%d) > length (%d)\n",offset,len); 1686 fflush(stdout); 1687 abort(); 1688 } 1689 1690 /* first test for null terminator */ 1691 end = s + len; 1692 if (*end != '\0') { 1693 printf("obj lacks null terminator\n"); 1694 fflush(stdout); 1695 abort(); 1696 } 1697 1698 /* check for valid UTF sequence */ 1699 while (*s) { 1700 Tcl_UniChar uc; 1701 1702 s += TclUtfToUniChar(s,&uc); 1703 if (s > end) { 1704 printf("UTF out of sync with terminator\n"); 1705 fflush(stdout); 1706 abort(); 1707 } 1708 } 1709 s += offset; 1710 while (*s) { 1711 Tcl_UniChar uc; 1712 1713 s += TclUtfToUniChar(s,&uc); 1714 if (s > end) { 1715 printf("UTF from offset out of sync with terminator\n"); 1716 fflush(stdout); 1717 abort(); 1718 } 1719 } 1720} 1721#endif /*OBSOLETE*/ 1722 1723/* Strip nulls from object, beginning at offset */ 1724static int 1725expNullStrip( 1726 ExpUniBuf* buf, 1727 int offsetChars) 1728{ 1729 Tcl_UniChar *src, *src2, *dest, *end; 1730 int newsize; /* size of obj after all nulls removed */ 1731 1732 src2 = src = dest = buf->buffer + offsetChars; 1733 end = buf->buffer + buf->use; 1734 1735 while (src < end) { 1736 if (*src) { 1737 *dest = *src; 1738 dest ++; 1739 } 1740 src ++; 1741 } 1742 newsize = offsetChars + (dest - src2); 1743 buf->use = newsize; 1744 return newsize; 1745} 1746 1747/* returns # of bytes read or (non-positive) error of form EXP_XXX */ 1748/* returns 0 for end of file */ 1749/* If timeout is non-zero, set an alarm before doing the read, else assume */ 1750/* the read will complete immediately. */ 1751/*ARGSUSED*/ 1752static int 1753expIRead( /* INTL */ 1754 Tcl_Interp *interp, 1755 ExpState *esPtr, 1756 int timeout, 1757 int save_flags) 1758{ 1759 int cc = EXP_TIMEOUT; 1760 int size; 1761 1762 /* We drop one third when are at least 2/3 full */ 1763 /* condition is (size >= max*2/3) <=> (size*3 >= max*2) */ 1764 if (expSizeGet(esPtr)*3 >= esPtr->input.max*2) 1765 exp_buffer_shuffle(interp,esPtr,save_flags,EXPECT_OUT,"expect"); 1766 size = expSizeGet(esPtr); 1767 1768#ifdef SIMPLE_EVENT 1769 restart: 1770 1771 alarm_fired = FALSE; 1772 1773 if (timeout > -1) { 1774 signal(SIGALRM,sigalarm_handler); 1775 alarm((timeout > 0)?timeout:1); 1776 } 1777#endif 1778 1779 cc = Tcl_ReadChars(esPtr->channel, esPtr->input.newchars, 1780 esPtr->input.max - esPtr->input.use, 1781 0 /* no append */); 1782 i_read_errno = errno; 1783 1784 if (cc > 0) { 1785 memcpy (esPtr->input.buffer + esPtr->input.use, 1786 Tcl_GetUnicodeFromObj (esPtr->input.newchars, NULL), 1787 cc * sizeof (Tcl_UniChar)); 1788 esPtr->input.use += cc; 1789 } 1790 1791#ifdef SIMPLE_EVENT 1792 alarm(0); 1793 1794 if (cc == -1) { 1795 /* check if alarm went off */ 1796 if (i_read_errno == EINTR) { 1797 if (alarm_fired) { 1798 return EXP_TIMEOUT; 1799 } else { 1800 if (Tcl_AsyncReady()) { 1801 int rc = Tcl_AsyncInvoke(interp,TCL_OK); 1802 if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); 1803 } 1804 goto restart; 1805 } 1806 } 1807 } 1808#endif 1809 return cc; 1810} 1811 1812/* 1813 * expRead() does the logical equivalent of a read() for the expect command. 1814 * This includes figuring out which descriptor should be read from. 1815 * 1816 * The result of the read() is left in a spawn_id's buffer rather than 1817 * explicitly passing it back. Note that if someone else has modified a buffer 1818 * either before or while this expect is running (i.e., if we or some event has 1819 * called Tcl_Eval which did another expect/interact), expRead will also call 1820 * this a successful read (for the purposes if needing to pattern match against 1821 * it). 1822 */ 1823 1824/* if it returns a negative number, it corresponds to a EXP_XXX result */ 1825/* if it returns a non-negative number, it means there is data */ 1826/* (0 means nothing new was actually read, but it should be looked at again) */ 1827int 1828expRead( 1829 Tcl_Interp *interp, 1830 ExpState *(esPtrs[]), /* If 0, then esPtrOut already known and set */ 1831 int esPtrsMax, /* number of esPtrs */ 1832 ExpState **esPtrOut, /* Out variable to leave new ExpState. */ 1833 int timeout, 1834 int key) 1835{ 1836 ExpState *esPtr; 1837 1838 int size; 1839 int cc; 1840 int write_count; 1841 int tcl_set_flags; /* if we have to discard chars, this tells */ 1842 /* whether to show user locally or globally */ 1843 1844 if (esPtrs == 0) { 1845 /* we already know the ExpState, just find out what happened */ 1846 cc = exp_get_next_event_info(interp,*esPtrOut); 1847 tcl_set_flags = TCL_GLOBAL_ONLY; 1848 } else { 1849 cc = exp_get_next_event(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key); 1850 tcl_set_flags = 0; 1851 } 1852 1853 esPtr = *esPtrOut; 1854 1855 if (cc == EXP_DATA_NEW) { 1856 /* try to read it */ 1857 cc = expIRead(interp,esPtr,timeout,tcl_set_flags); 1858 1859 /* the meaning of 0 from i_read means eof. Muck with it a */ 1860 /* little, so that from now on it means "no new data arrived */ 1861 /* but it should be looked at again anyway". */ 1862 if (cc == 0) { 1863 cc = EXP_EOF; 1864 } else if (cc > 0) { 1865 /* successfully read data */ 1866 } else { 1867 /* failed to read data - some sort of error was encountered such as 1868 * an interrupt with that forced an error return 1869 */ 1870 } 1871 } else if (cc == EXP_DATA_OLD) { 1872 cc = 0; 1873 } else if (cc == EXP_RECONFIGURE) { 1874 return EXP_RECONFIGURE; 1875 } 1876 1877 if (cc == EXP_ABEOF) { /* abnormal EOF */ 1878 /* On many systems, ptys produce EIO upon EOF - sigh */ 1879 if (i_read_errno == EIO) { 1880 /* Sun, Cray, BSD, and others */ 1881 cc = EXP_EOF; 1882 } else if (i_read_errno == EINVAL) { 1883 /* Solaris 2.4 occasionally returns this */ 1884 cc = EXP_EOF; 1885 } else { 1886 if (i_read_errno == EBADF) { 1887 exp_error(interp,"bad spawn_id (process died earlier?)"); 1888 } else { 1889 exp_error(interp,"i_read(spawn_id fd=%d): %s",esPtr->fdin, 1890 Tcl_PosixError(interp)); 1891 if (esPtr->close_on_eof) { 1892 exp_close(interp,esPtr); 1893 } 1894 } 1895 return(EXP_TCLERROR); 1896 /* was goto error; */ 1897 } 1898 } 1899 1900 /* EOF, TIMEOUT, and ERROR return here */ 1901 /* In such cases, there is no need to update screen since, if there */ 1902 /* was prior data read, it would have been sent to the screen when */ 1903 /* it was read. */ 1904 if (cc < 0) return (cc); 1905 1906 /* 1907 * update display 1908 */ 1909 1910 size = expSizeGet(esPtr); 1911 if (size) write_count = size - esPtr->printed; 1912 else write_count = 0; 1913 1914 if (write_count) { 1915 /* 1916 * Show chars to user if they've requested it, UNLESS they're seeing it 1917 * already because they're typing it and tty driver is echoing it. 1918 * Also send to Diag and Log if appropriate. 1919 */ 1920 expLogInteractionU(esPtr,esPtr->input.buffer + esPtr->printed, write_count); 1921 1922 /* 1923 * strip nulls from input, since there is no way for Tcl to deal with 1924 * such strings. Doing it here lets them be sent to the screen, just 1925 * in case they are involved in formatting operations 1926 */ 1927 if (esPtr->rm_nulls) size = expNullStrip(&esPtr->input,esPtr->printed); 1928 esPtr->printed = size; /* count'm even if not logging */ 1929 } 1930 return(cc); 1931} 1932 1933/* when buffer fills, copy second half over first and */ 1934/* continue, so we can do matches over multiple buffers */ 1935void 1936exp_buffer_shuffle( /* INTL */ 1937 Tcl_Interp *interp, 1938 ExpState *esPtr, 1939 int save_flags, 1940 char *array_name, 1941 char *caller_name) 1942{ 1943 Tcl_UniChar *str; 1944 Tcl_UniChar *p; 1945 int numchars, newlen, skiplen; 1946 Tcl_UniChar lostChar; 1947 1948 /* 1949 * allow user to see data we are discarding 1950 */ 1951 1952 expDiagLog("%s: set %s(spawn_id) \"%s\"\r\n", 1953 caller_name,array_name,esPtr->name); 1954 Tcl_SetVar2(interp,array_name,"spawn_id",esPtr->name,save_flags); 1955 1956 /* 1957 * The internal storage buffer object should only be referred 1958 * to by the channel that uses it. We always copy the contents 1959 * out of the object before passing the data to anyone outside 1960 * of these routines. This ensures that the object always has 1961 * a refcount of 1 so we can safely modify the contents in place. 1962 */ 1963 1964 str = esPtr->input.buffer; 1965 numchars = esPtr->input.use; 1966 1967 skiplen = numchars/3; 1968 p = str + skiplen; 1969 1970 /* 1971 * before doing move, show user data we are discarding 1972 */ 1973 1974 lostChar = *p; 1975 /* temporarily stick null in middle of string */ 1976 *p = 0; 1977 1978 expDiagLog("%s: set %s(buffer) \"",caller_name,array_name); 1979 expDiagLogU(expPrintifyUni(str,numchars)); 1980 expDiagLogU("\"\r\n"); 1981 Tcl_SetVar2Ex(interp,array_name,"buffer", 1982 Tcl_NewUnicodeObj (str, skiplen), 1983 save_flags); 1984 1985 /* 1986 * restore damage 1987 */ 1988 *p = lostChar; 1989 1990 /* 1991 * move 2nd half of string down to 1st half 1992 */ 1993 1994 newlen = numchars - skiplen; 1995 memmove(str, p, newlen * sizeof(Tcl_UniChar)); 1996 esPtr->input.use = newlen; 1997 1998 esPtr->printed -= skiplen; 1999 if (esPtr->printed < 0) esPtr->printed = 0; 2000} 2001 2002/* map EXP_ style return value to TCL_ style return value */ 2003/* not defined to work on TCL_OK */ 2004int 2005exp_tcl2_returnvalue(int x) 2006{ 2007 switch (x) { 2008 case TCL_ERROR: return EXP_TCLERROR; 2009 case TCL_RETURN: return EXP_TCLRET; 2010 case TCL_BREAK: return EXP_TCLBRK; 2011 case TCL_CONTINUE: return EXP_TCLCNT; 2012 case EXP_CONTINUE: return EXP_TCLCNTEXP; 2013 case EXP_CONTINUE_TIMER: return EXP_TCLCNTTIMER; 2014 case EXP_TCL_RETURN: return EXP_TCLRETTCL; 2015 } 2016 /* Must not reach this location. Can happen only if x is an 2017 * illegal value. Added return to suppress compiler warning. 2018 */ 2019 return -1000; 2020} 2021 2022/* map from EXP_ style return value to TCL_ style return values */ 2023int 2024exp_2tcl_returnvalue(int x) 2025{ 2026 switch (x) { 2027 case EXP_TCLERROR: return TCL_ERROR; 2028 case EXP_TCLRET: return TCL_RETURN; 2029 case EXP_TCLBRK: return TCL_BREAK; 2030 case EXP_TCLCNT: return TCL_CONTINUE; 2031 case EXP_TCLCNTEXP: return EXP_CONTINUE; 2032 case EXP_TCLCNTTIMER: return EXP_CONTINUE_TIMER; 2033 case EXP_TCLRETTCL: return EXP_TCL_RETURN; 2034 } 2035 /* Must not reach this location. Can happen only if x is an 2036 * illegal value. Added return to suppress compiler warning. 2037 */ 2038 return -1000; 2039} 2040 2041/* variables predefined by expect are retrieved using this routine 2042which looks in the global space if they are not in the local space. 2043This allows the user to localize them if desired, and also to 2044avoid having to put "global" in procedure definitions. 2045*/ 2046char * 2047exp_get_var( 2048 Tcl_Interp *interp, 2049 char *var) 2050{ 2051 char *val; 2052 2053 if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */))) 2054 return(val); 2055 return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY)); 2056} 2057 2058static int 2059get_timeout(Tcl_Interp *interp) 2060{ 2061 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 2062 CONST char *t; 2063 2064 if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) { 2065 tsdPtr->timeout = atoi(t); 2066 } 2067 return(tsdPtr->timeout); 2068} 2069 2070/* make a copy of a linked list (1st arg) and attach to end of another (2nd 2071arg) */ 2072static int 2073update_expect_states( 2074 struct exp_i *i_list, 2075 struct exp_state_list **i_union) 2076{ 2077 struct exp_i *p; 2078 2079 /* for each i_list in an expect statement ... */ 2080 for (p=i_list;p;p=p->next) { 2081 struct exp_state_list *slPtr; 2082 2083 /* for each esPtr in the i_list */ 2084 for (slPtr=p->state_list;slPtr;slPtr=slPtr->next) { 2085 struct exp_state_list *tmpslPtr; 2086 struct exp_state_list *u; 2087 2088 if (expStateAnyIs(slPtr->esPtr)) continue; 2089 2090 /* check this one against all so far */ 2091 for (u = *i_union;u;u=u->next) { 2092 if (slPtr->esPtr == u->esPtr) goto found; 2093 } 2094 /* if not found, link in as head of list */ 2095 tmpslPtr = exp_new_state(slPtr->esPtr); 2096 tmpslPtr->next = *i_union; 2097 *i_union = tmpslPtr; 2098 found:; 2099 } 2100 } 2101 return TCL_OK; 2102} 2103 2104char * 2105exp_cmdtype_printable(int cmdtype) 2106{ 2107 switch (cmdtype) { 2108 case EXP_CMD_FG: return("expect"); 2109 case EXP_CMD_BG: return("expect_background"); 2110 case EXP_CMD_BEFORE: return("expect_before"); 2111 case EXP_CMD_AFTER: return("expect_after"); 2112 } 2113 /*#ifdef LINT*/ 2114 return("unknown expect command"); 2115 /*#endif*/ 2116} 2117 2118/* exp_indirect_update2 is called back via Tcl's trace handler whenever */ 2119/* an indirect spawn id list is changed */ 2120/*ARGSUSED*/ 2121static char * 2122exp_indirect_update2( 2123 ClientData clientData, 2124 Tcl_Interp *interp, /* Interpreter containing variable. */ 2125 char *name1, /* Name of variable. */ 2126 char *name2, /* Second part of variable name. */ 2127 int flags) /* Information about what happened. */ 2128{ 2129 char *msg; 2130 2131 struct exp_i *exp_i = (struct exp_i *)clientData; 2132 exp_configure_count++; 2133 msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i); 2134 2135 exp_background_channelhandlers_run_all(); 2136 2137 return msg; 2138} 2139 2140static char * 2141exp_indirect_update1( 2142 Tcl_Interp *interp, 2143 struct exp_cmd_descriptor *ecmd, 2144 struct exp_i *exp_i) 2145{ 2146 struct exp_state_list *slPtr; /* temp for interating over state_list */ 2147 2148 /* 2149 * disarm any ExpState's that lose all their active spawn ids 2150 */ 2151 2152 if (ecmd->cmdtype == EXP_CMD_BG) { 2153 /* clean up each spawn id used by this exp_i */ 2154 for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { 2155 ExpState *esPtr = slPtr->esPtr; 2156 2157 if (expStateAnyIs(esPtr)) continue; 2158 2159 /* silently skip closed or preposterous fds */ 2160 /* since we're just disabling them anyway */ 2161 /* preposterous fds will have been reported */ 2162 /* by code in next section already */ 2163 if (!expStateCheck(interp,slPtr->esPtr,1,0,"")) continue; 2164 2165 /* check before decrementing, ecount may not be */ 2166 /* positive if update is called before ecount is */ 2167 /* properly synchronized */ 2168 if (esPtr->bg_ecount > 0) { 2169 esPtr->bg_ecount--; 2170 } 2171 if (esPtr->bg_ecount == 0) { 2172 exp_disarm_background_channelhandler(esPtr); 2173 esPtr->bg_interp = 0; 2174 } 2175 } 2176 } 2177 2178 /* 2179 * reread indirect variable 2180 */ 2181 2182 exp_i_update(interp,exp_i); 2183 2184 /* 2185 * check validity of all fd's in variable 2186 */ 2187 2188 for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { 2189 /* validate all input descriptors */ 2190 2191 if (expStateAnyIs(slPtr->esPtr)) continue; 2192 2193 if (!expStateCheck(interp,slPtr->esPtr,1,1, 2194 exp_cmdtype_printable(ecmd->cmdtype))) { 2195 /* Note: Cannot construct a Tcl_Obj* here, the function is a 2196 * Tcl_VarTraceProc and the API wants a char*. 2197 * 2198 * DANGER: The buffer may overflow if either the existing result, 2199 * the variable name, or both become to large. 2200 */ 2201 static char msg[200]; 2202 sprintf(msg,"%s from indirect variable (%s)", 2203 Tcl_GetStringResult (interp),exp_i->variable); 2204 return msg; 2205 } 2206 } 2207 2208 /* for each spawn id in list, arm if necessary */ 2209 if (ecmd->cmdtype == EXP_CMD_BG) { 2210 state_list_arm(interp,exp_i->state_list); 2211 } 2212 2213 return (char *)0; 2214} 2215 2216int 2217expMatchProcess( 2218 Tcl_Interp *interp, 2219 struct eval_out *eo, /* final case of interest */ 2220 int cc, /* EOF, TIMEOUT, etc... */ 2221 int bg, /* 1 if called from background handler, */ 2222 /* else 0 */ 2223 char *detail) 2224{ 2225 ExpState *esPtr = 0; 2226 Tcl_Obj *body = 0; 2227 Tcl_UniChar *buffer; 2228 struct ecase *e = 0; /* points to current ecase */ 2229 int match = -1; /* characters matched */ 2230 /* uprooted by a NULL */ 2231 int result = TCL_OK; 2232 2233#define out(indexName, value) \ 2234 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \ 2235 expDiagLogU(expPrintify(value)); \ 2236 expDiagLogU("\"\r\n"); \ 2237 Tcl_SetVar2(interp, EXPECT_OUT,indexName,value,(bg ? TCL_GLOBAL_ONLY : 0)); 2238 2239 /* The numchars argument allows us to avoid sticking a \0 into the buffer */ 2240#define outuni(indexName, value,numchars) \ 2241 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \ 2242 expDiagLogU(expPrintifyUni(value,numchars)); \ 2243 expDiagLogU("\"\r\n"); \ 2244 Tcl_SetVar2Ex(interp, EXPECT_OUT,indexName,Tcl_NewUnicodeObj(value,numchars),(bg ? TCL_GLOBAL_ONLY : 0)); 2245 2246 if (eo->e) { 2247 e = eo->e; 2248 body = e->body; 2249 if (cc != EXP_TIMEOUT) { 2250 esPtr = eo->esPtr; 2251 match = eo->matchlen; 2252 buffer = eo->matchbuf; 2253 } 2254 } else if (cc == EXP_EOF) { 2255 /* read an eof but no user-supplied case */ 2256 esPtr = eo->esPtr; 2257 match = eo->matchlen; 2258 buffer = eo->matchbuf; 2259 } 2260 2261 if (match >= 0) { 2262 char name[20], value[20]; 2263 int i; 2264 2265 if (e && e->use == PAT_RE) { 2266 Tcl_RegExp re; 2267 int flags; 2268 Tcl_RegExpInfo info; 2269 Tcl_Obj *buf; 2270 2271 /* No gate keeper required here, we know that the RE 2272 * matches, we just do it again to get all the captured 2273 * pieces 2274 */ 2275 2276 if (e->Case == CASE_NORM) { 2277 flags = TCL_REG_ADVANCED; 2278 } else { 2279 flags = TCL_REG_ADVANCED | TCL_REG_NOCASE; 2280 } 2281 2282 re = Tcl_GetRegExpFromObj(interp, e->pat, flags); 2283 Tcl_RegExpGetInfo(re, &info); 2284 2285 buf = Tcl_NewUnicodeObj (buffer,esPtr->input.use); 2286 for (i=0;i<=info.nsubs;i++) { 2287 int start, end; 2288 Tcl_Obj *val; 2289 2290 start = info.matches[i].start; 2291 end = info.matches[i].end-1; 2292 if (start == -1) continue; 2293 2294 if (e->indices) { 2295 /* start index */ 2296 sprintf(name,"%d,start",i); 2297 sprintf(value,"%d",start); 2298 out(name,value); 2299 2300 /* end index */ 2301 sprintf(name,"%d,end",i); 2302 sprintf(value,"%d",end); 2303 out(name,value); 2304 } 2305 2306 /* string itself */ 2307 sprintf(name,"%d,string",i); 2308 val = Tcl_GetRange(buf, start, end); 2309 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,name); 2310 expDiagLogU(expPrintifyObj(val)); 2311 expDiagLogU("\"\r\n"); 2312 Tcl_SetVar2Ex(interp,EXPECT_OUT,name,val,(bg ? TCL_GLOBAL_ONLY : 0)); 2313 } 2314 Tcl_DecrRefCount (buf); 2315 } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) { 2316 Tcl_UniChar *str; 2317 2318 if (e->indices) { 2319 /* start index */ 2320 sprintf(value,"%d",e->simple_start); 2321 out("0,start",value); 2322 2323 /* end index */ 2324 sprintf(value,"%d",e->simple_start + match - 1); 2325 out("0,end",value); 2326 } 2327 2328 /* string itself */ 2329 str = esPtr->input.buffer + e->simple_start; 2330 outuni("0,string",str,match); 2331 2332 /* redefine length of string that */ 2333 /* matched for later extraction */ 2334 match += e->simple_start; 2335 } else if (e && e->use == PAT_NULL && e->indices) { 2336 /* start index */ 2337 sprintf(value,"%d",match-1); 2338 out("0,start",value); 2339 /* end index */ 2340 sprintf(value,"%d",match-1); 2341 out("0,end",value); 2342 } else if (e && e->use == PAT_FULLBUFFER) { 2343 expDiagLogU("expect_background: full buffer\r\n"); 2344 } 2345 } 2346 2347 /* this is broken out of (match > 0) (above) since it can */ 2348 /* that an EOF occurred with match == 0 */ 2349 if (eo->esPtr) { 2350 Tcl_UniChar *str; 2351 int numchars; 2352 2353 out("spawn_id",esPtr->name); 2354 2355 str = esPtr->input.buffer; 2356 numchars = esPtr->input.use; 2357 2358 /* Save buf[0..match] */ 2359 outuni("buffer",str,match); 2360 2361 /* "!e" means no case matched - transfer by default */ 2362 if (!e || e->transfer) { 2363 int remainder = numchars-match; 2364 /* delete matched chars from input buffer */ 2365 esPtr->printed -= match; 2366 if (numchars != 0) { 2367 memmove(str,str+match,remainder*sizeof(Tcl_UniChar)); 2368 } 2369 esPtr->input.use = remainder; 2370 } 2371 2372 if (cc == EXP_EOF) { 2373 /* exp_close() deletes all background bodies */ 2374 /* so save eof body temporarily */ 2375 if (body) { Tcl_IncrRefCount(body); } 2376 if (esPtr->close_on_eof) { 2377 exp_close(interp,esPtr); 2378 } 2379 } 2380 } 2381 2382 if (body) { 2383 if (!bg) { 2384 result = Tcl_EvalObjEx(interp,body,0); 2385 } else { 2386 result = Tcl_EvalObjEx(interp,body,TCL_EVAL_GLOBAL); 2387 if (result != TCL_OK) Tcl_BackgroundError(interp); 2388 } 2389 if (cc == EXP_EOF) { Tcl_DecrRefCount(body); } 2390 } 2391 return result; 2392} 2393 2394/* this function is called from the background when input arrives */ 2395/*ARGSUSED*/ 2396void 2397exp_background_channelhandler( /* INTL */ 2398 ClientData clientData, 2399 int mask) 2400{ 2401 char backup[EXP_CHANNELNAMELEN+1]; /* backup copy of esPtr channel name! */ 2402 2403 ExpState *esPtr; 2404 Tcl_Interp *interp; 2405 int cc; /* number of bytes returned in a single read */ 2406 /* or negative EXP_whatever */ 2407 struct eval_out eo; /* final case of interest */ 2408 ExpState *last_esPtr; /* for differentiating when multiple esPtrs */ 2409 /* to print out better debugging messages */ 2410 int last_case; /* as above but for case */ 2411 2412 /* restore our environment */ 2413 esPtr = (ExpState *)clientData; 2414 2415 /* backup just in case someone zaps esPtr in the middle of our work! */ 2416 strcpy(backup,esPtr->name); 2417 2418 interp = esPtr->bg_interp; 2419 2420 /* temporarily prevent this handler from being invoked again */ 2421 exp_block_background_channelhandler(esPtr); 2422 2423 /* 2424 * if mask == 0, then we've been called because the patterns changed not 2425 * because the waiting data has changed, so don't actually do any I/O 2426 */ 2427 if (mask == 0) { 2428 cc = 0; 2429 } else { 2430 esPtr->notifiedMask = mask; 2431 esPtr->notified = FALSE; 2432 cc = expRead(interp,(ExpState **)0,0,&esPtr,EXP_TIME_INFINITY,0); 2433 } 2434 2435do_more_data: 2436 eo.e = 0; /* no final case yet */ 2437 eo.esPtr = 0; /* no final file selected yet */ 2438 eo.matchlen = 0; /* nothing matched yet */ 2439 2440 /* force redisplay of buffer when debugging */ 2441 last_esPtr = 0; 2442 2443 if (cc == EXP_EOF) { 2444 /* do nothing */ 2445 } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/ 2446 goto finish; 2447 /* 2448 * if we were going to do this right, we should differentiate between 2449 * things like HP ioctl-open-traps that fall out here and should 2450 * rightfully be ignored and real errors that should be reported. Come 2451 * to think of it, the only errors will come from HP ioctl handshake 2452 * botches anyway. 2453 */ 2454 } else { 2455 /* normal case, got data */ 2456 /* new data if cc > 0, same old data if cc == 0 */ 2457 2458 /* below here, cc as general status */ 2459 cc = EXP_NOMATCH; 2460 } 2461 2462 cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE], 2463 esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background"); 2464 cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG], 2465 esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background"); 2466 cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], 2467 esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background"); 2468 if (cc == EXP_TCLERROR) { 2469 /* only likely problem here is some internal regexp botch */ 2470 Tcl_BackgroundError(interp); 2471 goto finish; 2472 } 2473 /* special eof code that cannot be done in eval_cases */ 2474 /* or above, because it would then be executed several times */ 2475 if (cc == EXP_EOF) { 2476 eo.esPtr = esPtr; 2477 eo.matchlen = expSizeGet(eo.esPtr); 2478 eo.matchbuf = eo.esPtr->input.buffer; 2479 expDiagLogU("expect_background: read eof\r\n"); 2480 goto matched; 2481 } 2482 if (!eo.e) { 2483 /* if we get here, there must not have been a match */ 2484 goto finish; 2485 } 2486 2487 matched: 2488 expMatchProcess(interp, &eo, cc, 1 /* bg */,"expect_background"); 2489 2490 /* 2491 * Event handler will not call us back if there is more input 2492 * pending but it has already arrived. bg_status will be 2493 * "blocked" only if armed. 2494 */ 2495 2496 /* 2497 * Connection could have been closed on us. In this case, 2498 * exitWhenBgStatusUnblocked will be 1 and we should disable the channel 2499 * handler and release the esPtr. 2500 */ 2501 2502 /* First check that the esPtr is even still valid! */ 2503 /* This ought to be sufficient. */ 2504 if (0 == Tcl_GetChannel(interp,backup,(int *)0)) { 2505 expDiagLog("expect channel %s lost in background handler\n",backup); 2506 return; 2507 } 2508 2509 if ((!esPtr->freeWhenBgHandlerUnblocked) && (esPtr->bg_status == blocked)) { 2510 if (0 != (cc = expSizeGet(esPtr))) { 2511 goto do_more_data; 2512 } 2513 } 2514 finish: 2515 exp_unblock_background_channelhandler(esPtr); 2516 if (esPtr->freeWhenBgHandlerUnblocked) 2517 expStateFree(esPtr); 2518} 2519 2520/*ARGSUSED*/ 2521int 2522Exp_ExpectObjCmd( 2523 ClientData clientData, 2524 Tcl_Interp *interp, 2525 int objc, 2526 Tcl_Obj *CONST objv[]) /* Argument objects. */ 2527{ 2528 int cc; /* number of chars returned in a single read */ 2529 /* or negative EXP_whatever */ 2530 ExpState *esPtr = 0; 2531 2532 int i; /* misc temporary */ 2533 struct exp_cmd_descriptor eg; 2534 struct exp_state_list *state_list; /* list of ExpStates to watch */ 2535 struct exp_state_list *slPtr; /* temp for interating over state_list */ 2536 ExpState **esPtrs; 2537 int mcount; /* number of esPtrs to watch */ 2538 2539 struct eval_out eo; /* final case of interest */ 2540 2541 int result; /* Tcl result */ 2542 2543 time_t start_time_total; /* time at beginning of this procedure */ 2544 time_t start_time = 0; /* time when restart label hit */ 2545 time_t current_time = 0; /* current time (when we last looked)*/ 2546 time_t end_time; /* future time at which to give up */ 2547 2548 ExpState *last_esPtr; /* for differentiating when multiple f's */ 2549 /* to print out better debugging messages */ 2550 int last_case; /* as above but for case */ 2551 int first_time = 1; /* if not "restarted" */ 2552 2553 int key; /* identify this expect command instance */ 2554 int configure_count; /* monitor exp_configure_count */ 2555 2556 int timeout; /* seconds */ 2557 int remtime; /* remaining time in timeout */ 2558 int reset_timer; /* should timer be reset after continue? */ 2559 Tcl_Time temp_time; 2560 Tcl_Obj* new_cmd = NULL; 2561 2562 if ((objc == 2) && exp_one_arg_braced(objv[1])) { 2563 /* expect {...} */ 2564 2565 new_cmd = exp_eval_with_one_arg(clientData,interp,objv); 2566 if (!new_cmd) return TCL_ERROR; 2567 } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { 2568 /* expect -brace {...} ... fake command line for reparsing */ 2569 2570 Tcl_Obj *new_objv[2]; 2571 new_objv[0] = objv[0]; 2572 new_objv[1] = objv[2]; 2573 2574 new_cmd = exp_eval_with_one_arg(clientData,interp,new_objv); 2575 if (!new_cmd) return TCL_ERROR; 2576 } 2577 2578 if (new_cmd) { 2579 /* Replace old arguments with result of the reparse */ 2580 Tcl_ListObjGetElements (interp, new_cmd, &objc, (Tcl_Obj***) &objv); 2581 } 2582 2583 Tcl_GetTime (&temp_time); 2584 start_time_total = temp_time.sec; 2585 start_time = start_time_total; 2586 reset_timer = TRUE; 2587 2588 if (&StdinoutPlaceholder == (ExpState *)clientData) { 2589 clientData = (ClientData) expStdinoutGet(); 2590 } else if (&DevttyPlaceholder == (ExpState *)clientData) { 2591 clientData = (ClientData) expDevttyGet(); 2592 } 2593 2594 /* make arg list for processing cases */ 2595 /* do it dynamically, since expect can be called recursively */ 2596 2597 exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY); 2598 state_list = 0; 2599 esPtrs = 0; 2600 if (TCL_ERROR == parse_expect_args(interp,&eg, (ExpState *)clientData, 2601 objc,objv)) { 2602 if (new_cmd) { Tcl_DecrRefCount (new_cmd); } 2603 return TCL_ERROR; 2604 } 2605 2606 restart_with_update: 2607 /* validate all descriptors and flatten ExpStates into array */ 2608 2609 if ((TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_BEFORE].i_list,&state_list)) 2610 || (TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_AFTER].i_list, &state_list)) 2611 || (TCL_ERROR == update_expect_states(eg.i_list,&state_list))) { 2612 result = TCL_ERROR; 2613 goto cleanup; 2614 } 2615 2616 /* declare ourselves "in sync" with external view of close/indirect */ 2617 configure_count = exp_configure_count; 2618 2619 /* count and validate state_list */ 2620 mcount = 0; 2621 for (slPtr=state_list;slPtr;slPtr=slPtr->next) { 2622 mcount++; 2623 /* validate all input descriptors */ 2624 if (!expStateCheck(interp,slPtr->esPtr,1,1,"expect")) { 2625 result = TCL_ERROR; 2626 goto cleanup; 2627 } 2628 } 2629 2630 /* make into an array */ 2631 esPtrs = (ExpState **)ckalloc(mcount * sizeof(ExpState *)); 2632 for (slPtr=state_list,i=0;slPtr;slPtr=slPtr->next,i++) { 2633 esPtrs[i] = slPtr->esPtr; 2634 } 2635 2636 restart: 2637 if (first_time) first_time = 0; 2638 else { 2639 Tcl_GetTime (&temp_time); 2640 start_time = temp_time.sec; 2641 } 2642 2643 if (eg.timeout_specified_by_flag) { 2644 timeout = eg.timeout; 2645 } else { 2646 /* get the latest timeout */ 2647 timeout = get_timeout(interp); 2648 } 2649 2650 key = expect_key++; 2651 2652 result = TCL_OK; 2653 last_esPtr = 0; 2654 2655 /* 2656 * end of restart code 2657 */ 2658 2659 eo.e = 0; /* no final case yet */ 2660 eo.esPtr = 0; /* no final ExpState selected yet */ 2661 eo.matchlen = 0; /* nothing matched yet */ 2662 2663 /* timeout code is a little tricky, be very careful changing it */ 2664 if (timeout != EXP_TIME_INFINITY) { 2665 /* if exp_continue -continue_timer, do not update end_time */ 2666 if (reset_timer) { 2667 Tcl_GetTime (&temp_time); 2668 current_time = temp_time.sec; 2669 end_time = current_time + timeout; 2670 } else { 2671 reset_timer = TRUE; 2672 } 2673 } 2674 2675 /* remtime and current_time updated at bottom of loop */ 2676 remtime = timeout; 2677 2678 for (;;) { 2679 if ((timeout != EXP_TIME_INFINITY) && (remtime < 0)) { 2680 cc = EXP_TIMEOUT; 2681 } else { 2682 cc = expRead(interp,esPtrs,mcount,&esPtr,remtime,key); 2683 } 2684 2685 /*SUPPRESS 530*/ 2686 if (cc == EXP_EOF) { 2687 /* do nothing */ 2688 } else if (cc == EXP_TIMEOUT) { 2689 expDiagLogU("expect: timed out\r\n"); 2690 } else if (cc == EXP_RECONFIGURE) { 2691 reset_timer = FALSE; 2692 goto restart_with_update; 2693 } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/ 2694 goto error; 2695 } else { 2696 /* new data if cc > 0, same old data if cc == 0 */ 2697 2698 /* below here, cc as general status */ 2699 cc = EXP_NOMATCH; 2700 2701 /* force redisplay of buffer when debugging */ 2702 last_esPtr = 0; 2703 } 2704 2705 cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE], 2706 esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,""); 2707 cc = eval_cases(interp,&eg, 2708 esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,""); 2709 cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], 2710 esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,""); 2711 if (cc == EXP_TCLERROR) goto error; 2712 /* special eof code that cannot be done in eval_cases */ 2713 /* or above, because it would then be executed several times */ 2714 if (cc == EXP_EOF) { 2715 eo.esPtr = esPtr; 2716 eo.matchlen = expSizeGet(eo.esPtr); 2717 eo.matchbuf = eo.esPtr->input.buffer; 2718 expDiagLogU("expect: read eof\r\n"); 2719 break; 2720 } else if (cc == EXP_TIMEOUT) break; 2721 2722 /* break if timeout or eof and failed to find a case for it */ 2723 2724 if (eo.e) break; 2725 2726 /* no match was made with current data, force a read */ 2727 esPtr->force_read = TRUE; 2728 2729 if (timeout != EXP_TIME_INFINITY) { 2730 Tcl_GetTime (&temp_time); 2731 current_time = temp_time.sec; 2732 remtime = end_time - current_time; 2733 } 2734 } 2735 2736 goto done; 2737 2738error: 2739 result = exp_2tcl_returnvalue(cc); 2740 done: 2741 if (result != TCL_ERROR) { 2742 result = expMatchProcess(interp, &eo, cc, 0 /* not bg */,"expect"); 2743 } 2744 2745 cleanup: 2746 if (result == EXP_CONTINUE_TIMER) { 2747 reset_timer = FALSE; 2748 result = EXP_CONTINUE; 2749 } 2750 2751 if ((result == EXP_CONTINUE) && (configure_count == exp_configure_count)) { 2752 expDiagLogU("expect: continuing expect\r\n"); 2753 goto restart; 2754 } 2755 2756 if (state_list) { 2757 exp_free_state(state_list); 2758 state_list = 0; 2759 } 2760 if (esPtrs) { 2761 ckfree((char *)esPtrs); 2762 esPtrs = 0; 2763 } 2764 2765 if (result == EXP_CONTINUE) { 2766 expDiagLogU("expect: continuing expect after update\r\n"); 2767 goto restart_with_update; 2768 } 2769 2770 free_ecases(interp,&eg,0); /* requires i_lists to be avail */ 2771 exp_free_i(interp,eg.i_list,exp_indirect_update2); 2772 2773 if (new_cmd) { Tcl_DecrRefCount (new_cmd); } 2774 return(result); 2775} 2776 2777/*ARGSUSED*/ 2778static int 2779Exp_TimestampObjCmd( 2780 ClientData clientData, 2781 Tcl_Interp *interp, 2782 int objc, 2783 Tcl_Obj *CONST objv[]) /* Argument objects. */ 2784{ 2785 char *format = 0; 2786 time_t seconds = -1; 2787 int gmt = FALSE; /* local time by default */ 2788 struct tm *tm; 2789 Tcl_DString dstring; 2790 int i; 2791 2792 static char* options[] = { 2793 "-format", 2794 "-gmt", 2795 "-seconds", 2796 NULL 2797 }; 2798 enum options { 2799 TS_FORMAT, 2800 TS_GMT, 2801 TS_SECONDS 2802 }; 2803 2804 for (i=1; i<objc; i++) { 2805 char *name; 2806 int index; 2807 2808 name = Tcl_GetString(objv[i]); 2809 if (name[0] != '-') { 2810 break; 2811 } 2812 if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0, 2813 &index) != TCL_OK) { 2814 return TCL_ERROR; 2815 } 2816 switch ((enum options) index) { 2817 case TS_FORMAT: 2818 i++; 2819 if (i >= objc) goto usage_error; 2820 format = Tcl_GetString (objv[i]); 2821 break; 2822 case TS_GMT: 2823 gmt = TRUE; 2824 break; 2825 case TS_SECONDS: { 2826 int sec; 2827 i++; 2828 if (i >= objc) goto usage_error; 2829 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &sec)) { 2830 goto usage_error; 2831 } 2832 seconds = sec; 2833 } 2834 break; 2835 } 2836 } 2837 2838 if (i < objc) goto usage_error; 2839 2840 if (seconds == -1) { 2841 time(&seconds); 2842 } 2843 2844 if (format) { 2845 if (gmt) { 2846 tm = gmtime(&seconds); 2847 } else { 2848 tm = localtime(&seconds); 2849 } 2850 Tcl_DStringInit(&dstring); 2851 exp_strftime(format,tm,&dstring); 2852 Tcl_DStringResult(interp,&dstring); 2853 } else { 2854 Tcl_SetObjResult (interp, Tcl_NewIntObj (seconds)); 2855 } 2856 2857 return TCL_OK; 2858 usage_error: 2859 exp_error(interp,"args: [-seconds #] [-format format] [-gmt]"); 2860 return TCL_ERROR; 2861 2862} 2863 2864/* Helper function hnadling the common processing of -d and -i options of 2865 * various commands. 2866 */ 2867 2868static int 2869process_di _ANSI_ARGS_ ((Tcl_Interp* interp, 2870 int objc, 2871 Tcl_Obj *CONST objv[], /* Argument objects. */ 2872 int* at, 2873 int* Default, 2874 ExpState **esOut, 2875 CONST char* cmd)); 2876 2877static int 2878process_di ( 2879 Tcl_Interp *interp, 2880 int objc, 2881 Tcl_Obj *CONST objv[], /* Argument objects. */ 2882 int* at, 2883 int* Default, 2884 ExpState **esOut, 2885 CONST char* cmd) 2886{ 2887 static char* options[] = { 2888 "-d", 2889 "-i", 2890 NULL 2891 }; 2892 enum options { 2893 DI_DEFAULT, 2894 DI_ID 2895 }; 2896 int def = FALSE; 2897 char* chan = NULL; 2898 int i; 2899 ExpState *esPtr; 2900 2901 for (i=1; i<objc; i++) { 2902 char *name; 2903 int index; 2904 2905 name = Tcl_GetString(objv[i]); 2906 if (name[0] != '-') { 2907 break; 2908 } 2909 if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0, 2910 &index) != TCL_OK) { 2911 return TCL_ERROR; 2912 } 2913 switch ((enum options) index) { 2914 case DI_DEFAULT: 2915 def = TRUE; 2916 break; 2917 case DI_ID: 2918 i++; 2919 if (i >= objc) { 2920 exp_error(interp,"-i needs argument"); 2921 return(TCL_ERROR); 2922 } 2923 chan = Tcl_GetString (objv[i]); 2924 break; 2925 } 2926 } 2927 2928 if (def && chan) { 2929 exp_error(interp,"cannot do -d and -i at the same time"); 2930 return(TCL_ERROR); 2931 } 2932 2933 /* Not all arguments processed, more than two remaining, only at most one 2934 * remaining is expected/allowed. 2935 */ 2936 if (i < (objc-1)) { 2937 exp_error(interp,"too many arguments"); 2938 return(TCL_OK); 2939 } 2940 2941 if (!def) { 2942 if (!chan) { 2943 esPtr = expStateCurrent(interp,0,0,0); 2944 } else { 2945 esPtr = expStateFromChannelName(interp,chan,0,0,0,(char*)cmd); 2946 } 2947 if (!esPtr) return(TCL_ERROR); 2948 } 2949 2950 *at = i; 2951 *Default = def; 2952 *esOut = esPtr; 2953 return TCL_OK; 2954} 2955 2956 2957/*ARGSUSED*/ 2958int 2959Exp_MatchMaxObjCmd( 2960 ClientData clientData, 2961 Tcl_Interp *interp, 2962 int objc, 2963 Tcl_Obj *CONST objv[]) /* Argument objects. */ 2964{ 2965 int size = -1; 2966 ExpState *esPtr = 0; 2967 int Default = FALSE; 2968 int i; 2969 2970 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "match_max")) 2971 return TCL_ERROR; 2972 2973 /* No size argument */ 2974 if (i == objc) { 2975 if (Default) { 2976 size = exp_default_match_max; 2977 } else { 2978 size = esPtr->umsize; 2979 } 2980 Tcl_SetObjResult (interp, Tcl_NewIntObj (size)); 2981 return(TCL_OK); 2982 } 2983 2984 /* 2985 * All that's left is to set the size 2986 */ 2987 2988 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &size)) { 2989 return TCL_ERROR; 2990 } 2991 2992 if (size <= 0) { 2993 exp_error(interp,"must be positive"); 2994 return(TCL_ERROR); 2995 } 2996 2997 if (Default) exp_default_match_max = size; 2998 else esPtr->umsize = size; 2999 3000 return(TCL_OK); 3001} 3002 3003/*ARGSUSED*/ 3004int 3005Exp_RemoveNullsObjCmd( 3006 ClientData clientData, 3007 Tcl_Interp *interp, 3008 int objc, 3009 Tcl_Obj *CONST objv[]) /* Argument objects. */ 3010{ 3011 int value = -1; 3012 ExpState *esPtr = 0; 3013 int Default = FALSE; 3014 int i; 3015 3016 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "remove_nulls")) 3017 return TCL_ERROR; 3018 3019 /* No flag argument */ 3020 if (i == objc) { 3021 if (Default) { 3022 value = exp_default_rm_nulls; 3023 } else { 3024 value = esPtr->rm_nulls; 3025 } 3026 Tcl_SetObjResult (interp, Tcl_NewIntObj (value)); 3027 return(TCL_OK); 3028 } 3029 3030 /* all that's left is to set the value */ 3031 3032 if (TCL_OK != Tcl_GetBooleanFromObj (interp, objv[i], &value)) { 3033 return TCL_ERROR; 3034 } 3035 3036 if ((value != 0) && (value != 1)) { 3037 exp_error(interp,"must be 0 or 1"); 3038 return(TCL_ERROR); 3039 } 3040 3041 if (Default) exp_default_rm_nulls = value; 3042 else esPtr->rm_nulls = value; 3043 3044 return(TCL_OK); 3045} 3046 3047/*ARGSUSED*/ 3048int 3049Exp_ParityObjCmd( 3050 ClientData clientData, 3051 Tcl_Interp *interp, 3052 int objc, 3053 Tcl_Obj *CONST objv[]) /* Argument objects. */ 3054{ 3055 int parity; 3056 ExpState *esPtr = 0; 3057 int Default = FALSE; 3058 int i; 3059 3060 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "parity")) 3061 return TCL_ERROR; 3062 3063 /* No parity argument */ 3064 if (i == objc) { 3065 if (Default) { 3066 parity = exp_default_parity; 3067 } else { 3068 parity = esPtr->parity; 3069 } 3070 Tcl_SetObjResult (interp, Tcl_NewIntObj (parity)); 3071 return(TCL_OK); 3072 } 3073 3074 /* all that's left is to set the parity */ 3075 3076 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &parity)) { 3077 return TCL_ERROR; 3078 } 3079 3080 if (Default) exp_default_parity = parity; 3081 else esPtr->parity = parity; 3082 3083 return(TCL_OK); 3084} 3085 3086/*ARGSUSED*/ 3087int 3088Exp_CloseOnEofObjCmd( 3089 ClientData clientData, 3090 Tcl_Interp *interp, 3091 int objc, 3092 Tcl_Obj *CONST objv[]) /* Argument objects. */ 3093{ 3094 int close_on_eof; 3095 ExpState *esPtr = 0; 3096 int Default = FALSE; 3097 int i; 3098 3099 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "close_on_eof")) 3100 return TCL_ERROR; 3101 3102 /* No flag argument */ 3103 if (i == objc) { 3104 if (Default) { 3105 close_on_eof = exp_default_close_on_eof; 3106 } else { 3107 close_on_eof = esPtr->close_on_eof; 3108 } 3109 Tcl_SetObjResult (interp, Tcl_NewIntObj (close_on_eof)); 3110 return(TCL_OK); 3111 } 3112 3113 /* all that's left is to set the close_on_eof */ 3114 3115 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &close_on_eof)) { 3116 return TCL_ERROR; 3117 } 3118 3119 if (Default) exp_default_close_on_eof = close_on_eof; 3120 else esPtr->close_on_eof = close_on_eof; 3121 3122 return(TCL_OK); 3123} 3124 3125#if DEBUG_PERM_ECASES 3126/* This big chunk of code is just for debugging the permanent */ 3127/* expect cases */ 3128void 3129exp_fd_print(struct exp_state_list *slPtr) 3130{ 3131 if (!slPtr) return; 3132 printf("%d ",slPtr->esPtr); 3133 exp_fd_print(slPtr->next); 3134} 3135 3136void 3137exp_i_print(struct exp_i *exp_i) 3138{ 3139 if (!exp_i) return; 3140 printf("exp_i %x",exp_i); 3141 printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect"); 3142 printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp"); 3143 printf(" ecount = %d\n",exp_i->ecount); 3144 printf("variable %s, value %s\n", 3145 ((exp_i->variable)?exp_i->variable:"--"), 3146 ((exp_i->value)?exp_i->value:"--")); 3147 printf("ExpStates: "); 3148 exp_fd_print(exp_i->state_list); printf("\n"); 3149 exp_i_print(exp_i->next); 3150} 3151 3152void 3153exp_ecase_print(struct ecase *ecase) 3154{ 3155 printf("pat <%s>\n",ecase->pat); 3156 printf("exp_i = %x\n",ecase->i_list); 3157} 3158 3159void 3160exp_ecases_print(struct exp_cases_descriptor *ecd) 3161{ 3162 int i; 3163 3164 printf("%d cases\n",ecd->count); 3165 for (i=0;i<ecd->count;i++) exp_ecase_print(ecd->cases[i]); 3166} 3167 3168void 3169exp_cmd_print(struct exp_cmd_descriptor *ecmd) 3170{ 3171 printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype)); 3172 printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp "); 3173 /* printdict */ 3174 exp_ecases_print(&ecmd->ecd); 3175 exp_i_print(ecmd->i_list); 3176} 3177 3178void 3179exp_cmds_print(void) 3180{ 3181 exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]); 3182 exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]); 3183 exp_cmd_print(&exp_cmds[EXP_CMD_BG]); 3184} 3185 3186/*ARGSUSED*/ 3187int 3188cmdX( 3189 ClientData clientData, 3190 Tcl_Interp *interp, 3191 int objc, 3192 Tcl_Obj *CONST objv[]) /* Argument objects. */ 3193{ 3194 exp_cmds_print(); 3195 return TCL_OK; 3196} 3197#endif /*DEBUG_PERM_ECASES*/ 3198 3199void 3200expExpectVarsInit(void) 3201{ 3202 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); 3203 3204 tsdPtr->timeout = INIT_EXPECT_TIMEOUT; 3205} 3206 3207static struct exp_cmd_data 3208cmd_data[] = { 3209{"expect", Exp_ExpectObjCmd, 0, (ClientData)0, 0}, 3210{"expect_after",Exp_ExpectGlobalObjCmd, 0, (ClientData)&exp_cmds[EXP_CMD_AFTER],0}, 3211{"expect_before",Exp_ExpectGlobalObjCmd,0, (ClientData)&exp_cmds[EXP_CMD_BEFORE],0}, 3212{"expect_user", Exp_ExpectObjCmd, 0, (ClientData)&StdinoutPlaceholder,0}, 3213{"expect_tty", Exp_ExpectObjCmd, 0, (ClientData)&DevttyPlaceholder,0}, 3214{"expect_background",Exp_ExpectGlobalObjCmd,0, (ClientData)&exp_cmds[EXP_CMD_BG],0}, 3215 {"match_max", Exp_MatchMaxObjCmd, 0, (ClientData)0, 0}, 3216 {"remove_nulls", Exp_RemoveNullsObjCmd, 0, (ClientData)0, 0}, 3217 {"parity", Exp_ParityObjCmd, 0, (ClientData)0, 0}, 3218 {"close_on_eof", Exp_CloseOnEofObjCmd, 0, (ClientData)0, 0}, 3219 {"timestamp", Exp_TimestampObjCmd, 0, (ClientData)0, 0}, 3220{0}}; 3221 3222void 3223exp_init_expect_cmds(Tcl_Interp *interp) 3224{ 3225 exp_create_commands(interp,cmd_data); 3226 3227 Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0); 3228 3229 exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT); 3230 exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT); 3231 exp_cmd_init(&exp_cmds[EXP_CMD_BG ],EXP_CMD_BG, EXP_PERMANENT); 3232 exp_cmd_init(&exp_cmds[EXP_CMD_FG ],EXP_CMD_FG, EXP_TEMPORARY); 3233 3234 /* preallocate to one element, so future realloc's work */ 3235 exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0; 3236 exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0; 3237 exp_cmds[EXP_CMD_BG ].ecd.cases = 0; 3238 3239 pattern_style[PAT_EOF] = "eof"; 3240 pattern_style[PAT_TIMEOUT] = "timeout"; 3241 pattern_style[PAT_DEFAULT] = "default"; 3242 pattern_style[PAT_FULLBUFFER] = "full buffer"; 3243 pattern_style[PAT_GLOB] = "glob pattern"; 3244 pattern_style[PAT_RE] = "regular expression"; 3245 pattern_style[PAT_EXACT] = "exact string"; 3246 pattern_style[PAT_NULL] = "null"; 3247 3248#if 0 3249 Tcl_CreateObjCommand(interp,"x",cmdX,(ClientData)0,exp_deleteProc); 3250#endif 3251} 3252 3253void 3254exp_init_sig(void) { 3255#if 0 3256 signal(SIGALRM,sigalarm_handler); 3257 signal(SIGINT,sigint_handler); 3258#endif 3259} 3260 3261/* 3262 * Local Variables: 3263 * mode: c 3264 * c-basic-offset: 4 3265 * fill-column: 78 3266 * End: 3267 */ 3268