1 /* expect.c - expect commands
3 Written by: Don Libes, NIST, 2/6/90
5 Design and implementation of this program was paid for by U.S. tax
6 dollars. Therefore it is public domain. However, the author and NIST
7 would appreciate credit if this program or parts of it are used.
11 #include <sys/types.h>
15 #include <ctype.h> /* for isspace */
16 #include <time.h> /* for time(3) */
18 #include "expect_cf.h"
20 #ifdef HAVE_SYS_WAIT_H
32 #include "exp_rename.h"
34 #include "exp_command.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 */
44 #include "retoglob.c" /* RE 2 GLOB translator C variant */
46 /* initial length of strings that we can guarantee patterns can match */
47 int exp_default_match_max = 2000;
48 #define INIT_EXPECT_TIMEOUT_LIT "10" /* seconds */
49 #define INIT_EXPECT_TIMEOUT 10 /* seconds */
50 int exp_default_parity = TRUE;
51 int exp_default_rm_nulls = TRUE;
52 int exp_default_close_on_eof = TRUE;
54 /* user variable names */
55 #define EXPECT_TIMEOUT "timeout"
56 #define EXPECT_OUT "expect_out"
58 extern int Exp_StringCaseMatch _ANSI_ARGS_((Tcl_UniChar *string, int strlen,
59 Tcl_UniChar *pattern,int plen,
60 int nocase,int *offset));
62 typedef struct ThreadSpecificData {
66 static Tcl_ThreadDataKey dataKey;
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.
73 static ExpState StdinoutPlaceholder;
74 static ExpState DevttyPlaceholder;
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.
80 struct ecase { /* case for expect command */
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
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
108 int Case; /* convert case before doing match? */
111 /* descriptions of the pattern types, used for debugging */
112 char *pattern_style[PAT_TYPES];
114 struct exp_cases_descriptor {
116 struct ecase **cases;
119 /* This describes an Expect command */
121 struct exp_cmd_descriptor {
122 int cmdtype; /* bg, before, after */
123 int duration; /* permanent or temporary */
124 int timeout_specified_by_flag; /* if -timeout flag used */
125 int timeout; /* timeout period if flag used */
126 struct exp_cases_descriptor ecd;
127 struct exp_i *i_list;
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.
138 struct exp_cmd_descriptor *cmd,
142 cmd->duration = duration;
143 cmd->cmdtype = cmdtype;
149 static int i_read_errno;/* place to save errno, if i_read() == -1, so it
150 doesn't get overwritten before we get to read it */
153 static int alarm_fired; /* if alarm occurs */
156 void exp_background_channelhandlers_run_all();
158 /* exp_indirect_updateX is called by Tcl when an indirect variable is set */
159 static char *exp_indirect_update1( /* 1-part Tcl variable names */
161 struct exp_cmd_descriptor *ecmd,
162 struct exp_i *exp_i);
163 static char *exp_indirect_update2( /* 2-part Tcl variable names */
164 ClientData clientData,
165 Tcl_Interp *interp, /* Interpreter containing variable. */
166 char *name1, /* Name of variable. */
167 char *name2, /* Second part of variable name. */
168 int flags); /* Information about what happened. */
173 sigalarm_handler(int n) /* unused, for compatibility with STDC */
177 #endif /*SIMPLE_EVENT*/
179 /* free up everything in ecase */
184 int free_ilist) /* if we should free ilist */
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); }
193 ec->i_list->ecount--;
194 if (ec->i_list->ecount == 0) {
195 exp_free_i(interp,ec->i_list,exp_indirect_update2);
199 ckfree((char *)ec); /* NEW */
202 /* free up any argv structures in the ecases */
206 struct exp_cmd_descriptor *eg,
207 int free_ilist) /* if true, free ilists */
211 if (!eg->ecd.cases) return;
213 for (i=0;i<eg->ecd.count;i++) {
214 free_ecase(interp,eg->ecd.cases[i],free_ilist);
216 ckfree((char *)eg->ecd.cases);
224 /* no standard defn for this, and some systems don't even have it, so avoid */
225 /* the whole quagmire by calling it something else */
226 static char *exp_strdup(char *s)
228 char *news = ckalloc(strlen(s) + 1);
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:
245 \nfoo\n TRUE (set of args)
248 Current test is very cheap and almost always right :-)
251 exp_one_arg_braced(Tcl_Obj *objPtr) /* INTL */
254 char *p = Tcl_GetString(objPtr);
262 if (!isspace(*p)) { /* INTL: ISO space */
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 */
276 exp_eval_with_one_arg(
277 ClientData clientData,
279 Tcl_Obj *CONST objv[]) /* Argument objects. */
281 Tcl_Obj* res = Tcl_NewListObj (1,objv);
283 #define NUM_STATIC_OBJS 20
288 int bytesLeft, numWords;
292 * Prepend the command name and the -nobrace switch so we can
293 * reinvoke without recursing.
296 Tcl_ListObjAppendElement (interp, res, Tcl_NewStringObj("-nobrace", -1));
298 p = Tcl_GetStringFromObj(objv[1], &bytesLeft);
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.
308 if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse)
313 numWords = parse.numWords;
316 * Generate an array of objects for the words of the command.
320 * For each word, perform substitutions then store the
321 * result in the objs array.
324 for (tokenPtr = parse.tokenPtr; numWords > 0;
325 numWords--, tokenPtr += (tokenPtr->numComponents + 1)) {
326 /* FUTURE: Save token information, do substitution later */
328 Tcl_Obj* w = Tcl_EvalTokens(interp, tokenPtr+1,
329 tokenPtr->numComponents);
330 /* w has refCount 1 here, if not NULL */
332 Tcl_DecrRefCount (res);
337 Tcl_ListObjAppendElement (interp, res, w);
338 Tcl_DecrRefCount (w); /* Local reference goes away */
343 * Advance to the next command in the script.
345 next = parse.commandStart + parse.commandSize;
346 bytesLeft -= next - p;
348 Tcl_FreeParse(&parse);
349 } while (bytesLeft > 0);
356 ecase_clear(struct ecase *ec)
362 ec->simple_start = 0;
365 ec->timestamp = FALSE;
366 ec->Case = CASE_NORM;
371 static struct ecase *
374 struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase));
382 parse_expect_args parses the arguments to expect or its variants.
383 It normally returns TCL_OK, and returns TCL_ERROR for failure.
384 (It can't return i_list directly because there is no way to differentiate
385 between clearing, say, expect_before and signalling an error.)
387 eg (expect_global) is initialized to reflect the arguments parsed
388 eg->ecd.cases is an array of ecases
389 eg->ecd.count is the # of ecases
390 eg->i_list is a linked list of exp_i's which represent the -i info
392 Each exp_i is chained to the next so that they can be easily free'd if
393 necessary. Each exp_i has a reference count. If the -i is not used
394 (e.g., has no following patterns), the ref count will be 0.
396 Each ecase points to an exp_i. Several ecases may point to the same exp_i.
397 Variables named by indirect exp_i's are read for the direct values.
399 If called from a foreground expect and no patterns or -i are given, a
400 default exp_i is forced so that the command "expect" works right.
402 The exp_i chain can be broken by the caller if desired.
409 struct exp_cmd_descriptor *eg,
410 ExpState *default_esPtr, /* suggested ExpState if called as expect_user or _tty */
412 Tcl_Obj *CONST objv[]) /* Argument objects. */
416 struct ecase ec; /* temporary to collect args */
418 eg->timeout_specified_by_flag = FALSE;
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. */
426 eg->ecd.cases = (struct ecase **)ckalloc(sizeof(struct ecase *) * (1+(objc/2)));
430 for (i = 1;i<objc;i++) {
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
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
447 * Allow abbreviations of switches and report an error if we
448 * get an invalid switch.
451 if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0,
455 switch ((enum flags) index) {
459 /* assignment here is not actually necessary */
460 /* since cases are initialized this way above */
461 /* ec.use = PAT_GLOB; */
463 Tcl_WrongNumArgs(interp, 1, objv,"-glob pattern");
470 Tcl_WrongNumArgs(interp, 1, objv,"-regexp regexp");
476 * Try compiling the expression so we can report
477 * any errors now rather then when we first try to
481 if (!(Tcl_GetRegExpFromObj(interp, objv[i],
482 TCL_REG_ADVANCED))) {
486 /* Derive a gate keeper glob pattern which reduces the amount
495 str = Tcl_GetUnicodeFromObj (objv[i], &strlen);
496 g = exp_retoglob (str, strlen);
501 expDiagLog("Gate keeper glob pattern for '%s'",Tcl_GetString(objv[i]));
502 expDiagLog(" is '%s'. Activating booster.\n",Tcl_GetString(g));
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");
515 Tcl_WrongNumArgs(interp, 1, objv, "-exact string");
520 case EXP_ARG_NOTRANSFER:
524 ec.Case = CASE_LOWER;
526 case EXP_ARG_SPAWN_ID:
529 Tcl_WrongNumArgs(interp, 1, objv, "-i spawn_id");
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;
538 /* link new i_list to head of list */
539 ec.i_list->next = eg->i_list;
540 eg->i_list = ec.i_list;
542 case EXP_ARG_INDICES:
548 case EXP_ARG_TIMESTAMP:
551 case EXP_ARG_DASH_TIMEOUT:
554 Tcl_WrongNumArgs(interp, 1, objv, "-timeout seconds");
557 if (Tcl_GetIntFromObj(interp, objv[i],
558 &eg->timeout) != TCL_OK) {
561 eg->timeout_specified_by_flag = TRUE;
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. */
572 * Keep processing arguments, we aren't ready for the
578 * We have a pattern or keyword.
581 static char *keywords[] = {
582 "timeout", "eof", "full_buffer", "default", "null",
586 EXP_ARG_TIMEOUT, EXP_ARG_EOF, EXP_ARG_FULL_BUFFER,
587 EXP_ARG_DEFAULT, EXP_ARG_NULL
591 * Match keywords exactly, otherwise they are patterns.
594 if (Tcl_GetIndexFromObj(interp, objv[i], keywords, "keyword",
595 1 /* exact */, &index) != TCL_OK) {
596 Tcl_ResetResult(interp);
599 switch ((enum keywords) index) {
600 case EXP_ARG_TIMEOUT:
601 ec.use = PAT_TIMEOUT;
606 case EXP_ARG_FULL_BUFFER:
607 ec.use = PAT_FULLBUFFER;
609 case EXP_ARG_DEFAULT:
610 ec.use = PAT_DEFAULT;
617 /* if no -i, use previous one */
619 /* if no -i flag has occurred yet, use default */
621 if (default_esPtr != EXP_SPAWN_ID_BAD) {
622 eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
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);
629 ec.i_list = eg->i_list;
633 /* save original pattern spec */
634 /* keywords such as "-timeout" are saved as patterns here */
635 /* useful for debugging but not otherwise used */
638 if (eg->duration == EXP_PERMANENT) {
639 Tcl_IncrRefCount(ec.pat);
641 Tcl_IncrRefCount(ec.gate);
648 if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.body);
653 *(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec;
655 /* clear out for next set */
662 /* if no patterns at all have appeared force the current */
663 /* spawn id to be added to list anyway */
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);
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);
678 /* very hard to free case_master_list here if it hasn't already */
679 /* been attached to a case, ugh */
681 /* note that i_list must be avail to free ecases! */
682 free_ecases(interp,eg,0);
685 exp_free_i(interp,eg->i_list,exp_indirect_update2);
689 #define EXP_IS_DEFAULT(x) ((x) == EXP_TIMEOUT || (x) == EXP_EOF)
691 static char yes[] = "yes\r\n";
692 static char no[] = "no\r\n";
694 /* this describes status of a successful match */
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 ! */
708 *----------------------------------------------------------------------
710 * string_case_first --
712 * Find the first instance of a pattern in a string.
715 * Returns the pointer to the first instance of the pattern
716 * in the given string, or NULL if no match was found.
721 *----------------------------------------------------------------------
725 string_case_first( /* INTL */
726 register Tcl_UniChar *string, /* String (unicode). */
727 int length, /* length of above string */
728 register char *pattern) /* Pattern, which may contain
729 * special characters (utf8). */
734 register int consumed = 0;
735 Tcl_UniChar ch1, ch2;
736 Tcl_UniChar *bufend = string + length;
738 while ((*string != 0) && (string < bufend)) {
741 while ((*s) && (s < bufend)) {
744 offset = TclUtfToUniChar(p, &ch2);
745 if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
760 string_first( /* INTL */
761 register Tcl_UniChar *string, /* String (unicode). */
762 int length, /* length of above string */
763 register char *pattern) /* Pattern, which may contain
764 * special characters (utf8). */
769 register int consumed = 0;
770 Tcl_UniChar ch1, ch2;
771 Tcl_UniChar *bufend = string + length;
773 while ((*string != 0) && (string < bufend)) {
776 while ((*s) && (s < bufend)) {
779 offset = TclUtfToUniChar(p, &ch2);
795 string_first_char( /* INTL */
796 register Tcl_UniChar *string, /* String. */
797 register Tcl_UniChar pattern)
799 /* unicode based Tcl_UtfFindFirst */
805 if (find == pattern) {
808 if (*string == '\0') {
816 /* like eval_cases, but handles only a single cases that needs a real */
818 /* returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCLERRROR */
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,
834 int numchars, flags, dummy, globmatch;
837 str = esPtr->input.buffer;
838 numchars = esPtr->input.use;
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]);
846 *last_case = e->Case;
849 if (e->use == PAT_RE) {
851 expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
856 Tcl_UniChar* pat = Tcl_GetUnicodeFromObj(e->gate,&plen);
858 expDiagLog("Gate \"");
859 expDiagLogU(expPrintify(Tcl_GetString(e->gate)));
860 expDiagLog("\"? gate=");
862 globmatch = Exp_StringCaseMatch(str, numchars, pat, plen,
863 (e->Case == CASE_NORM) ? 0 : 1,
866 expDiagLog("(No Gate, RE only) gate=");
868 /* No gate => RE matching always */
875 expDiagLog("yes re=");
877 if (e->Case == CASE_NORM) {
878 flags = TCL_REG_ADVANCED;
880 flags = TCL_REG_ADVANCED | TCL_REG_NOCASE;
883 re = Tcl_GetRegExpFromObj(interp, e->pat, flags);
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);
895 * Retrieve the byte offset of the end of the
899 Tcl_RegExpGetInfo(re, &info);
900 o->matchlen = info.matches[0].end;
905 } else if (result == 0) {
907 } else { /* result < 0 */
908 return(EXP_TCLERROR);
911 } else if (e->use == PAT_GLOB) {
912 int match; /* # of chars that matched */
915 expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
919 Tcl_UniChar* pat = Tcl_GetUnicodeFromObj(e->pat,&plen);
921 match = Exp_StringCaseMatch(str,numchars, pat, plen,
922 (e->Case == CASE_NORM) ? 0 : 1,
934 } else if (e->use == PAT_EXACT) {
936 char *pat = Tcl_GetStringFromObj(e->pat, &patLength);
939 if (e->Case == CASE_NORM) {
940 p = string_first(str, numchars, pat); /* NEW function in this file, see above */
942 p = string_case_first(str, numchars, pat);
946 expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
949 /* Bug 3095935. Go from #bytes to #chars */
950 patLength = Tcl_NumUtfChars (pat, patLength);
952 e->simple_start = p - str;
954 o->matchlen = patLength;
959 } else expDiagLogU(no);
960 } else if (e->use == PAT_NULL) {
961 CONST Tcl_UniChar *p;
962 expDiagLogU("null? ");
963 p = string_first_char (str, 0); /* NEW function in this file, see above */
967 o->matchlen = p-str; /* #chars */
974 } else if (e->use == PAT_FULLBUFFER) {
975 expDiagLogU(Tcl_GetString(e->pat));
977 /* this must be the same test as in expIRead */
978 /* We drop one third when are at least 2/3 full */
979 /* condition is (size >= max*2/3) <=> (size*3 >= max*2) */
980 if (((expSizeGet(esPtr)*3) >= (esPtr->input.max*2)) && (numchars > 0)) {
982 o->matchlen = numchars;
986 return(EXP_FULLBUFFER);
994 /* sets o.e if successfully finds a matching pattern, eof, timeout or deflt */
995 /* returns original status arg or EXP_TCLERROR */
999 struct exp_cmd_descriptor *eg,
1001 struct eval_out *o, /* 'output' - i.e., final case of interest */
1002 /* next two args are for debugging, when they change, reprint buffer */
1003 ExpState **last_esPtr,
1006 ExpState *(esPtrs[]),
1011 ExpState *em; /* ExpState of ecase */
1014 if (o->e || status == EXP_TCLERROR || eg->ecd.count == 0) return(status);
1016 if (status == EXP_TIMEOUT) {
1017 for (i=0;i<eg->ecd.count;i++) {
1018 e = eg->ecd.cases[i];
1019 if (e->use == PAT_TIMEOUT || e->use == PAT_DEFAULT) {
1025 } else if (status == EXP_EOF) {
1026 for (i=0;i<eg->ecd.count;i++) {
1027 e = eg->ecd.cases[i];
1028 if (e->use == PAT_EOF || e->use == PAT_DEFAULT) {
1029 struct exp_state_list *slPtr;
1031 for (slPtr=e->i_list->state_list; slPtr ;slPtr=slPtr->next) {
1033 if (expStateAnyIs(em) || em == esPtr) {
1043 /* the top loops are split from the bottom loop only because I can't */
1044 /* split'em further. */
1046 /* The bufferful condition does not prevent a pattern match from */
1047 /* occurring and vice versa, so it is scanned with patterns */
1048 for (i=0;i<eg->ecd.count;i++) {
1049 struct exp_state_list *slPtr;
1052 e = eg->ecd.cases[i];
1053 if (e->use == PAT_TIMEOUT ||
1054 e->use == PAT_DEFAULT ||
1055 e->use == PAT_EOF) continue;
1057 for (slPtr = e->i_list->state_list; slPtr; slPtr = slPtr->next) {
1059 /* if em == EXP_SPAWN_ID_ANY, then user is explicitly asking */
1060 /* every case to be checked against every ExpState */
1061 if (expStateAnyIs(em)) {
1062 /* test against each spawn_id */
1063 for (j=0;j<mcount;j++) {
1064 status = eval_case_string(interp,e,esPtrs[j],o,
1065 last_esPtr,last_case,suffix);
1066 if (status != EXP_NOMATCH) return(status);
1069 /* reject things immediately from wrong spawn_id */
1070 if (em != esPtr) continue;
1072 status = eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix);
1073 if (status != EXP_NOMATCH) return(status);
1077 return(EXP_NOMATCH);
1081 ecases_remove_by_expi(
1083 struct exp_cmd_descriptor *ecmd,
1084 struct exp_i *exp_i)
1088 /* delete every ecase dependent on it */
1089 for (i=0;i<ecmd->ecd.count;) {
1090 struct ecase *e = ecmd->ecd.cases[i];
1091 if (e->i_list == exp_i) {
1092 free_ecase(interp,e,0);
1094 /* shift remaining elements down */
1095 /* but only if there are any left */
1096 if (i+1 != ecmd->ecd.count) {
1097 memcpy(&ecmd->ecd.cases[i],
1098 &ecmd->ecd.cases[i+1],
1099 ((ecmd->ecd.count - i) - 1) *
1100 sizeof(struct exp_cmd_descriptor *));
1103 if (0 == ecmd->ecd.count) {
1104 ckfree((char *)ecmd->ecd.cases);
1105 ecmd->ecd.cases = 0;
1113 /* remove exp_i from list */
1117 struct exp_i **ei, /* list to remove from */
1118 struct exp_i *exp_i) /* element to remove */
1120 /* since it's in middle of list, free exp_i by hand */
1121 for (;*ei; ei = &(*ei)->next) {
1125 exp_free_i(interp,exp_i,exp_indirect_update2);
1131 /* remove exp_i from list and remove any dependent ecases */
1133 exp_i_remove_with_ecases(
1135 struct exp_cmd_descriptor *ecmd,
1136 struct exp_i *exp_i)
1138 ecases_remove_by_expi(interp,ecmd,exp_i);
1139 exp_i_remove(interp,&ecmd->i_list,exp_i);
1142 /* remove ecases tied to a single direct spawn id */
1146 struct exp_cmd_descriptor *ecmd,
1150 struct exp_i *exp_i, *next;
1151 struct exp_state_list **slPtr;
1153 for (exp_i=ecmd->i_list;exp_i;exp_i=next) {
1156 if (!(direct & exp_i->direct)) continue;
1158 for (slPtr = &exp_i->state_list;*slPtr;) {
1159 if (esPtr == ((*slPtr)->esPtr)) {
1160 struct exp_state_list *tmp = *slPtr;
1161 *slPtr = (*slPtr)->next;
1162 exp_free_state_single(tmp);
1164 /* if last bg ecase, disarm spawn id */
1165 if ((ecmd->cmdtype == EXP_CMD_BG) && (!expStateAnyIs(esPtr))) {
1167 if (esPtr->bg_ecount == 0) {
1168 exp_disarm_background_channelhandler(esPtr);
1169 esPtr->bg_interp = 0;
1175 slPtr = &(*slPtr)->next;
1178 /* if left with no ExpStates (and is direct), get rid of it */
1179 /* and any dependent ecases */
1180 if (exp_i->direct == EXP_DIRECT && !exp_i->state_list) {
1181 exp_i_remove_with_ecases(interp,ecmd,exp_i);
1186 /* this is called from exp_close to clean up the ExpState */
1188 exp_ecmd_remove_state_direct_and_indirect(
1192 ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BEFORE],esPtr,EXP_DIRECT|EXP_INDIRECT);
1193 ecmd_remove_state(interp,&exp_cmds[EXP_CMD_AFTER],esPtr,EXP_DIRECT|EXP_INDIRECT);
1194 ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BG],esPtr,EXP_DIRECT|EXP_INDIRECT);
1196 /* force it - explanation in exp_tk.c where this func is defined */
1197 exp_disarm_background_channelhandler_force(esPtr);
1200 /* arm a list of background ExpState's */
1204 struct exp_state_list *slPtr)
1206 /* for each spawn id in list, arm if necessary */
1207 for (;slPtr;slPtr=slPtr->next) {
1208 ExpState *esPtr = slPtr->esPtr;
1209 if (expStateAnyIs(esPtr)) continue;
1211 if (esPtr->bg_ecount == 0) {
1212 exp_arm_background_channelhandler(esPtr);
1213 esPtr->bg_interp = interp;
1219 /* return TRUE if this ecase is used by this fd */
1222 struct exp_i *exp_i,
1225 struct exp_state_list *fdp;
1227 for (fdp = exp_i->state_list;fdp;fdp=fdp->next) {
1228 if (fdp->esPtr == esPtr) return 1;
1238 if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer");
1239 if (ec->indices) Tcl_AppendElement(interp,"-indices");
1240 if (!ec->Case) Tcl_AppendElement(interp,"-nocase");
1242 if (ec->use == PAT_RE) Tcl_AppendElement(interp,"-re");
1243 else if (ec->use == PAT_GLOB) Tcl_AppendElement(interp,"-gl");
1244 else if (ec->use == PAT_EXACT) Tcl_AppendElement(interp,"-ex");
1245 Tcl_AppendElement(interp,Tcl_GetString(ec->pat));
1246 Tcl_AppendElement(interp,ec->body?Tcl_GetString(ec->body):"");
1249 /* append all ecases that match this exp_i */
1251 ecase_by_exp_i_append(
1253 struct exp_cmd_descriptor *ecmd,
1254 struct exp_i *exp_i)
1257 for (i=0;i<ecmd->ecd.count;i++) {
1258 if (ecmd->ecd.cases[i]->i_list == exp_i) {
1259 ecase_append(interp,ecmd->ecd.cases[i]);
1267 struct exp_i *exp_i)
1269 Tcl_AppendElement(interp,"-i");
1270 if (exp_i->direct == EXP_INDIRECT) {
1271 Tcl_AppendElement(interp,exp_i->variable);
1273 struct exp_state_list *fdp;
1275 /* if more than one element, add braces */
1276 if (exp_i->state_list->next) {
1277 Tcl_AppendResult(interp," {",(char *)0);
1280 for (fdp = exp_i->state_list;fdp;fdp=fdp->next) {
1281 char buf[25]; /* big enough for a small int */
1282 sprintf(buf,"%ld", (long)fdp->esPtr);
1283 Tcl_AppendElement(interp,buf);
1286 if (exp_i->state_list->next) {
1287 Tcl_AppendResult(interp,"} ",(char *)0);
1292 /* return current setting of the permanent expect_before/after/bg */
1296 struct exp_cmd_descriptor *ecmd,
1298 Tcl_Obj *CONST objv[]) /* Argument objects. */
1300 struct exp_i *exp_i;
1302 int direct = EXP_DIRECT|EXP_INDIRECT;
1304 int all = FALSE; /* report on all fds */
1305 ExpState *esPtr = 0;
1307 static char *flags[] = {"-i", "-all", "-noindirect", (char *)0};
1308 enum flags {EXP_ARG_I, EXP_ARG_ALL, EXP_ARG_NOINDIRECT};
1310 /* start with 2 to skip over "cmdname -info" */
1311 for (i = 2;i<objc;i++) {
1313 * Allow abbreviations of switches and report an error if we
1314 * get an invalid switch.
1318 if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0,
1319 &index) != TCL_OK) {
1322 switch ((enum flags) index) {
1326 Tcl_WrongNumArgs(interp, 1, objv,"-i spawn_id");
1333 case EXP_ARG_NOINDIRECT:
1334 direct &= ~EXP_INDIRECT;
1340 /* avoid printing out -i when redundant */
1341 struct exp_i *previous = 0;
1343 for (i=0;i<ecmd->ecd.count;i++) {
1344 if (previous != ecmd->ecd.cases[i]->i_list) {
1345 exp_i_append(interp,ecmd->ecd.cases[i]->i_list);
1346 previous = ecmd->ecd.cases[i]->i_list;
1348 ecase_append(interp,ecmd->ecd.cases[i]);
1354 if (!(esPtr = expStateCurrent(interp,0,0,0))) {
1357 } else if (!(esPtr = expStateFromChannelName(interp,iflag,0,0,0,"dummy"))) {
1358 /* not a valid ExpState so assume it is an indirect variable */
1359 Tcl_ResetResult(interp);
1360 for (i=0;i<ecmd->ecd.count;i++) {
1361 if (ecmd->ecd.cases[i]->i_list->direct == EXP_INDIRECT &&
1362 streq(ecmd->ecd.cases[i]->i_list->variable,iflag)) {
1363 ecase_append(interp,ecmd->ecd.cases[i]);
1369 /* print ecases of this direct_fd */
1370 for (exp_i=ecmd->i_list;exp_i;exp_i=exp_i->next) {
1371 if (!(direct & exp_i->direct)) continue;
1372 if (!exp_i_uses_state(exp_i,esPtr)) continue;
1373 ecase_by_exp_i_append(interp,ecmd,exp_i);
1379 /* Exp_ExpectGlobalObjCmd is invoked to process expect_before/after/background */
1382 Exp_ExpectGlobalObjCmd(
1383 ClientData clientData,
1386 Tcl_Obj *CONST objv[]) /* Argument objects. */
1388 int result = TCL_OK;
1389 struct exp_i *exp_i, **eip;
1390 struct exp_state_list *slPtr; /* temp for interating over state_list */
1391 struct exp_cmd_descriptor eg;
1393 Tcl_Obj* new_cmd = NULL;
1395 struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData;
1397 if ((objc == 2) && exp_one_arg_braced(objv[1])) {
1400 new_cmd = exp_eval_with_one_arg(clientData,interp,objv);
1401 if (!new_cmd) return TCL_ERROR;
1402 } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
1403 /* expect -brace {...} ... fake command line for reparsing */
1405 Tcl_Obj *new_objv[2];
1406 new_objv[0] = objv[0];
1407 new_objv[1] = objv[2];
1409 new_cmd = exp_eval_with_one_arg(clientData,interp,new_objv);
1410 if (!new_cmd) return TCL_ERROR;
1414 /* Replace old arguments with result of the reparse */
1415 Tcl_ListObjGetElements (interp, new_cmd, &objc, (Tcl_Obj***) &objv);
1418 if (objc > 1 && (Tcl_GetString(objv[1])[0] == '-')) {
1419 if (exp_flageq("info",Tcl_GetString(objv[1])+1,4)) {
1420 int res = expect_info(interp,ecmd,objc,objv);
1421 if (new_cmd) { Tcl_DecrRefCount (new_cmd); }
1426 exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT);
1428 if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD,
1430 if (new_cmd) { Tcl_DecrRefCount (new_cmd); }
1435 * visit each NEW direct exp_i looking for spawn ids.
1436 * When found, remove them from any OLD exp_i's.
1439 /* visit each exp_i */
1440 for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
1441 if (exp_i->direct == EXP_INDIRECT) continue;
1442 /* for each spawn id, remove it from ecases */
1443 for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
1444 ExpState *esPtr = slPtr->esPtr;
1446 /* validate all input descriptors */
1447 if (!expStateAnyIs(esPtr)) {
1448 if (!expStateCheck(interp,esPtr,1,1,"expect")) {
1454 /* remove spawn id from exp_i */
1455 ecmd_remove_state(interp,ecmd,esPtr,EXP_DIRECT);
1460 * For each indirect variable, release its old ecases and
1461 * clean up the matching spawn ids.
1462 * Same logic as in "expect_X delete" command.
1465 for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
1466 struct exp_i **old_i;
1468 if (exp_i->direct == EXP_DIRECT) continue;
1470 for (old_i = &ecmd->i_list;*old_i;) {
1473 if (((*old_i)->direct == EXP_DIRECT) ||
1474 (!streq((*old_i)->variable,exp_i->variable))) {
1475 old_i = &(*old_i)->next;
1479 ecases_remove_by_expi(interp,ecmd,*old_i);
1481 /* unlink from middle of list */
1485 exp_free_i(interp,tmp,exp_indirect_update2);
1488 /* if new one has ecases, update it */
1489 if (exp_i->ecount) {
1490 /* Note: The exp_indirect_ functions are Tcl_VarTraceProc's, and
1491 * are used as such in other places of Expect. We cannot use a
1492 * Tcl_Obj* as return value :(
1494 char *msg = exp_indirect_update1(interp,ecmd,exp_i);
1496 /* unusual way of handling error return */
1497 /* because of Tcl's variable tracing */
1498 Tcl_SetResult (interp, msg, TCL_VOLATILE);
1500 goto indirect_update_abort;
1504 /* empty i_lists have to be removed from global eg.i_list */
1505 /* before returning, even if during error */
1506 indirect_update_abort:
1509 * New exp_i's that have 0 ecases indicate fd/vars to be deleted.
1510 * Now that the deletions have been done, discard the new exp_i's.
1513 for (exp_i=eg.i_list;exp_i;) {
1514 struct exp_i *next = exp_i->next;
1516 if (exp_i->ecount == 0) {
1517 exp_i_remove(interp,&eg.i_list,exp_i);
1521 if (result == TCL_ERROR) goto cleanup;
1524 * arm all new bg direct fds
1527 if (ecmd->cmdtype == EXP_CMD_BG) {
1528 for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
1529 if (exp_i->direct == EXP_DIRECT) {
1530 state_list_arm(interp,exp_i->state_list);
1536 * now that old ecases are gone, add new ecases and exp_i's (both
1537 * direct and indirect).
1542 count = ecmd->ecd.count + eg.ecd.count;
1544 int start_index; /* where to add new ecases in old list */
1546 if (ecmd->ecd.count) {
1548 ecmd->ecd.cases = (struct ecase **)ckrealloc((char *)ecmd->ecd.cases, count * sizeof(struct ecase *));
1549 start_index = ecmd->ecd.count;
1551 /* append to beginning */
1552 ecmd->ecd.cases = (struct ecase **)ckalloc(eg.ecd.count * sizeof(struct ecase *));
1555 memcpy(&ecmd->ecd.cases[start_index],eg.ecd.cases,
1556 eg.ecd.count*sizeof(struct ecase *));
1557 ecmd->ecd.count = count;
1560 /* append exp_i's */
1561 for (eip = &ecmd->i_list;*eip;eip = &(*eip)->next) {
1562 /* empty loop to get to end of list */
1564 /* *exp_i now points to end of list */
1566 *eip = eg.i_list; /* connect new list to end of current list */
1569 if (result == TCL_ERROR) {
1570 /* in event of error, free any unreferenced ecases */
1571 /* but first, split up i_list so that exp_i's aren't */
1574 for (exp_i=eg.i_list;exp_i;) {
1575 struct exp_i *next = exp_i->next;
1579 free_ecases(interp,&eg,1);
1581 if (eg.ecd.cases) ckfree((char *)eg.ecd.cases);
1584 if (ecmd->cmdtype == EXP_CMD_BG) {
1585 exp_background_channelhandlers_run_all();
1588 if (new_cmd) { Tcl_DecrRefCount (new_cmd); }
1592 /* adjusts file according to user's size request */
1594 expAdjust(ExpState *esPtr)
1596 int new_msize, excess;
1597 Tcl_UniChar *string;
1600 * Resize buffer to user's request * 3 + 1.
1602 * x3: in case the match straddles two bufferfuls, and to allow
1603 * reading a bufferful even when we reach near fullness of two.
1604 * (At shuffle time this means we look for 2/3 full buffer and
1605 * drop a 1/3, i.e. half of that).
1607 * NOTE: The unmodified expect got the same effect by comparing
1608 * apples and oranges in shuffle mgmt, i.e bytes vs. chars,
1609 * and automatically extending the buffer (Tcl_Obj string)
1610 * to hold that much.
1612 * +1: for trailing null.
1615 new_msize = esPtr->umsize * 3 + 1;
1617 if (new_msize != esPtr->input.max) {
1619 if (esPtr->input.use > new_msize) {
1621 * too much data, forget about data at beginning of buffer
1624 string = esPtr->input.buffer;
1625 excess = esPtr->input.use - new_msize; /* #chars */
1627 memcpy (string, string + excess, new_msize * sizeof (Tcl_UniChar));
1628 esPtr->input.use = new_msize;
1632 * too little data - length < new_mbytes
1633 * Make larger if the max is also too small.
1636 if (esPtr->input.max < new_msize) {
1637 esPtr->input.buffer = (Tcl_UniChar*) \
1638 Tcl_Realloc ((char*)esPtr->input.buffer,
1639 new_msize * sizeof (Tcl_UniChar));
1643 esPtr->key = expect_key++;
1644 esPtr->input.max = new_msize;
1657 int changed = FALSE;
1659 for (p = Tcl_GetString(obj) + offsetBytes;*p;p++) {
1661 if (ch != *p) changed = TRUE;
1666 /* invalidate the unicode rep */
1667 if (obj->typePtr->freeIntRepProc) {
1668 obj->typePtr->freeIntRepProc(obj);
1673 /* This function is only used when debugging. It checks when a string's
1674 internal UTF is sane and whether an offset into the string appears to
1675 be at a UTF boundary.
1685 s = Tcl_GetStringFromObj(obj,&len);
1688 printf("offset (%d) > length (%d)\n",offset,len);
1693 /* first test for null terminator */
1696 printf("obj lacks null terminator\n");
1701 /* check for valid UTF sequence */
1705 s += TclUtfToUniChar(s,&uc);
1707 printf("UTF out of sync with terminator\n");
1716 s += TclUtfToUniChar(s,&uc);
1718 printf("UTF from offset out of sync with terminator\n");
1726 /* Strip nulls from object, beginning at offset */
1732 Tcl_UniChar *src, *src2, *dest, *end;
1733 int newsize; /* size of obj after all nulls removed */
1735 src2 = src = dest = buf->buffer + offsetChars;
1736 end = buf->buffer + buf->use;
1745 newsize = offsetChars + (dest - src2);
1750 /* returns # of bytes read or (non-positive) error of form EXP_XXX */
1751 /* returns 0 for end of file */
1752 /* If timeout is non-zero, set an alarm before doing the read, else assume */
1753 /* the read will complete immediately. */
1756 expIRead( /* INTL */
1762 int cc = EXP_TIMEOUT;
1765 /* We drop one third when are at least 2/3 full */
1766 /* condition is (size >= max*2/3) <=> (size*3 >= max*2) */
1767 if (expSizeGet(esPtr)*3 >= esPtr->input.max*2)
1768 exp_buffer_shuffle(interp,esPtr,save_flags,EXPECT_OUT,"expect");
1769 size = expSizeGet(esPtr);
1774 alarm_fired = FALSE;
1777 signal(SIGALRM,sigalarm_handler);
1778 alarm((timeout > 0)?timeout:1);
1782 cc = Tcl_ReadChars(esPtr->channel, esPtr->input.newchars,
1783 esPtr->input.max - esPtr->input.use,
1785 i_read_errno = errno;
1788 memcpy (esPtr->input.buffer + esPtr->input.use,
1789 Tcl_GetUnicodeFromObj (esPtr->input.newchars, NULL),
1790 cc * sizeof (Tcl_UniChar));
1791 esPtr->input.use += cc;
1798 /* check if alarm went off */
1799 if (i_read_errno == EINTR) {
1803 if (Tcl_AsyncReady()) {
1804 int rc = Tcl_AsyncInvoke(interp,TCL_OK);
1805 if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc));
1816 * expRead() does the logical equivalent of a read() for the expect command.
1817 * This includes figuring out which descriptor should be read from.
1819 * The result of the read() is left in a spawn_id's buffer rather than
1820 * explicitly passing it back. Note that if someone else has modified a buffer
1821 * either before or while this expect is running (i.e., if we or some event has
1822 * called Tcl_Eval which did another expect/interact), expRead will also call
1823 * this a successful read (for the purposes if needing to pattern match against
1827 /* if it returns a negative number, it corresponds to a EXP_XXX result */
1828 /* if it returns a non-negative number, it means there is data */
1829 /* (0 means nothing new was actually read, but it should be looked at again) */
1833 ExpState *(esPtrs[]), /* If 0, then esPtrOut already known and set */
1834 int esPtrsMax, /* number of esPtrs */
1835 ExpState **esPtrOut, /* Out variable to leave new ExpState. */
1844 int tcl_set_flags; /* if we have to discard chars, this tells */
1845 /* whether to show user locally or globally */
1848 /* we already know the ExpState, just find out what happened */
1849 cc = exp_get_next_event_info(interp,*esPtrOut);
1850 tcl_set_flags = TCL_GLOBAL_ONLY;
1852 cc = exp_get_next_event(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key);
1858 if (cc == EXP_DATA_NEW) {
1859 /* try to read it */
1860 cc = expIRead(interp,esPtr,timeout,tcl_set_flags);
1862 /* the meaning of 0 from i_read means eof. Muck with it a */
1863 /* little, so that from now on it means "no new data arrived */
1864 /* but it should be looked at again anyway". */
1867 } else if (cc > 0) {
1868 /* successfully read data */
1870 /* failed to read data - some sort of error was encountered such as
1871 * an interrupt with that forced an error return
1874 } else if (cc == EXP_DATA_OLD) {
1876 } else if (cc == EXP_RECONFIGURE) {
1877 return EXP_RECONFIGURE;
1880 if (cc == EXP_ABEOF) { /* abnormal EOF */
1881 /* On many systems, ptys produce EIO upon EOF - sigh */
1882 if (i_read_errno == EIO) {
1883 /* Sun, Cray, BSD, and others */
1885 } else if (i_read_errno == EINVAL) {
1886 /* Solaris 2.4 occasionally returns this */
1889 if (i_read_errno == EBADF) {
1890 exp_error(interp,"bad spawn_id (process died earlier?)");
1892 exp_error(interp,"i_read(spawn_id fd=%d): %s",esPtr->fdin,
1893 Tcl_PosixError(interp));
1894 if (esPtr->close_on_eof) {
1895 exp_close(interp,esPtr);
1898 return(EXP_TCLERROR);
1899 /* was goto error; */
1903 /* EOF, TIMEOUT, and ERROR return here */
1904 /* In such cases, there is no need to update screen since, if there */
1905 /* was prior data read, it would have been sent to the screen when */
1907 if (cc < 0) return (cc);
1913 size = expSizeGet(esPtr);
1914 if (size) write_count = size - esPtr->printed;
1915 else write_count = 0;
1919 * Show chars to user if they've requested it, UNLESS they're seeing it
1920 * already because they're typing it and tty driver is echoing it.
1921 * Also send to Diag and Log if appropriate.
1923 expLogInteractionU(esPtr,esPtr->input.buffer + esPtr->printed, write_count);
1926 * strip nulls from input, since there is no way for Tcl to deal with
1927 * such strings. Doing it here lets them be sent to the screen, just
1928 * in case they are involved in formatting operations
1930 if (esPtr->rm_nulls) size = expNullStrip(&esPtr->input,esPtr->printed);
1931 esPtr->printed = size; /* count'm even if not logging */
1936 /* when buffer fills, copy second half over first and */
1937 /* continue, so we can do matches over multiple buffers */
1939 exp_buffer_shuffle( /* INTL */
1948 int numchars, newlen, skiplen;
1949 Tcl_UniChar lostChar;
1952 * allow user to see data we are discarding
1955 expDiagLog("%s: set %s(spawn_id) \"%s\"\r\n",
1956 caller_name,array_name,esPtr->name);
1957 Tcl_SetVar2(interp,array_name,"spawn_id",esPtr->name,save_flags);
1960 * The internal storage buffer object should only be referred
1961 * to by the channel that uses it. We always copy the contents
1962 * out of the object before passing the data to anyone outside
1963 * of these routines. This ensures that the object always has
1964 * a refcount of 1 so we can safely modify the contents in place.
1967 str = esPtr->input.buffer;
1968 numchars = esPtr->input.use;
1970 skiplen = numchars/3;
1974 * before doing move, show user data we are discarding
1978 /* temporarily stick null in middle of string */
1981 expDiagLog("%s: set %s(buffer) \"",caller_name,array_name);
1982 expDiagLogU(expPrintifyUni(str,numchars));
1983 expDiagLogU("\"\r\n");
1984 Tcl_SetVar2Ex(interp,array_name,"buffer",
1985 Tcl_NewUnicodeObj (str, skiplen),
1994 * move 2nd half of string down to 1st half
1997 newlen = numchars - skiplen;
1998 memmove(str, p, newlen * sizeof(Tcl_UniChar));
1999 esPtr->input.use = newlen;
2001 esPtr->printed -= skiplen;
2002 if (esPtr->printed < 0) esPtr->printed = 0;
2005 /* map EXP_ style return value to TCL_ style return value */
2006 /* not defined to work on TCL_OK */
2008 exp_tcl2_returnvalue(int x)
2011 case TCL_ERROR: return EXP_TCLERROR;
2012 case TCL_RETURN: return EXP_TCLRET;
2013 case TCL_BREAK: return EXP_TCLBRK;
2014 case TCL_CONTINUE: return EXP_TCLCNT;
2015 case EXP_CONTINUE: return EXP_TCLCNTEXP;
2016 case EXP_CONTINUE_TIMER: return EXP_TCLCNTTIMER;
2017 case EXP_TCL_RETURN: return EXP_TCLRETTCL;
2019 /* Must not reach this location. Can happen only if x is an
2020 * illegal value. Added return to suppress compiler warning.
2025 /* map from EXP_ style return value to TCL_ style return values */
2027 exp_2tcl_returnvalue(int x)
2030 case EXP_TCLERROR: return TCL_ERROR;
2031 case EXP_TCLRET: return TCL_RETURN;
2032 case EXP_TCLBRK: return TCL_BREAK;
2033 case EXP_TCLCNT: return TCL_CONTINUE;
2034 case EXP_TCLCNTEXP: return EXP_CONTINUE;
2035 case EXP_TCLCNTTIMER: return EXP_CONTINUE_TIMER;
2036 case EXP_TCLRETTCL: return EXP_TCL_RETURN;
2038 /* Must not reach this location. Can happen only if x is an
2039 * illegal value. Added return to suppress compiler warning.
2044 /* variables predefined by expect are retrieved using this routine
2045 which looks in the global space if they are not in the local space.
2046 This allows the user to localize them if desired, and also to
2047 avoid having to put "global" in procedure definitions.
2056 if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */)))
2058 return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY));
2062 get_timeout(Tcl_Interp *interp)
2064 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
2067 if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) {
2068 tsdPtr->timeout = atoi(t);
2070 return(tsdPtr->timeout);
2073 /* make a copy of a linked list (1st arg) and attach to end of another (2nd
2076 update_expect_states(
2077 struct exp_i *i_list,
2078 struct exp_state_list **i_union)
2082 /* for each i_list in an expect statement ... */
2083 for (p=i_list;p;p=p->next) {
2084 struct exp_state_list *slPtr;
2086 /* for each esPtr in the i_list */
2087 for (slPtr=p->state_list;slPtr;slPtr=slPtr->next) {
2088 struct exp_state_list *tmpslPtr;
2089 struct exp_state_list *u;
2091 if (expStateAnyIs(slPtr->esPtr)) continue;
2093 /* check this one against all so far */
2094 for (u = *i_union;u;u=u->next) {
2095 if (slPtr->esPtr == u->esPtr) goto found;
2097 /* if not found, link in as head of list */
2098 tmpslPtr = exp_new_state(slPtr->esPtr);
2099 tmpslPtr->next = *i_union;
2100 *i_union = tmpslPtr;
2108 exp_cmdtype_printable(int cmdtype)
2111 case EXP_CMD_FG: return("expect");
2112 case EXP_CMD_BG: return("expect_background");
2113 case EXP_CMD_BEFORE: return("expect_before");
2114 case EXP_CMD_AFTER: return("expect_after");
2117 return("unknown expect command");
2121 /* exp_indirect_update2 is called back via Tcl's trace handler whenever */
2122 /* an indirect spawn id list is changed */
2125 exp_indirect_update2(
2126 ClientData clientData,
2127 Tcl_Interp *interp, /* Interpreter containing variable. */
2128 char *name1, /* Name of variable. */
2129 char *name2, /* Second part of variable name. */
2130 int flags) /* Information about what happened. */
2134 struct exp_i *exp_i = (struct exp_i *)clientData;
2135 exp_configure_count++;
2136 msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i);
2138 exp_background_channelhandlers_run_all();
2144 exp_indirect_update1(
2146 struct exp_cmd_descriptor *ecmd,
2147 struct exp_i *exp_i)
2149 struct exp_state_list *slPtr; /* temp for interating over state_list */
2152 * disarm any ExpState's that lose all their active spawn ids
2155 if (ecmd->cmdtype == EXP_CMD_BG) {
2156 /* clean up each spawn id used by this exp_i */
2157 for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
2158 ExpState *esPtr = slPtr->esPtr;
2160 if (expStateAnyIs(esPtr)) continue;
2162 /* silently skip closed or preposterous fds */
2163 /* since we're just disabling them anyway */
2164 /* preposterous fds will have been reported */
2165 /* by code in next section already */
2166 if (!expStateCheck(interp,slPtr->esPtr,1,0,"")) continue;
2168 /* check before decrementing, ecount may not be */
2169 /* positive if update is called before ecount is */
2170 /* properly synchronized */
2171 if (esPtr->bg_ecount > 0) {
2174 if (esPtr->bg_ecount == 0) {
2175 exp_disarm_background_channelhandler(esPtr);
2176 esPtr->bg_interp = 0;
2182 * reread indirect variable
2185 exp_i_update(interp,exp_i);
2188 * check validity of all fd's in variable
2191 for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
2192 /* validate all input descriptors */
2194 if (expStateAnyIs(slPtr->esPtr)) continue;
2196 if (!expStateCheck(interp,slPtr->esPtr,1,1,
2197 exp_cmdtype_printable(ecmd->cmdtype))) {
2198 /* Note: Cannot construct a Tcl_Obj* here, the function is a
2199 * Tcl_VarTraceProc and the API wants a char*.
2201 * DANGER: The buffer may overflow if either the existing result,
2202 * the variable name, or both become to large.
2204 static char msg[200];
2205 sprintf(msg,"%s from indirect variable (%s)",
2206 Tcl_GetStringResult (interp),exp_i->variable);
2211 /* for each spawn id in list, arm if necessary */
2212 if (ecmd->cmdtype == EXP_CMD_BG) {
2213 state_list_arm(interp,exp_i->state_list);
2222 struct eval_out *eo, /* final case of interest */
2223 int cc, /* EOF, TIMEOUT, etc... */
2224 int bg, /* 1 if called from background handler, */
2228 ExpState *esPtr = 0;
2230 Tcl_UniChar *buffer;
2231 struct ecase *e = 0; /* points to current ecase */
2232 int match = -1; /* characters matched */
2233 /* uprooted by a NULL */
2234 int result = TCL_OK;
2236 #define out(indexName, value) \
2237 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \
2238 expDiagLogU(expPrintify(value)); \
2239 expDiagLogU("\"\r\n"); \
2240 Tcl_SetVar2(interp, EXPECT_OUT,indexName,value,(bg ? TCL_GLOBAL_ONLY : 0));
2242 /* The numchars argument allows us to avoid sticking a \0 into the buffer */
2243 #define outuni(indexName, value,numchars) \
2244 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \
2245 expDiagLogU(expPrintifyUni(value,numchars)); \
2246 expDiagLogU("\"\r\n"); \
2247 Tcl_SetVar2Ex(interp, EXPECT_OUT,indexName,Tcl_NewUnicodeObj(value,numchars),(bg ? TCL_GLOBAL_ONLY : 0));
2252 if (cc != EXP_TIMEOUT) {
2254 match = eo->matchlen;
2255 buffer = eo->matchbuf;
2257 } else if (cc == EXP_EOF) {
2258 /* read an eof but no user-supplied case */
2260 match = eo->matchlen;
2261 buffer = eo->matchbuf;
2265 char name[20], value[20];
2268 if (e && e->use == PAT_RE) {
2271 Tcl_RegExpInfo info;
2274 /* No gate keeper required here, we know that the RE
2275 * matches, we just do it again to get all the captured
2279 if (e->Case == CASE_NORM) {
2280 flags = TCL_REG_ADVANCED;
2282 flags = TCL_REG_ADVANCED | TCL_REG_NOCASE;
2285 re = Tcl_GetRegExpFromObj(interp, e->pat, flags);
2286 Tcl_RegExpGetInfo(re, &info);
2288 buf = Tcl_NewUnicodeObj (buffer,esPtr->input.use);
2289 for (i=0;i<=info.nsubs;i++) {
2293 start = info.matches[i].start;
2294 end = info.matches[i].end-1;
2295 if (start == -1) continue;
2299 sprintf(name,"%d,start",i);
2300 sprintf(value,"%d",start);
2304 sprintf(name,"%d,end",i);
2305 sprintf(value,"%d",end);
2310 sprintf(name,"%d,string",i);
2311 val = Tcl_GetRange(buf, start, end);
2312 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,name);
2313 expDiagLogU(expPrintifyObj(val));
2314 expDiagLogU("\"\r\n");
2315 Tcl_SetVar2Ex(interp,EXPECT_OUT,name,val,(bg ? TCL_GLOBAL_ONLY : 0));
2317 Tcl_DecrRefCount (buf);
2318 } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) {
2323 sprintf(value,"%d",e->simple_start);
2324 out("0,start",value);
2327 sprintf(value,"%d",e->simple_start + match - 1);
2332 str = esPtr->input.buffer + e->simple_start;
2333 outuni("0,string",str,match);
2335 /* redefine length of string that */
2336 /* matched for later extraction */
2337 match += e->simple_start;
2338 } else if (e && e->use == PAT_NULL && e->indices) {
2340 sprintf(value,"%d",match-1);
2341 out("0,start",value);
2343 sprintf(value,"%d",match-1);
2345 } else if (e && e->use == PAT_FULLBUFFER) {
2346 expDiagLogU("expect_background: full buffer\r\n");
2350 /* this is broken out of (match > 0) (above) since it can be */
2351 /* that an EOF occurred with match == 0 */
2356 out("spawn_id",esPtr->name);
2358 str = esPtr->input.buffer;
2359 numchars = esPtr->input.use;
2361 /* Save buf[0..match] */
2362 outuni("buffer",str,match);
2364 /* "!e" means no case matched - transfer by default */
2365 if (!e || e->transfer) {
2366 int remainder = numchars-match;
2367 /* delete matched chars from input buffer */
2368 esPtr->printed -= match;
2369 if (numchars != 0) {
2370 memmove(str,str+match,remainder*sizeof(Tcl_UniChar));
2372 esPtr->input.use = remainder;
2375 if (cc == EXP_EOF) {
2376 /* exp_close() deletes all background bodies */
2377 /* so save eof body temporarily */
2378 if (body) { Tcl_IncrRefCount(body); }
2379 if (esPtr->close_on_eof) {
2380 exp_close(interp,esPtr);
2387 result = Tcl_EvalObjEx(interp,body,0);
2389 result = Tcl_EvalObjEx(interp,body,TCL_EVAL_GLOBAL);
2390 if (result != TCL_OK) Tcl_BackgroundError(interp);
2392 if (cc == EXP_EOF) { Tcl_DecrRefCount(body); }
2397 /* this function is called from the background when input arrives */
2400 exp_background_channelhandler( /* INTL */
2401 ClientData clientData,
2404 char backup[EXP_CHANNELNAMELEN+1]; /* backup copy of esPtr channel name! */
2408 int cc; /* number of bytes returned in a single read */
2409 /* or negative EXP_whatever */
2410 struct eval_out eo; /* final case of interest */
2411 ExpState *last_esPtr; /* for differentiating when multiple esPtrs */
2412 /* to print out better debugging messages */
2413 int last_case; /* as above but for case */
2415 /* restore our environment */
2416 esPtr = (ExpState *)clientData;
2418 /* backup just in case someone zaps esPtr in the middle of our work! */
2419 strcpy(backup,esPtr->name);
2421 interp = esPtr->bg_interp;
2423 /* temporarily prevent this handler from being invoked again */
2424 exp_block_background_channelhandler(esPtr);
2427 * if mask == 0, then we've been called because the patterns changed not
2428 * because the waiting data has changed, so don't actually do any I/O
2433 esPtr->notifiedMask = mask;
2434 esPtr->notified = FALSE;
2435 cc = expRead(interp,(ExpState **)0,0,&esPtr,EXP_TIME_INFINITY,0);
2439 eo.e = 0; /* no final case yet */
2440 eo.esPtr = 0; /* no final file selected yet */
2441 eo.matchlen = 0; /* nothing matched yet */
2443 /* force redisplay of buffer when debugging */
2446 if (cc == EXP_EOF) {
2448 } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/
2451 * if we were going to do this right, we should differentiate between
2452 * things like HP ioctl-open-traps that fall out here and should
2453 * rightfully be ignored and real errors that should be reported. Come
2454 * to think of it, the only errors will come from HP ioctl handshake
2458 /* normal case, got data */
2459 /* new data if cc > 0, same old data if cc == 0 */
2461 /* below here, cc as general status */
2465 cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE],
2466 esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
2467 cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG],
2468 esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
2469 cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER],
2470 esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
2471 if (cc == EXP_TCLERROR) {
2472 /* only likely problem here is some internal regexp botch */
2473 Tcl_BackgroundError(interp);
2476 /* special eof code that cannot be done in eval_cases */
2477 /* or above, because it would then be executed several times */
2478 if (cc == EXP_EOF) {
2480 eo.matchlen = expSizeGet(eo.esPtr);
2481 eo.matchbuf = eo.esPtr->input.buffer;
2482 expDiagLogU("expect_background: read eof\r\n");
2486 /* if we get here, there must not have been a match */
2491 expMatchProcess(interp, &eo, cc, 1 /* bg */,"expect_background");
2494 * Event handler will not call us back if there is more input
2495 * pending but it has already arrived. bg_status will be
2496 * "blocked" only if armed.
2500 * Connection could have been closed on us. In this case,
2501 * exitWhenBgStatusUnblocked will be 1 and we should disable the channel
2502 * handler and release the esPtr.
2505 /* First check that the esPtr is even still valid! */
2506 /* This ought to be sufficient. */
2507 if (0 == Tcl_GetChannel(interp,backup,(int *)0)) {
2508 expDiagLog("expect channel %s lost in background handler\n",backup);
2512 if ((!esPtr->freeWhenBgHandlerUnblocked) && (esPtr->bg_status == blocked)) {
2513 if (0 != (cc = expSizeGet(esPtr))) {
2518 exp_unblock_background_channelhandler(esPtr);
2519 if (esPtr->freeWhenBgHandlerUnblocked)
2520 expStateFree(esPtr);
2526 ClientData clientData,
2529 Tcl_Obj *CONST objv[]) /* Argument objects. */
2531 int cc; /* number of chars returned in a single read */
2532 /* or negative EXP_whatever */
2533 ExpState *esPtr = 0;
2535 int i; /* misc temporary */
2536 struct exp_cmd_descriptor eg;
2537 struct exp_state_list *state_list; /* list of ExpStates to watch */
2538 struct exp_state_list *slPtr; /* temp for interating over state_list */
2540 int mcount; /* number of esPtrs to watch */
2542 struct eval_out eo; /* final case of interest */
2544 int result; /* Tcl result */
2546 time_t start_time_total; /* time at beginning of this procedure */
2547 time_t start_time = 0; /* time when restart label hit */
2548 time_t current_time = 0; /* current time (when we last looked)*/
2549 time_t end_time; /* future time at which to give up */
2551 ExpState *last_esPtr; /* for differentiating when multiple f's */
2552 /* to print out better debugging messages */
2553 int last_case; /* as above but for case */
2554 int first_time = 1; /* if not "restarted" */
2556 int key; /* identify this expect command instance */
2557 int configure_count; /* monitor exp_configure_count */
2559 int timeout; /* seconds */
2560 int remtime; /* remaining time in timeout */
2561 int reset_timer; /* should timer be reset after continue? */
2563 Tcl_Obj* new_cmd = NULL;
2565 if ((objc == 2) && exp_one_arg_braced(objv[1])) {
2568 new_cmd = exp_eval_with_one_arg(clientData,interp,objv);
2569 if (!new_cmd) return TCL_ERROR;
2570 } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
2571 /* expect -brace {...} ... fake command line for reparsing */
2573 Tcl_Obj *new_objv[2];
2574 new_objv[0] = objv[0];
2575 new_objv[1] = objv[2];
2577 new_cmd = exp_eval_with_one_arg(clientData,interp,new_objv);
2578 if (!new_cmd) return TCL_ERROR;
2582 /* Replace old arguments with result of the reparse */
2583 Tcl_ListObjGetElements (interp, new_cmd, &objc, (Tcl_Obj***) &objv);
2586 Tcl_GetTime (&temp_time);
2587 start_time_total = temp_time.sec;
2588 start_time = start_time_total;
2591 if (&StdinoutPlaceholder == (ExpState *)clientData) {
2592 clientData = (ClientData) expStdinoutGet();
2593 } else if (&DevttyPlaceholder == (ExpState *)clientData) {
2594 clientData = (ClientData) expDevttyGet();
2597 /* make arg list for processing cases */
2598 /* do it dynamically, since expect can be called recursively */
2600 exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY);
2603 if (TCL_ERROR == parse_expect_args(interp,&eg, (ExpState *)clientData,
2605 if (new_cmd) { Tcl_DecrRefCount (new_cmd); }
2609 restart_with_update:
2610 /* validate all descriptors and flatten ExpStates into array */
2612 if ((TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_BEFORE].i_list,&state_list))
2613 || (TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_AFTER].i_list, &state_list))
2614 || (TCL_ERROR == update_expect_states(eg.i_list,&state_list))) {
2619 /* declare ourselves "in sync" with external view of close/indirect */
2620 configure_count = exp_configure_count;
2622 /* count and validate state_list */
2624 for (slPtr=state_list;slPtr;slPtr=slPtr->next) {
2626 /* validate all input descriptors */
2627 if (!expStateCheck(interp,slPtr->esPtr,1,1,"expect")) {
2633 /* make into an array */
2634 esPtrs = (ExpState **)ckalloc(mcount * sizeof(ExpState *));
2635 for (slPtr=state_list,i=0;slPtr;slPtr=slPtr->next,i++) {
2636 esPtrs[i] = slPtr->esPtr;
2640 if (first_time) first_time = 0;
2642 Tcl_GetTime (&temp_time);
2643 start_time = temp_time.sec;
2646 if (eg.timeout_specified_by_flag) {
2647 timeout = eg.timeout;
2649 /* get the latest timeout */
2650 timeout = get_timeout(interp);
2659 * end of restart code
2662 eo.e = 0; /* no final case yet */
2663 eo.esPtr = 0; /* no final ExpState selected yet */
2664 eo.matchlen = 0; /* nothing matched yet */
2666 /* timeout code is a little tricky, be very careful changing it */
2667 if (timeout != EXP_TIME_INFINITY) {
2668 /* if exp_continue -continue_timer, do not update end_time */
2670 Tcl_GetTime (&temp_time);
2671 current_time = temp_time.sec;
2672 end_time = current_time + timeout;
2678 /* remtime and current_time updated at bottom of loop */
2682 if ((timeout != EXP_TIME_INFINITY) && (remtime < 0)) {
2685 cc = expRead(interp,esPtrs,mcount,&esPtr,remtime,key);
2689 if (cc == EXP_EOF) {
2691 } else if (cc == EXP_TIMEOUT) {
2692 expDiagLogU("expect: timed out\r\n");
2693 } else if (cc == EXP_RECONFIGURE) {
2694 reset_timer = FALSE;
2695 goto restart_with_update;
2696 } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/
2699 /* new data if cc > 0, same old data if cc == 0 */
2701 /* below here, cc as general status */
2704 /* force redisplay of buffer when debugging */
2708 cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE],
2709 esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
2710 cc = eval_cases(interp,&eg,
2711 esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
2712 cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER],
2713 esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
2714 if (cc == EXP_TCLERROR) goto error;
2715 /* special eof code that cannot be done in eval_cases */
2716 /* or above, because it would then be executed several times */
2717 if (cc == EXP_EOF) {
2719 eo.matchlen = expSizeGet(eo.esPtr);
2720 eo.matchbuf = eo.esPtr->input.buffer;
2721 expDiagLogU("expect: read eof\r\n");
2723 } else if (cc == EXP_TIMEOUT) break;
2725 /* break if timeout or eof and failed to find a case for it */
2729 /* no match was made with current data, force a read */
2730 esPtr->force_read = TRUE;
2732 if (timeout != EXP_TIME_INFINITY) {
2733 Tcl_GetTime (&temp_time);
2734 current_time = temp_time.sec;
2735 remtime = end_time - current_time;
2742 result = exp_2tcl_returnvalue(cc);
2744 if (result != TCL_ERROR) {
2745 result = expMatchProcess(interp, &eo, cc, 0 /* not bg */,"expect");
2749 if (result == EXP_CONTINUE_TIMER) {
2750 reset_timer = FALSE;
2751 result = EXP_CONTINUE;
2754 if ((result == EXP_CONTINUE) && (configure_count == exp_configure_count)) {
2755 expDiagLogU("expect: continuing expect\r\n");
2760 exp_free_state(state_list);
2764 ckfree((char *)esPtrs);
2768 if (result == EXP_CONTINUE) {
2769 expDiagLogU("expect: continuing expect after update\r\n");
2770 goto restart_with_update;
2773 free_ecases(interp,&eg,0); /* requires i_lists to be avail */
2774 exp_free_i(interp,eg.i_list,exp_indirect_update2);
2776 if (new_cmd) { Tcl_DecrRefCount (new_cmd); }
2782 Exp_TimestampObjCmd(
2783 ClientData clientData,
2786 Tcl_Obj *CONST objv[]) /* Argument objects. */
2789 time_t seconds = -1;
2790 int gmt = FALSE; /* local time by default */
2792 Tcl_DString dstring;
2795 static char* options[] = {
2807 for (i=1; i<objc; i++) {
2811 name = Tcl_GetString(objv[i]);
2812 if (name[0] != '-') {
2815 if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
2816 &index) != TCL_OK) {
2819 switch ((enum options) index) {
2822 if (i >= objc) goto usage_error;
2823 format = Tcl_GetString (objv[i]);
2831 if (i >= objc) goto usage_error;
2832 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &sec)) {
2841 if (i < objc) goto usage_error;
2843 if (seconds == -1) {
2849 tm = gmtime(&seconds);
2851 tm = localtime(&seconds);
2853 Tcl_DStringInit(&dstring);
2854 exp_strftime(format,tm,&dstring);
2855 Tcl_DStringResult(interp,&dstring);
2857 Tcl_SetObjResult (interp, Tcl_NewIntObj (seconds));
2862 exp_error(interp,"args: [-seconds #] [-format format] [-gmt]");
2867 /* Helper function hnadling the common processing of -d and -i options of
2872 process_di _ANSI_ARGS_ ((Tcl_Interp* interp,
2874 Tcl_Obj *CONST objv[], /* Argument objects. */
2884 Tcl_Obj *CONST objv[], /* Argument objects. */
2890 static char* options[] = {
2904 for (i=1; i<objc; i++) {
2908 name = Tcl_GetString(objv[i]);
2909 if (name[0] != '-') {
2912 if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
2913 &index) != TCL_OK) {
2916 switch ((enum options) index) {
2923 exp_error(interp,"-i needs argument");
2926 chan = Tcl_GetString (objv[i]);
2932 exp_error(interp,"cannot do -d and -i at the same time");
2936 /* Not all arguments processed, more than two remaining, only at most one
2937 * remaining is expected/allowed.
2940 exp_error(interp,"too many arguments");
2946 esPtr = expStateCurrent(interp,0,0,0);
2948 esPtr = expStateFromChannelName(interp,chan,0,0,0,(char*)cmd);
2950 if (!esPtr) return(TCL_ERROR);
2963 ClientData clientData,
2966 Tcl_Obj *CONST objv[]) /* Argument objects. */
2969 ExpState *esPtr = 0;
2970 int Default = FALSE;
2973 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "match_max"))
2976 /* No size argument */
2979 size = exp_default_match_max;
2981 size = esPtr->umsize;
2983 Tcl_SetObjResult (interp, Tcl_NewIntObj (size));
2988 * All that's left is to set the size
2991 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &size)) {
2996 exp_error(interp,"must be positive");
3000 if (Default) exp_default_match_max = size;
3001 else esPtr->umsize = size;
3008 Exp_RemoveNullsObjCmd(
3009 ClientData clientData,
3012 Tcl_Obj *CONST objv[]) /* Argument objects. */
3015 ExpState *esPtr = 0;
3016 int Default = FALSE;
3019 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "remove_nulls"))
3022 /* No flag argument */
3025 value = exp_default_rm_nulls;
3027 value = esPtr->rm_nulls;
3029 Tcl_SetObjResult (interp, Tcl_NewIntObj (value));
3033 /* all that's left is to set the value */
3035 if (TCL_OK != Tcl_GetBooleanFromObj (interp, objv[i], &value)) {
3039 if ((value != 0) && (value != 1)) {
3040 exp_error(interp,"must be 0 or 1");
3044 if (Default) exp_default_rm_nulls = value;
3045 else esPtr->rm_nulls = value;
3053 ClientData clientData,
3056 Tcl_Obj *CONST objv[]) /* Argument objects. */
3059 ExpState *esPtr = 0;
3060 int Default = FALSE;
3063 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "parity"))
3066 /* No parity argument */
3069 parity = exp_default_parity;
3071 parity = esPtr->parity;
3073 Tcl_SetObjResult (interp, Tcl_NewIntObj (parity));
3077 /* all that's left is to set the parity */
3079 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &parity)) {
3083 if (Default) exp_default_parity = parity;
3084 else esPtr->parity = parity;
3091 Exp_CloseOnEofObjCmd(
3092 ClientData clientData,
3095 Tcl_Obj *CONST objv[]) /* Argument objects. */
3098 ExpState *esPtr = 0;
3099 int Default = FALSE;
3102 if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "close_on_eof"))
3105 /* No flag argument */
3108 close_on_eof = exp_default_close_on_eof;
3110 close_on_eof = esPtr->close_on_eof;
3112 Tcl_SetObjResult (interp, Tcl_NewIntObj (close_on_eof));
3116 /* all that's left is to set the close_on_eof */
3118 if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &close_on_eof)) {
3122 if (Default) exp_default_close_on_eof = close_on_eof;
3123 else esPtr->close_on_eof = close_on_eof;
3128 #if DEBUG_PERM_ECASES
3129 /* This big chunk of code is just for debugging the permanent */
3132 exp_fd_print(struct exp_state_list *slPtr)
3135 printf("%d ",slPtr->esPtr);
3136 exp_fd_print(slPtr->next);
3140 exp_i_print(struct exp_i *exp_i)
3143 printf("exp_i %x",exp_i);
3144 printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect");
3145 printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp");
3146 printf(" ecount = %d\n",exp_i->ecount);
3147 printf("variable %s, value %s\n",
3148 ((exp_i->variable)?exp_i->variable:"--"),
3149 ((exp_i->value)?exp_i->value:"--"));
3150 printf("ExpStates: ");
3151 exp_fd_print(exp_i->state_list); printf("\n");
3152 exp_i_print(exp_i->next);
3156 exp_ecase_print(struct ecase *ecase)
3158 printf("pat <%s>\n",ecase->pat);
3159 printf("exp_i = %x\n",ecase->i_list);
3163 exp_ecases_print(struct exp_cases_descriptor *ecd)
3167 printf("%d cases\n",ecd->count);
3168 for (i=0;i<ecd->count;i++) exp_ecase_print(ecd->cases[i]);
3172 exp_cmd_print(struct exp_cmd_descriptor *ecmd)
3174 printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype));
3175 printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp ");
3177 exp_ecases_print(&ecmd->ecd);
3178 exp_i_print(ecmd->i_list);
3182 exp_cmds_print(void)
3184 exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]);
3185 exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]);
3186 exp_cmd_print(&exp_cmds[EXP_CMD_BG]);
3192 ClientData clientData,
3195 Tcl_Obj *CONST objv[]) /* Argument objects. */
3200 #endif /*DEBUG_PERM_ECASES*/
3203 expExpectVarsInit(void)
3205 ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
3207 tsdPtr->timeout = INIT_EXPECT_TIMEOUT;
3210 static struct exp_cmd_data
3212 {"expect", Exp_ExpectObjCmd, 0, (ClientData)0, 0},
3213 {"expect_after",Exp_ExpectGlobalObjCmd, 0, (ClientData)&exp_cmds[EXP_CMD_AFTER],0},
3214 {"expect_before",Exp_ExpectGlobalObjCmd,0, (ClientData)&exp_cmds[EXP_CMD_BEFORE],0},
3215 {"expect_user", Exp_ExpectObjCmd, 0, (ClientData)&StdinoutPlaceholder,0},
3216 {"expect_tty", Exp_ExpectObjCmd, 0, (ClientData)&DevttyPlaceholder,0},
3217 {"expect_background",Exp_ExpectGlobalObjCmd,0, (ClientData)&exp_cmds[EXP_CMD_BG],0},
3218 {"match_max", Exp_MatchMaxObjCmd, 0, (ClientData)0, 0},
3219 {"remove_nulls", Exp_RemoveNullsObjCmd, 0, (ClientData)0, 0},
3220 {"parity", Exp_ParityObjCmd, 0, (ClientData)0, 0},
3221 {"close_on_eof", Exp_CloseOnEofObjCmd, 0, (ClientData)0, 0},
3222 {"timestamp", Exp_TimestampObjCmd, 0, (ClientData)0, 0},
3226 exp_init_expect_cmds(Tcl_Interp *interp)
3228 exp_create_commands(interp,cmd_data);
3230 Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0);
3232 exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT);
3233 exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT);
3234 exp_cmd_init(&exp_cmds[EXP_CMD_BG ],EXP_CMD_BG, EXP_PERMANENT);
3235 exp_cmd_init(&exp_cmds[EXP_CMD_FG ],EXP_CMD_FG, EXP_TEMPORARY);
3237 /* preallocate to one element, so future realloc's work */
3238 exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0;
3239 exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0;
3240 exp_cmds[EXP_CMD_BG ].ecd.cases = 0;
3242 pattern_style[PAT_EOF] = "eof";
3243 pattern_style[PAT_TIMEOUT] = "timeout";
3244 pattern_style[PAT_DEFAULT] = "default";
3245 pattern_style[PAT_FULLBUFFER] = "full buffer";
3246 pattern_style[PAT_GLOB] = "glob pattern";
3247 pattern_style[PAT_RE] = "regular expression";
3248 pattern_style[PAT_EXACT] = "exact string";
3249 pattern_style[PAT_NULL] = "null";
3252 Tcl_CreateObjCommand(interp,"x",cmdX,(ClientData)0,exp_deleteProc);
3257 exp_init_sig(void) {
3259 signal(SIGALRM,sigalarm_handler);
3260 signal(SIGINT,sigint_handler);