OSDN Git Service

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