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