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