diff options
Diffstat (limited to 'expect.c')
| -rw-r--r-- | expect.c | 3270 |
1 files changed, 3270 insertions, 0 deletions
diff --git a/expect.c b/expect.c new file mode 100644 index 0000000..73f79c9 --- /dev/null +++ b/expect.c @@ -0,0 +1,3270 @@ +/* expect.c - expect commands + +Written by: Don Libes, NIST, 2/6/90 + +Design and implementation of this program was paid for by U.S. tax +dollars. Therefore it is public domain. However, the author and NIST +would appreciate credit if this program or parts of it are used. + +*/ + +#include <sys/types.h> +#include <stdio.h> +#include <signal.h> +#include <errno.h> +#include <ctype.h> /* for isspace */ +#include <time.h> /* for time(3) */ + +#include "expect_cf.h" + +#ifdef HAVE_SYS_WAIT_H +#include <sys/wait.h> +#endif + +#ifdef HAVE_UNISTD_H +# include <unistd.h> +#endif + +#include "tclInt.h" + +#include "string.h" + +#include "exp_rename.h" +#include "exp_prog.h" +#include "exp_command.h" +#include "exp_log.h" +#include "exp_event.h" +#include "exp_tty_in.h" +#include "exp_tstamp.h" /* this should disappear when interact */ + /* loses ref's to it */ +#ifdef TCL_DEBUGGER +#include "tcldbg.h" +#endif + +#include "retoglob.c" /* RE 2 GLOB translator C variant */ + +/* initial length of strings that we can guarantee patterns can match */ +int exp_default_match_max = 2000; +#define INIT_EXPECT_TIMEOUT_LIT "10" /* seconds */ +#define INIT_EXPECT_TIMEOUT 10 /* seconds */ +int exp_default_parity = TRUE; +int exp_default_rm_nulls = TRUE; +int exp_default_close_on_eof = TRUE; + +/* user variable names */ +#define EXPECT_TIMEOUT "timeout" +#define EXPECT_OUT "expect_out" + +extern int Exp_StringCaseMatch _ANSI_ARGS_((Tcl_UniChar *string, int strlen, + Tcl_UniChar *pattern,int plen, + int nocase,int *offset)); + +typedef struct ThreadSpecificData { + int timeout; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + +/* + * addr of these placeholders appear as clientData in ExpectCmd * when called + * as expect_user and expect_tty. It would be nicer * to invoked + * expDevttyGet() but C doesn't allow this in an array initialization, sigh. + */ +static ExpState StdinoutPlaceholder; +static ExpState DevttyPlaceholder; + +/* 1 ecase struct is reserved for each case in the expect command. Note that + * eof/timeout don't use any of theirs, but the algorithm is simpler this way. + */ + +struct ecase { /* case for expect command */ + struct exp_i *i_list; + Tcl_Obj *pat; /* original pattern spec */ + Tcl_Obj *body; /* ptr to body to be executed upon match */ + Tcl_Obj *gate; /* For PAT_RE, a gate-keeper glob pattern + * which is quicker to match and reduces + * the number of calls into expensive RE + * matching. Optional. + */ +#define PAT_EOF 1 +#define PAT_TIMEOUT 2 +#define PAT_DEFAULT 3 +#define PAT_FULLBUFFER 4 +#define PAT_GLOB 5 /* glob-style pattern list */ +#define PAT_RE 6 /* regular expression */ +#define PAT_EXACT 7 /* exact string */ +#define PAT_NULL 8 /* ASCII 0 */ +#define PAT_TYPES 9 /* used to size array of pattern type descriptions */ + int use; /* PAT_XXX */ + int simple_start; /* offset (chars) from start of buffer denoting where a + * glob or exact match begins */ + int transfer; /* if false, leave matched chars in input stream */ + int indices; /* if true, write indices */ + int iread; /* if true, reread indirects */ + int timestamp; /* if true, write timestamps */ +#define CASE_UNKNOWN 0 +#define CASE_NORM 1 +#define CASE_LOWER 2 + int Case; /* convert case before doing match? */ +}; + +/* descriptions of the pattern types, used for debugging */ +char *pattern_style[PAT_TYPES]; + +struct exp_cases_descriptor { + int count; + struct ecase **cases; +}; + +/* This describes an Expect command */ +static +struct exp_cmd_descriptor { + int cmdtype; /* bg, before, after */ + int duration; /* permanent or temporary */ + int timeout_specified_by_flag; /* if -timeout flag used */ + int timeout; /* timeout period if flag used */ + struct exp_cases_descriptor ecd; + struct exp_i *i_list; +} exp_cmds[4]; + +/* note that exp_cmds[FG] is just a fake, the real contents is stored in some + * dynamically-allocated variable. We use exp_cmds[FG] mostly as a well-known + * address and also as a convenience and so we allocate just a few of its + * fields that we need. + */ + +static void +exp_cmd_init( + struct exp_cmd_descriptor *cmd, + int cmdtype, + int duration) +{ + cmd->duration = duration; + cmd->cmdtype = cmdtype; + cmd->ecd.cases = 0; + cmd->ecd.count = 0; + cmd->i_list = 0; +} + +static int i_read_errno;/* place to save errno, if i_read() == -1, so it + doesn't get overwritten before we get to read it */ + +#ifdef SIMPLE_EVENT +static int alarm_fired; /* if alarm occurs */ +#endif + +void exp_background_channelhandlers_run_all(); + +/* exp_indirect_updateX is called by Tcl when an indirect variable is set */ +static char *exp_indirect_update1( /* 1-part Tcl variable names */ + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + struct exp_i *exp_i); +static char *exp_indirect_update2( /* 2-part Tcl variable names */ + ClientData clientData, + Tcl_Interp *interp, /* Interpreter containing variable. */ + char *name1, /* Name of variable. */ + char *name2, /* Second part of variable name. */ + int flags); /* Information about what happened. */ + +#ifdef SIMPLE_EVENT +/*ARGSUSED*/ +static RETSIGTYPE +sigalarm_handler(int n) /* unused, for compatibility with STDC */ +{ + alarm_fired = TRUE; +} +#endif /*SIMPLE_EVENT*/ + +/* free up everything in ecase */ +static void +free_ecase( + Tcl_Interp *interp, + struct ecase *ec, + int free_ilist) /* if we should free ilist */ +{ + if (ec->i_list->duration == EXP_PERMANENT) { + if (ec->pat) { Tcl_DecrRefCount(ec->pat); } + if (ec->gate) { Tcl_DecrRefCount(ec->gate); } + if (ec->body) { Tcl_DecrRefCount(ec->body); } + } + + if (free_ilist) { + ec->i_list->ecount--; + if (ec->i_list->ecount == 0) { + exp_free_i(interp,ec->i_list,exp_indirect_update2); + } + } + + ckfree((char *)ec); /* NEW */ +} + +/* free up any argv structures in the ecases */ +static void +free_ecases( + Tcl_Interp *interp, + struct exp_cmd_descriptor *eg, + int free_ilist) /* if true, free ilists */ +{ + int i; + + if (!eg->ecd.cases) return; + + for (i=0;i<eg->ecd.count;i++) { + free_ecase(interp,eg->ecd.cases[i],free_ilist); + } + ckfree((char *)eg->ecd.cases); + + eg->ecd.cases = 0; + eg->ecd.count = 0; +} + + +#if 0 +/* no standard defn for this, and some systems don't even have it, so avoid */ +/* the whole quagmire by calling it something else */ +static char *exp_strdup(char *s) +{ + char *news = ckalloc(strlen(s) + 1); + strcpy(news,s); + return(news); +} +#endif + +/* return TRUE if string appears to be a set of arguments + The intent of this test is to support the ability of commands to have + all their args braced as one. This conflicts with the possibility of + actually intending to have a single argument. + The bad case is in expect which can have a single argument with embedded + \n's although it's rare. Examples that this code should handle: + \n FALSE (pattern) + \n\n FALSE + \n \n \n FALSE + foo FALSE + foo\n FALSE + \nfoo\n TRUE (set of args) + \nfoo\nbar TRUE + + Current test is very cheap and almost always right :-) +*/ +int +exp_one_arg_braced(Tcl_Obj *objPtr) /* INTL */ +{ + int seen_nl = FALSE; + char *p = Tcl_GetString(objPtr); + + for (;*p;p++) { + if (*p == '\n') { + seen_nl = TRUE; + continue; + } + + if (!isspace(*p)) { /* INTL: ISO space */ + return(seen_nl); + } + } + return FALSE; +} + +/* called to execute a command of only one argument - a hack to commands */ +/* to be called with all args surrounded by an outer set of braces */ +/* Returns a list object containing the new set of arguments */ +/* Caller then has to either reinvoke itself, or better, simply replace + * its current argumnts */ +/*ARGSUSED*/ +Tcl_Obj* +exp_eval_with_one_arg( + ClientData clientData, + Tcl_Interp *interp, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + Tcl_Obj* res = Tcl_NewListObj (1,objv); + +#define NUM_STATIC_OBJS 20 + Tcl_Token *tokenPtr; + CONST char *p; + CONST char *next; + int rc; + int bytesLeft, numWords; + Tcl_Parse parse; + + /* + * Prepend the command name and the -nobrace switch so we can + * reinvoke without recursing. + */ + + Tcl_ListObjAppendElement (interp, res, Tcl_NewStringObj("-nobrace", -1)); + + p = Tcl_GetStringFromObj(objv[1], &bytesLeft); + + /* + * Treat the pattern/action block like a series of Tcl commands. + * For each command, parse the command words, perform substititions + * on each word, and add the words to an array of values. We don't + * actually evaluate the individual commands, just the substitutions. + */ + + do { + if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) + != TCL_OK) { + rc = TCL_ERROR; + goto done; + } + numWords = parse.numWords; + if (numWords > 0) { + /* + * Generate an array of objects for the words of the command. + */ + + /* + * For each word, perform substitutions then store the + * result in the objs array. + */ + + for (tokenPtr = parse.tokenPtr; numWords > 0; + numWords--, tokenPtr += (tokenPtr->numComponents + 1)) { + /* FUTURE: Save token information, do substitution later */ + + Tcl_Obj* w = Tcl_EvalTokens(interp, tokenPtr+1, + tokenPtr->numComponents); + /* w has refCount 1 here, if not NULL */ + if (w == NULL) { + Tcl_DecrRefCount (res); + res = NULL; + goto done; + + } + Tcl_ListObjAppendElement (interp, res, w); + Tcl_DecrRefCount (w); /* Local reference goes away */ + } + } + + /* + * Advance to the next command in the script. + */ + next = parse.commandStart + parse.commandSize; + bytesLeft -= next - p; + p = next; + Tcl_FreeParse(&parse); + } while (bytesLeft > 0); + + done: + return res; +} + +static void +ecase_clear(struct ecase *ec) +{ + ec->i_list = 0; + ec->pat = 0; + ec->body = 0; + ec->transfer = TRUE; + ec->simple_start = 0; + ec->indices = FALSE; + ec->iread = FALSE; + ec->timestamp = FALSE; + ec->Case = CASE_NORM; + ec->use = PAT_GLOB; + ec->gate = NULL; +} + +static struct ecase * +ecase_new(void) +{ + struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase)); + + ecase_clear(ec); + return ec; +} + +/* + +parse_expect_args parses the arguments to expect or its variants. +It normally returns TCL_OK, and returns TCL_ERROR for failure. +(It can't return i_list directly because there is no way to differentiate +between clearing, say, expect_before and signalling an error.) + +eg (expect_global) is initialized to reflect the arguments parsed +eg->ecd.cases is an array of ecases +eg->ecd.count is the # of ecases +eg->i_list is a linked list of exp_i's which represent the -i info + +Each exp_i is chained to the next so that they can be easily free'd if +necessary. Each exp_i has a reference count. If the -i is not used +(e.g., has no following patterns), the ref count will be 0. + +Each ecase points to an exp_i. Several ecases may point to the same exp_i. +Variables named by indirect exp_i's are read for the direct values. + +If called from a foreground expect and no patterns or -i are given, a +default exp_i is forced so that the command "expect" works right. + +The exp_i chain can be broken by the caller if desired. + +*/ + +static int +parse_expect_args( + Tcl_Interp *interp, + struct exp_cmd_descriptor *eg, + ExpState *default_esPtr, /* suggested ExpState if called as expect_user or _tty */ + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int i; + char *string; + struct ecase ec; /* temporary to collect args */ + + eg->timeout_specified_by_flag = FALSE; + + ecase_clear(&ec); + + /* Allocate an array to store the ecases. Force array even if 0 */ + /* cases. This will often be too large (i.e., if there are flags) */ + /* but won't affect anything. */ + + eg->ecd.cases = (struct ecase **)ckalloc(sizeof(struct ecase *) * (1+(objc/2))); + + eg->ecd.count = 0; + + for (i = 1;i<objc;i++) { + int index; + string = Tcl_GetString(objv[i]); + if (string[0] == '-') { + static char *flags[] = { + "-glob", "-regexp", "-exact", "-notransfer", "-nocase", + "-i", "-indices", "-iread", "-timestamp", "-timeout", + "-nobrace", "--", (char *)0 + }; + enum flags { + EXP_ARG_GLOB, EXP_ARG_REGEXP, EXP_ARG_EXACT, + EXP_ARG_NOTRANSFER, EXP_ARG_NOCASE, EXP_ARG_SPAWN_ID, + EXP_ARG_INDICES, EXP_ARG_IREAD, EXP_ARG_TIMESTAMP, + EXP_ARG_DASH_TIMEOUT, EXP_ARG_NOBRACE, EXP_ARG_DASH + }; + + /* + * Allow abbreviations of switches and report an error if we + * get an invalid switch. + */ + + if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum flags) index) { + case EXP_ARG_GLOB: + case EXP_ARG_DASH: + i++; + /* assignment here is not actually necessary */ + /* since cases are initialized this way above */ + /* ec.use = PAT_GLOB; */ + if (i >= objc) { + Tcl_WrongNumArgs(interp, 1, objv,"-glob pattern"); + return TCL_ERROR; + } + goto pattern; + case EXP_ARG_REGEXP: + i++; + if (i >= objc) { + Tcl_WrongNumArgs(interp, 1, objv,"-regexp regexp"); + return TCL_ERROR; + } + ec.use = PAT_RE; + + /* + * Try compiling the expression so we can report + * any errors now rather then when we first try to + * use it. + */ + + if (!(Tcl_GetRegExpFromObj(interp, objv[i], + TCL_REG_ADVANCED))) { + goto error; + } + + /* Derive a gate keeper glob pattern which reduces the amount + * of RE matching. + */ + + { + Tcl_Obj* g; + Tcl_UniChar* str; + int strlen; + + str = Tcl_GetUnicodeFromObj (objv[i], &strlen); + g = exp_retoglob (str, strlen); + + if (g) { + ec.gate = g; + + expDiagLog("Gate keeper glob pattern for '%s'",Tcl_GetString(objv[i])); + expDiagLog(" is '%s'. Activating booster.\n",Tcl_GetString(g)); + } else { + /* Ignore errors, fall back to regular RE matching */ + expDiagLog("Gate keeper glob pattern for '%s'",Tcl_GetString(objv[i])); + expDiagLog(" is '%s'. Not usable, disabling the",Tcl_GetString(Tcl_GetObjResult (interp))); + expDiagLog(" performance booster.\n"); + } + } + + goto pattern; + case EXP_ARG_EXACT: + i++; + if (i >= objc) { + Tcl_WrongNumArgs(interp, 1, objv, "-exact string"); + return TCL_ERROR; + } + ec.use = PAT_EXACT; + goto pattern; + case EXP_ARG_NOTRANSFER: + ec.transfer = 0; + break; + case EXP_ARG_NOCASE: + ec.Case = CASE_LOWER; + break; + case EXP_ARG_SPAWN_ID: + i++; + if (i>=objc) { + Tcl_WrongNumArgs(interp, 1, objv, "-i spawn_id"); + goto error; + } + ec.i_list = exp_new_i_complex(interp, + Tcl_GetString(objv[i]), + eg->duration, exp_indirect_update2); + if (!ec.i_list) goto error; + ec.i_list->cmdtype = eg->cmdtype; + + /* link new i_list to head of list */ + ec.i_list->next = eg->i_list; + eg->i_list = ec.i_list; + break; + case EXP_ARG_INDICES: + ec.indices = TRUE; + break; + case EXP_ARG_IREAD: + ec.iread = TRUE; + break; + case EXP_ARG_TIMESTAMP: + ec.timestamp = TRUE; + break; + case EXP_ARG_DASH_TIMEOUT: + i++; + if (i>=objc) { + Tcl_WrongNumArgs(interp, 1, objv, "-timeout seconds"); + goto error; + } + if (Tcl_GetIntFromObj(interp, objv[i], + &eg->timeout) != TCL_OK) { + goto error; + } + eg->timeout_specified_by_flag = TRUE; + break; + case EXP_ARG_NOBRACE: + /* nobrace does nothing but take up space */ + /* on the command line which prevents */ + /* us from re-expanding any command lines */ + /* of one argument that looks like it should */ + /* be expanded to multiple arguments. */ + break; + } + /* + * Keep processing arguments, we aren't ready for the + * pattern yet. + */ + continue; + } else { + /* + * We have a pattern or keyword. + */ + + static char *keywords[] = { + "timeout", "eof", "full_buffer", "default", "null", + (char *)NULL + }; + enum keywords { + EXP_ARG_TIMEOUT, EXP_ARG_EOF, EXP_ARG_FULL_BUFFER, + EXP_ARG_DEFAULT, EXP_ARG_NULL + }; + + /* + * Match keywords exactly, otherwise they are patterns. + */ + + if (Tcl_GetIndexFromObj(interp, objv[i], keywords, "keyword", + 1 /* exact */, &index) != TCL_OK) { + Tcl_ResetResult(interp); + goto pattern; + } + switch ((enum keywords) index) { + case EXP_ARG_TIMEOUT: + ec.use = PAT_TIMEOUT; + break; + case EXP_ARG_EOF: + ec.use = PAT_EOF; + break; + case EXP_ARG_FULL_BUFFER: + ec.use = PAT_FULLBUFFER; + break; + case EXP_ARG_DEFAULT: + ec.use = PAT_DEFAULT; + break; + case EXP_ARG_NULL: + ec.use = PAT_NULL; + break; + } +pattern: + /* if no -i, use previous one */ + if (!ec.i_list) { + /* if no -i flag has occurred yet, use default */ + if (!eg->i_list) { + if (default_esPtr != EXP_SPAWN_ID_BAD) { + eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); + } else { + default_esPtr = expStateCurrent(interp,0,0,1); + if (!default_esPtr) goto error; + eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); + } + } + ec.i_list = eg->i_list; + } + ec.i_list->ecount++; + + /* save original pattern spec */ + /* keywords such as "-timeout" are saved as patterns here */ + /* useful for debugging but not otherwise used */ + + ec.pat = objv[i]; + if (eg->duration == EXP_PERMANENT) { + Tcl_IncrRefCount(ec.pat); + if (ec.gate) { + Tcl_IncrRefCount(ec.gate); + } + } + + i++; + if (i < objc) { + ec.body = objv[i]; + if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.body); + } else { + ec.body = NULL; + } + + *(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec; + + /* clear out for next set */ + ecase_clear(&ec); + + eg->ecd.count++; + } + } + + /* if no patterns at all have appeared force the current */ + /* spawn id to be added to list anyway */ + + if (eg->i_list == 0) { + if (default_esPtr != EXP_SPAWN_ID_BAD) { + eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); + } else { + default_esPtr = expStateCurrent(interp,0,0,1); + if (!default_esPtr) goto error; + eg->i_list = exp_new_i_simple(default_esPtr,eg->duration); + } + } + + return(TCL_OK); + + error: + /* very hard to free case_master_list here if it hasn't already */ + /* been attached to a case, ugh */ + + /* note that i_list must be avail to free ecases! */ + free_ecases(interp,eg,0); + + if (eg->i_list) + exp_free_i(interp,eg->i_list,exp_indirect_update2); + return(TCL_ERROR); +} + +#define EXP_IS_DEFAULT(x) ((x) == EXP_TIMEOUT || (x) == EXP_EOF) + +static char yes[] = "yes\r\n"; +static char no[] = "no\r\n"; + +/* this describes status of a successful match */ +struct eval_out { + struct ecase *e; /* ecase that matched */ + ExpState *esPtr; /* ExpState that matched */ + Tcl_UniChar* matchbuf; /* Buffer that matched, */ + int matchlen; /* and #chars that matched, or + * #chars in buffer at EOF */ + /* This points into the esPtr->input.buffer ! */ +}; + + + + +/* + *---------------------------------------------------------------------- + * + * string_case_first -- + * + * Find the first instance of a pattern in a string. + * + * Results: + * Returns the pointer to the first instance of the pattern + * in the given string, or NULL if no match was found. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_UniChar * +string_case_first( /* INTL */ + register Tcl_UniChar *string, /* String (unicode). */ + int length, /* length of above string */ + register char *pattern) /* Pattern, which may contain + * special characters (utf8). */ +{ + Tcl_UniChar *s; + char *p; + int offset; + register int consumed = 0; + Tcl_UniChar ch1, ch2; + Tcl_UniChar *bufend = string + length; + + while ((*string != 0) && (string < bufend)) { + s = string; + p = pattern; + while ((*s) && (s < bufend)) { + ch1 = *s++; + consumed++; + offset = TclUtfToUniChar(p, &ch2); + if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { + break; + } + p += offset; + } + if (*p == '\0') { + return string; + } + string++; + consumed++; + } + return NULL; +} + +Tcl_UniChar * +string_first( /* INTL */ + register Tcl_UniChar *string, /* String (unicode). */ + int length, /* length of above string */ + register char *pattern) /* Pattern, which may contain + * special characters (utf8). */ +{ + Tcl_UniChar *s; + char *p; + int offset; + register int consumed = 0; + Tcl_UniChar ch1, ch2; + Tcl_UniChar *bufend = string + length; + + while ((*string != 0) && (string < bufend)) { + s = string; + p = pattern; + while ((*s) && (s < bufend)) { + ch1 = *s++; + consumed++; + offset = TclUtfToUniChar(p, &ch2); + if (ch1 != ch2) { + break; + } + p += offset; + } + if (*p == '\0') { + return string; + } + string++; + consumed++; + } + return NULL; +} + +Tcl_UniChar * +string_first_char( /* INTL */ + register Tcl_UniChar *string, /* String. */ + register Tcl_UniChar pattern) +{ + /* unicode based Tcl_UtfFindFirst */ + + Tcl_UniChar find; + + while (1) { + find = *string; + if (find == pattern) { + return string; + } + if (*string == '\0') { + return NULL; + } + string ++; + } + return NULL; +} + +/* like eval_cases, but handles only a single cases that needs a real */ +/* string match */ +/* returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCLERRROR */ +static int +eval_case_string( + Tcl_Interp *interp, + struct ecase *e, + ExpState *esPtr, + struct eval_out *o, /* 'output' - i.e., final case of interest */ +/* next two args are for debugging, when they change, reprint buffer */ + ExpState **last_esPtr, + int *last_case, + char *suffix) +{ + Tcl_RegExp re; + Tcl_RegExpInfo info; + Tcl_Obj* buf; + Tcl_UniChar *str; + int numchars, flags, dummy, globmatch; + int result; + + str = esPtr->input.buffer; + numchars = esPtr->input.use; + + /* if ExpState or case changed, redisplay debug-buffer */ + if ((esPtr != *last_esPtr) || e->Case != *last_case) { + expDiagLog("\r\nexpect%s: does \"",suffix); + expDiagLogU(expPrintifyUni(str,numchars)); + expDiagLog("\" (spawn_id %s) match %s ",esPtr->name,pattern_style[e->use]); + *last_esPtr = esPtr; + *last_case = e->Case; + } + + if (e->use == PAT_RE) { + expDiagLog("\""); + expDiagLogU(expPrintify(Tcl_GetString(e->pat))); + expDiagLog("\"? "); + + if (e->gate) { + int plen; + Tcl_UniChar* pat = Tcl_GetUnicodeFromObj(e->gate,&plen); + + expDiagLog("Gate \""); + expDiagLogU(expPrintify(Tcl_GetString(e->gate))); + expDiagLog("\"? gate="); + + globmatch = Exp_StringCaseMatch(str, numchars, pat, plen, + (e->Case == CASE_NORM) ? 0 : 1, + &dummy); + } else { + expDiagLog("(No Gate, RE only) gate="); + + /* No gate => RE matching always */ + globmatch = 1; + } + if (globmatch < 0) { + expDiagLogU(no); + /* i.e. no match */ + } else { + expDiagLog("yes re="); + + if (e->Case == CASE_NORM) { + flags = TCL_REG_ADVANCED; + } else { + flags = TCL_REG_ADVANCED | TCL_REG_NOCASE; + } + + re = Tcl_GetRegExpFromObj(interp, e->pat, flags); + + /* ZZZ: Future optimization: Avoid copying */ + buf = Tcl_NewUnicodeObj (str, numchars); + Tcl_IncrRefCount (buf); + result = Tcl_RegExpExecObj(interp, re, buf, 0 /* offset */, + -1 /* nmatches */, 0 /* eflags */); + Tcl_DecrRefCount (buf); + if (result > 0) { + o->e = e; + + /* + * Retrieve the byte offset of the end of the + * matched string. + */ + + Tcl_RegExpGetInfo(re, &info); + o->matchlen = info.matches[0].end; + o->matchbuf = str; + o->esPtr = esPtr; + expDiagLogU(yes); + return(EXP_MATCH); + } else if (result == 0) { + expDiagLogU(no); + } else { /* result < 0 */ + return(EXP_TCLERROR); + } + } + } else if (e->use == PAT_GLOB) { + int match; /* # of chars that matched */ + + expDiagLog("\""); + expDiagLogU(expPrintify(Tcl_GetString(e->pat))); + expDiagLog("\"? "); + if (str) { + int plen; + Tcl_UniChar* pat = Tcl_GetUnicodeFromObj(e->pat,&plen); + + match = Exp_StringCaseMatch(str,numchars, pat, plen, + (e->Case == CASE_NORM) ? 0 : 1, + &e->simple_start); + if (match != -1) { + o->e = e; + o->matchlen = match; + o->matchbuf = str; + o->esPtr = esPtr; + expDiagLogU(yes); + return(EXP_MATCH); + } + } + expDiagLogU(no); + } else if (e->use == PAT_EXACT) { + int patLength; + char *pat = Tcl_GetStringFromObj(e->pat, &patLength); + Tcl_UniChar *p; + + if (e->Case == CASE_NORM) { + p = string_first(str, numchars, pat); /* NEW function in this file, see above */ + } else { + p = string_case_first(str, numchars, pat); + } + + expDiagLog("\""); + expDiagLogU(expPrintify(Tcl_GetString(e->pat))); + expDiagLog("\"? "); + if (p) { + /* Bug 3095935. Go from #bytes to #chars */ + patLength = Tcl_NumUtfChars (pat, patLength); + + e->simple_start = p - str; + o->e = e; + o->matchlen = patLength; + o->matchbuf = str; + o->esPtr = esPtr; + expDiagLogU(yes); + return(EXP_MATCH); + } else expDiagLogU(no); + } else if (e->use == PAT_NULL) { + CONST Tcl_UniChar *p; + expDiagLogU("null? "); + p = string_first_char (str, 0); /* NEW function in this file, see above */ + + if (p) { + o->e = e; + o->matchlen = p-str; /* #chars */ + o->matchbuf = str; + o->esPtr = esPtr; + expDiagLogU(yes); + return EXP_MATCH; + } + expDiagLogU(no); + } else if (e->use == PAT_FULLBUFFER) { + expDiagLogU(Tcl_GetString(e->pat)); + expDiagLogU("? "); + /* this must be the same test as in expIRead */ + /* We drop one third when are at least 2/3 full */ + /* condition is (size >= max*2/3) <=> (size*3 >= max*2) */ + if (((expSizeGet(esPtr)*3) >= (esPtr->input.max*2)) && (numchars > 0)) { + o->e = e; + o->matchlen = numchars; + o->matchbuf = str; + o->esPtr = esPtr; + expDiagLogU(yes); + return(EXP_FULLBUFFER); + } else { + expDiagLogU(no); + } + } + return(EXP_NOMATCH); +} + +/* sets o.e if successfully finds a matching pattern, eof, timeout or deflt */ +/* returns original status arg or EXP_TCLERROR */ +static int +eval_cases( + Tcl_Interp *interp, + struct exp_cmd_descriptor *eg, + ExpState *esPtr, + struct eval_out *o, /* 'output' - i.e., final case of interest */ +/* next two args are for debugging, when they change, reprint buffer */ + ExpState **last_esPtr, + int *last_case, + int status, + ExpState *(esPtrs[]), + int mcount, + char *suffix) +{ + int i; + ExpState *em; /* ExpState of ecase */ + struct ecase *e; + + if (o->e || status == EXP_TCLERROR || eg->ecd.count == 0) return(status); + + if (status == EXP_TIMEOUT) { + for (i=0;i<eg->ecd.count;i++) { + e = eg->ecd.cases[i]; + if (e->use == PAT_TIMEOUT || e->use == PAT_DEFAULT) { + o->e = e; + break; + } + } + return(status); + } else if (status == EXP_EOF) { + for (i=0;i<eg->ecd.count;i++) { + e = eg->ecd.cases[i]; + if (e->use == PAT_EOF || e->use == PAT_DEFAULT) { + struct exp_state_list *slPtr; + + for (slPtr=e->i_list->state_list; slPtr ;slPtr=slPtr->next) { + em = slPtr->esPtr; + if (expStateAnyIs(em) || em == esPtr) { + o->e = e; + return(status); + } + } + } + } + return(status); + } + + /* the top loops are split from the bottom loop only because I can't */ + /* split'em further. */ + + /* The bufferful condition does not prevent a pattern match from */ + /* occurring and vice versa, so it is scanned with patterns */ + for (i=0;i<eg->ecd.count;i++) { + struct exp_state_list *slPtr; + int j; + + e = eg->ecd.cases[i]; + if (e->use == PAT_TIMEOUT || + e->use == PAT_DEFAULT || + e->use == PAT_EOF) continue; + + for (slPtr = e->i_list->state_list; slPtr; slPtr = slPtr->next) { + em = slPtr->esPtr; + /* if em == EXP_SPAWN_ID_ANY, then user is explicitly asking */ + /* every case to be checked against every ExpState */ + if (expStateAnyIs(em)) { + /* test against each spawn_id */ + for (j=0;j<mcount;j++) { + status = eval_case_string(interp,e,esPtrs[j],o, + last_esPtr,last_case,suffix); + if (status != EXP_NOMATCH) return(status); + } + } else { + /* reject things immediately from wrong spawn_id */ + if (em != esPtr) continue; + + status = eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix); + if (status != EXP_NOMATCH) return(status); + } + } + } + return(EXP_NOMATCH); +} + +static void +ecases_remove_by_expi( + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + struct exp_i *exp_i) +{ + int i; + + /* delete every ecase dependent on it */ + for (i=0;i<ecmd->ecd.count;) { + struct ecase *e = ecmd->ecd.cases[i]; + if (e->i_list == exp_i) { + free_ecase(interp,e,0); + + /* shift remaining elements down */ + /* but only if there are any left */ + if (i+1 != ecmd->ecd.count) { + memcpy(&ecmd->ecd.cases[i], + &ecmd->ecd.cases[i+1], + ((ecmd->ecd.count - i) - 1) * + sizeof(struct exp_cmd_descriptor *)); + } + ecmd->ecd.count--; + if (0 == ecmd->ecd.count) { + ckfree((char *)ecmd->ecd.cases); + ecmd->ecd.cases = 0; + } + } else { + i++; + } + } +} + +/* remove exp_i from list */ +static void +exp_i_remove( + Tcl_Interp *interp, + struct exp_i **ei, /* list to remove from */ + struct exp_i *exp_i) /* element to remove */ +{ + /* since it's in middle of list, free exp_i by hand */ + for (;*ei; ei = &(*ei)->next) { + if (*ei == exp_i) { + *ei = exp_i->next; + exp_i->next = 0; + exp_free_i(interp,exp_i,exp_indirect_update2); + break; + } + } +} + +/* remove exp_i from list and remove any dependent ecases */ +static void +exp_i_remove_with_ecases( + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + struct exp_i *exp_i) +{ + ecases_remove_by_expi(interp,ecmd,exp_i); + exp_i_remove(interp,&ecmd->i_list,exp_i); +} + +/* remove ecases tied to a single direct spawn id */ +static void +ecmd_remove_state( + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + ExpState *esPtr, + int direct) +{ + struct exp_i *exp_i, *next; + struct exp_state_list **slPtr; + + for (exp_i=ecmd->i_list;exp_i;exp_i=next) { + next = exp_i->next; + + if (!(direct & exp_i->direct)) continue; + + for (slPtr = &exp_i->state_list;*slPtr;) { + if (esPtr == ((*slPtr)->esPtr)) { + struct exp_state_list *tmp = *slPtr; + *slPtr = (*slPtr)->next; + exp_free_state_single(tmp); + + /* if last bg ecase, disarm spawn id */ + if ((ecmd->cmdtype == EXP_CMD_BG) && (!expStateAnyIs(esPtr))) { + esPtr->bg_ecount--; + if (esPtr->bg_ecount == 0) { + exp_disarm_background_channelhandler(esPtr); + esPtr->bg_interp = 0; + } + } + + continue; + } + slPtr = &(*slPtr)->next; + } + + /* if left with no ExpStates (and is direct), get rid of it */ + /* and any dependent ecases */ + if (exp_i->direct == EXP_DIRECT && !exp_i->state_list) { + exp_i_remove_with_ecases(interp,ecmd,exp_i); + } + } +} + +/* this is called from exp_close to clean up the ExpState */ +void +exp_ecmd_remove_state_direct_and_indirect( + Tcl_Interp *interp, + ExpState *esPtr) +{ + ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BEFORE],esPtr,EXP_DIRECT|EXP_INDIRECT); + ecmd_remove_state(interp,&exp_cmds[EXP_CMD_AFTER],esPtr,EXP_DIRECT|EXP_INDIRECT); + ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BG],esPtr,EXP_DIRECT|EXP_INDIRECT); + + /* force it - explanation in exp_tk.c where this func is defined */ + exp_disarm_background_channelhandler_force(esPtr); +} + +/* arm a list of background ExpState's */ +static void +state_list_arm( + Tcl_Interp *interp, + struct exp_state_list *slPtr) +{ + /* for each spawn id in list, arm if necessary */ + for (;slPtr;slPtr=slPtr->next) { + ExpState *esPtr = slPtr->esPtr; + if (expStateAnyIs(esPtr)) continue; + + if (esPtr->bg_ecount == 0) { + exp_arm_background_channelhandler(esPtr); + esPtr->bg_interp = interp; + } + esPtr->bg_ecount++; + } +} + +/* return TRUE if this ecase is used by this fd */ +static int +exp_i_uses_state( + struct exp_i *exp_i, + ExpState *esPtr) +{ + struct exp_state_list *fdp; + + for (fdp = exp_i->state_list;fdp;fdp=fdp->next) { + if (fdp->esPtr == esPtr) return 1; + } + return 0; +} + +static void +ecase_append( + Tcl_Interp *interp, + struct ecase *ec) +{ + if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer"); + if (ec->indices) Tcl_AppendElement(interp,"-indices"); + if (!ec->Case) Tcl_AppendElement(interp,"-nocase"); + + if (ec->use == PAT_RE) Tcl_AppendElement(interp,"-re"); + else if (ec->use == PAT_GLOB) Tcl_AppendElement(interp,"-gl"); + else if (ec->use == PAT_EXACT) Tcl_AppendElement(interp,"-ex"); + Tcl_AppendElement(interp,Tcl_GetString(ec->pat)); + Tcl_AppendElement(interp,ec->body?Tcl_GetString(ec->body):""); +} + +/* append all ecases that match this exp_i */ +static void +ecase_by_exp_i_append( + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + struct exp_i *exp_i) +{ + int i; + for (i=0;i<ecmd->ecd.count;i++) { + if (ecmd->ecd.cases[i]->i_list == exp_i) { + ecase_append(interp,ecmd->ecd.cases[i]); + } + } +} + +static void +exp_i_append( + Tcl_Interp *interp, + struct exp_i *exp_i) +{ + Tcl_AppendElement(interp,"-i"); + if (exp_i->direct == EXP_INDIRECT) { + Tcl_AppendElement(interp,exp_i->variable); + } else { + struct exp_state_list *fdp; + + /* if more than one element, add braces */ + if (exp_i->state_list->next) { + Tcl_AppendResult(interp," {",(char *)0); + } + + for (fdp = exp_i->state_list;fdp;fdp=fdp->next) { + char buf[25]; /* big enough for a small int */ + sprintf(buf,"%ld", (long)fdp->esPtr); + Tcl_AppendElement(interp,buf); + } + + if (exp_i->state_list->next) { + Tcl_AppendResult(interp,"} ",(char *)0); + } +} +} + +/* return current setting of the permanent expect_before/after/bg */ +int +expect_info( + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + struct exp_i *exp_i; + int i; + int direct = EXP_DIRECT|EXP_INDIRECT; + char *iflag = 0; + int all = FALSE; /* report on all fds */ + ExpState *esPtr = 0; + + static char *flags[] = {"-i", "-all", "-noindirect", (char *)0}; + enum flags {EXP_ARG_I, EXP_ARG_ALL, EXP_ARG_NOINDIRECT}; + + /* start with 2 to skip over "cmdname -info" */ + for (i = 2;i<objc;i++) { + /* + * Allow abbreviations of switches and report an error if we + * get an invalid switch. + */ + + int index; + if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum flags) index) { + case EXP_ARG_I: + i++; + if (i >= objc) { + Tcl_WrongNumArgs(interp, 1, objv,"-i spawn_id"); + return TCL_ERROR; + } + break; + case EXP_ARG_ALL: + all = TRUE; + break; + case EXP_ARG_NOINDIRECT: + direct &= ~EXP_INDIRECT; + break; + } + } + + if (all) { + /* avoid printing out -i when redundant */ + struct exp_i *previous = 0; + + for (i=0;i<ecmd->ecd.count;i++) { + if (previous != ecmd->ecd.cases[i]->i_list) { + exp_i_append(interp,ecmd->ecd.cases[i]->i_list); + previous = ecmd->ecd.cases[i]->i_list; + } + ecase_append(interp,ecmd->ecd.cases[i]); + } + return TCL_OK; + } + + if (!iflag) { + if (!(esPtr = expStateCurrent(interp,0,0,0))) { + return TCL_ERROR; + } + } else if (!(esPtr = expStateFromChannelName(interp,iflag,0,0,0,"dummy"))) { + /* not a valid ExpState so assume it is an indirect variable */ + Tcl_ResetResult(interp); + for (i=0;i<ecmd->ecd.count;i++) { + if (ecmd->ecd.cases[i]->i_list->direct == EXP_INDIRECT && + streq(ecmd->ecd.cases[i]->i_list->variable,iflag)) { + ecase_append(interp,ecmd->ecd.cases[i]); + } + } + return TCL_OK; + } + + /* print ecases of this direct_fd */ + for (exp_i=ecmd->i_list;exp_i;exp_i=exp_i->next) { + if (!(direct & exp_i->direct)) continue; + if (!exp_i_uses_state(exp_i,esPtr)) continue; + ecase_by_exp_i_append(interp,ecmd,exp_i); + } + + return TCL_OK; +} + +/* Exp_ExpectGlobalObjCmd is invoked to process expect_before/after/background */ +/*ARGSUSED*/ +int +Exp_ExpectGlobalObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int result = TCL_OK; + struct exp_i *exp_i, **eip; + struct exp_state_list *slPtr; /* temp for interating over state_list */ + struct exp_cmd_descriptor eg; + int count; + Tcl_Obj* new_cmd = NULL; + + struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData; + + if ((objc == 2) && exp_one_arg_braced(objv[1])) { + /* expect {...} */ + + new_cmd = exp_eval_with_one_arg(clientData,interp,objv); + if (!new_cmd) return TCL_ERROR; + } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { + /* expect -brace {...} ... fake command line for reparsing */ + + Tcl_Obj *new_objv[2]; + new_objv[0] = objv[0]; + new_objv[1] = objv[2]; + + new_cmd = exp_eval_with_one_arg(clientData,interp,new_objv); + if (!new_cmd) return TCL_ERROR; + } + + if (new_cmd) { + /* Replace old arguments with result of the reparse */ + Tcl_ListObjGetElements (interp, new_cmd, &objc, (Tcl_Obj***) &objv); + } + + if (objc > 1 && (Tcl_GetString(objv[1])[0] == '-')) { + if (exp_flageq("info",Tcl_GetString(objv[1])+1,4)) { + int res = expect_info(interp,ecmd,objc,objv); + if (new_cmd) { Tcl_DecrRefCount (new_cmd); } + return res; + } + } + + exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT); + + if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD, + objc,objv)) { + if (new_cmd) { Tcl_DecrRefCount (new_cmd); } + return TCL_ERROR; + } + + /* + * visit each NEW direct exp_i looking for spawn ids. + * When found, remove them from any OLD exp_i's. + */ + + /* visit each exp_i */ + for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) { + if (exp_i->direct == EXP_INDIRECT) continue; + /* for each spawn id, remove it from ecases */ + for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { + ExpState *esPtr = slPtr->esPtr; + + /* validate all input descriptors */ + if (!expStateAnyIs(esPtr)) { + if (!expStateCheck(interp,esPtr,1,1,"expect")) { + result = TCL_ERROR; + goto cleanup; + } + } + + /* remove spawn id from exp_i */ + ecmd_remove_state(interp,ecmd,esPtr,EXP_DIRECT); + } + } + + /* + * For each indirect variable, release its old ecases and + * clean up the matching spawn ids. + * Same logic as in "expect_X delete" command. + */ + + for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) { + struct exp_i **old_i; + + if (exp_i->direct == EXP_DIRECT) continue; + + for (old_i = &ecmd->i_list;*old_i;) { + struct exp_i *tmp; + + if (((*old_i)->direct == EXP_DIRECT) || + (!streq((*old_i)->variable,exp_i->variable))) { + old_i = &(*old_i)->next; + continue; + } + + ecases_remove_by_expi(interp,ecmd,*old_i); + + /* unlink from middle of list */ + tmp = *old_i; + *old_i = tmp->next; + tmp->next = 0; + exp_free_i(interp,tmp,exp_indirect_update2); + } + + /* if new one has ecases, update it */ + if (exp_i->ecount) { + /* Note: The exp_indirect_ functions are Tcl_VarTraceProc's, and + * are used as such in other places of Expect. We cannot use a + * Tcl_Obj* as return value :( + */ + char *msg = exp_indirect_update1(interp,ecmd,exp_i); + if (msg) { + /* unusual way of handling error return */ + /* because of Tcl's variable tracing */ + Tcl_SetResult (interp, msg, TCL_VOLATILE); + result = TCL_ERROR; + goto indirect_update_abort; + } + } + } + /* empty i_lists have to be removed from global eg.i_list */ + /* before returning, even if during error */ + indirect_update_abort: + + /* + * New exp_i's that have 0 ecases indicate fd/vars to be deleted. + * Now that the deletions have been done, discard the new exp_i's. + */ + + for (exp_i=eg.i_list;exp_i;) { + struct exp_i *next = exp_i->next; + + if (exp_i->ecount == 0) { + exp_i_remove(interp,&eg.i_list,exp_i); + } + exp_i = next; + } + if (result == TCL_ERROR) goto cleanup; + + /* + * arm all new bg direct fds + */ + + if (ecmd->cmdtype == EXP_CMD_BG) { + for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) { + if (exp_i->direct == EXP_DIRECT) { + state_list_arm(interp,exp_i->state_list); + } + } + } + + /* + * now that old ecases are gone, add new ecases and exp_i's (both + * direct and indirect). + */ + + /* append ecases */ + + count = ecmd->ecd.count + eg.ecd.count; + if (eg.ecd.count) { + int start_index; /* where to add new ecases in old list */ + + if (ecmd->ecd.count) { + /* append to end */ + ecmd->ecd.cases = (struct ecase **)ckrealloc((char *)ecmd->ecd.cases, count * sizeof(struct ecase *)); + start_index = ecmd->ecd.count; + } else { + /* append to beginning */ + ecmd->ecd.cases = (struct ecase **)ckalloc(eg.ecd.count * sizeof(struct ecase *)); + start_index = 0; + } + memcpy(&ecmd->ecd.cases[start_index],eg.ecd.cases, + eg.ecd.count*sizeof(struct ecase *)); + ecmd->ecd.count = count; + } + + /* append exp_i's */ + for (eip = &ecmd->i_list;*eip;eip = &(*eip)->next) { + /* empty loop to get to end of list */ + } + /* *exp_i now points to end of list */ + + *eip = eg.i_list; /* connect new list to end of current list */ + + cleanup: + if (result == TCL_ERROR) { + /* in event of error, free any unreferenced ecases */ + /* but first, split up i_list so that exp_i's aren't */ + /* freed twice */ + + for (exp_i=eg.i_list;exp_i;) { + struct exp_i *next = exp_i->next; + exp_i->next = 0; + exp_i = next; + } + free_ecases(interp,&eg,1); + } else { + if (eg.ecd.cases) ckfree((char *)eg.ecd.cases); + } + + if (ecmd->cmdtype == EXP_CMD_BG) { + exp_background_channelhandlers_run_all(); + } + + if (new_cmd) { Tcl_DecrRefCount (new_cmd); } + return(result); +} + +/* adjusts file according to user's size request */ +void +expAdjust(ExpState *esPtr) +{ + int new_msize, excess; + Tcl_UniChar *string; + + /* + * Resize buffer to user's request * 3 + 1. + * + * x3: in case the match straddles two bufferfuls, and to allow + * reading a bufferful even when we reach near fullness of two. + * (At shuffle time this means we look for 2/3 full buffer and + * drop a 1/3, i.e. half of that). + * + * NOTE: The unmodified expect got the same effect by comparing + * apples and oranges in shuffle mgmt, i.e bytes vs. chars, + * and automatically extending the buffer (Tcl_Obj string) + * to hold that much. + * + * +1: for trailing null. + */ + + new_msize = esPtr->umsize * 3 + 1; + + if (new_msize != esPtr->input.max) { + + if (esPtr->input.use > new_msize) { + /* + * too much data, forget about data at beginning of buffer + */ + + string = esPtr->input.buffer; + excess = esPtr->input.use - new_msize; /* #chars */ + + memcpy (string, string + excess, new_msize * sizeof (Tcl_UniChar)); + esPtr->input.use = new_msize; + + } else { + /* + * too little data - length < new_mbytes + * Make larger if the max is also too small. + */ + + if (esPtr->input.max < new_msize) { + esPtr->input.buffer = (Tcl_UniChar*) \ + Tcl_Realloc ((char*)esPtr->input.buffer, + new_msize * sizeof (Tcl_UniChar)); + } + } + + esPtr->key = expect_key++; + esPtr->input.max = new_msize; + } +} + +#if OBSOLETE +/* Strip parity */ +static void +expParityStrip( + Tcl_Obj *obj, + int offsetBytes) +{ + char *p, ch; + + int changed = FALSE; + + for (p = Tcl_GetString(obj) + offsetBytes;*p;p++) { + ch = *p & 0x7f; + if (ch != *p) changed = TRUE; + else *p &= 0x7f; + } + + if (changed) { + /* invalidate the unicode rep */ + if (obj->typePtr->freeIntRepProc) { + obj->typePtr->freeIntRepProc(obj); + } + } +} + +/* This function is only used when debugging. It checks when a string's + internal UTF is sane and whether an offset into the string appears to + be at a UTF boundary. +*/ +static void +expValid( + Tcl_Obj *obj, + int offset) +{ + char *s, *end; + int len; + + s = Tcl_GetStringFromObj(obj,&len); + + if (offset > len) { + printf("offset (%d) > length (%d)\n",offset,len); + fflush(stdout); + abort(); + } + + /* first test for null terminator */ + end = s + len; + if (*end != '\0') { + printf("obj lacks null terminator\n"); + fflush(stdout); + abort(); + } + + /* check for valid UTF sequence */ + while (*s) { + Tcl_UniChar uc; + + s += TclUtfToUniChar(s,&uc); + if (s > end) { + printf("UTF out of sync with terminator\n"); + fflush(stdout); + abort(); + } + } + s += offset; + while (*s) { + Tcl_UniChar uc; + + s += TclUtfToUniChar(s,&uc); + if (s > end) { + printf("UTF from offset out of sync with terminator\n"); + fflush(stdout); + abort(); + } + } +} +#endif /*OBSOLETE*/ + +/* Strip nulls from object, beginning at offset */ +static int +expNullStrip( + ExpUniBuf* buf, + int offsetChars) +{ + Tcl_UniChar *src, *src2, *dest, *end; + int newsize; /* size of obj after all nulls removed */ + + src2 = src = dest = buf->buffer + offsetChars; + end = buf->buffer + buf->use; + + while (src < end) { + if (*src) { + *dest = *src; + dest ++; + } + src ++; + } + newsize = offsetChars + (dest - src2); + buf->use = newsize; + return newsize; +} + +/* returns # of bytes read or (non-positive) error of form EXP_XXX */ +/* returns 0 for end of file */ +/* If timeout is non-zero, set an alarm before doing the read, else assume */ +/* the read will complete immediately. */ +/*ARGSUSED*/ +static int +expIRead( /* INTL */ + Tcl_Interp *interp, + ExpState *esPtr, + int timeout, + int save_flags) +{ + int cc = EXP_TIMEOUT; + int size; + + /* We drop one third when are at least 2/3 full */ + /* condition is (size >= max*2/3) <=> (size*3 >= max*2) */ + if (expSizeGet(esPtr)*3 >= esPtr->input.max*2) + exp_buffer_shuffle(interp,esPtr,save_flags,EXPECT_OUT,"expect"); + size = expSizeGet(esPtr); + +#ifdef SIMPLE_EVENT + restart: + + alarm_fired = FALSE; + + if (timeout > -1) { + signal(SIGALRM,sigalarm_handler); + alarm((timeout > 0)?timeout:1); + } +#endif + + cc = Tcl_ReadChars(esPtr->channel, esPtr->input.newchars, + esPtr->input.max - esPtr->input.use, + 0 /* no append */); + i_read_errno = errno; + + if (cc > 0) { + memcpy (esPtr->input.buffer + esPtr->input.use, + Tcl_GetUnicodeFromObj (esPtr->input.newchars, NULL), + cc * sizeof (Tcl_UniChar)); + esPtr->input.use += cc; + } + +#ifdef SIMPLE_EVENT + alarm(0); + + if (cc == -1) { + /* check if alarm went off */ + if (i_read_errno == EINTR) { + if (alarm_fired) { + return EXP_TIMEOUT; + } else { + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); + } + goto restart; + } + } + } +#endif + return cc; +} + +/* + * expRead() does the logical equivalent of a read() for the expect command. + * This includes figuring out which descriptor should be read from. + * + * The result of the read() is left in a spawn_id's buffer rather than + * explicitly passing it back. Note that if someone else has modified a buffer + * either before or while this expect is running (i.e., if we or some event has + * called Tcl_Eval which did another expect/interact), expRead will also call + * this a successful read (for the purposes if needing to pattern match against + * it). + */ + +/* if it returns a negative number, it corresponds to a EXP_XXX result */ +/* if it returns a non-negative number, it means there is data */ +/* (0 means nothing new was actually read, but it should be looked at again) */ +int +expRead( + Tcl_Interp *interp, + ExpState *(esPtrs[]), /* If 0, then esPtrOut already known and set */ + int esPtrsMax, /* number of esPtrs */ + ExpState **esPtrOut, /* Out variable to leave new ExpState. */ + int timeout, + int key) +{ + ExpState *esPtr; + + int size; + int cc; + int write_count; + int tcl_set_flags; /* if we have to discard chars, this tells */ + /* whether to show user locally or globally */ + + if (esPtrs == 0) { + /* we already know the ExpState, just find out what happened */ + cc = exp_get_next_event_info(interp,*esPtrOut); + tcl_set_flags = TCL_GLOBAL_ONLY; + } else { + cc = exp_get_next_event(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key); + tcl_set_flags = 0; + } + + esPtr = *esPtrOut; + + if (cc == EXP_DATA_NEW) { + /* try to read it */ + cc = expIRead(interp,esPtr,timeout,tcl_set_flags); + + /* the meaning of 0 from i_read means eof. Muck with it a */ + /* little, so that from now on it means "no new data arrived */ + /* but it should be looked at again anyway". */ + if (cc == 0) { + cc = EXP_EOF; + } else if (cc > 0) { + /* successfully read data */ + } else { + /* failed to read data - some sort of error was encountered such as + * an interrupt with that forced an error return + */ + } + } else if (cc == EXP_DATA_OLD) { + cc = 0; + } else if (cc == EXP_RECONFIGURE) { + return EXP_RECONFIGURE; + } + + if (cc == EXP_ABEOF) { /* abnormal EOF */ + /* On many systems, ptys produce EIO upon EOF - sigh */ + if (i_read_errno == EIO) { + /* Sun, Cray, BSD, and others */ + cc = EXP_EOF; + } else if (i_read_errno == EINVAL) { + /* Solaris 2.4 occasionally returns this */ + cc = EXP_EOF; + } else { + if (i_read_errno == EBADF) { + exp_error(interp,"bad spawn_id (process died earlier?)"); + } else { + exp_error(interp,"i_read(spawn_id fd=%d): %s",esPtr->fdin, + Tcl_PosixError(interp)); + if (esPtr->close_on_eof) { + exp_close(interp,esPtr); + } + } + return(EXP_TCLERROR); + /* was goto error; */ + } + } + + /* EOF, TIMEOUT, and ERROR return here */ + /* In such cases, there is no need to update screen since, if there */ + /* was prior data read, it would have been sent to the screen when */ + /* it was read. */ + if (cc < 0) return (cc); + + /* + * update display + */ + + size = expSizeGet(esPtr); + if (size) write_count = size - esPtr->printed; + else write_count = 0; + + if (write_count) { + /* + * Show chars to user if they've requested it, UNLESS they're seeing it + * already because they're typing it and tty driver is echoing it. + * Also send to Diag and Log if appropriate. + */ + expLogInteractionU(esPtr,esPtr->input.buffer + esPtr->printed, write_count); + + /* + * strip nulls from input, since there is no way for Tcl to deal with + * such strings. Doing it here lets them be sent to the screen, just + * in case they are involved in formatting operations + */ + if (esPtr->rm_nulls) size = expNullStrip(&esPtr->input,esPtr->printed); + esPtr->printed = size; /* count'm even if not logging */ + } + return(cc); +} + +/* when buffer fills, copy second half over first and */ +/* continue, so we can do matches over multiple buffers */ +void +exp_buffer_shuffle( /* INTL */ + Tcl_Interp *interp, + ExpState *esPtr, + int save_flags, + char *array_name, + char *caller_name) +{ + Tcl_UniChar *str; + Tcl_UniChar *p; + int numchars, newlen, skiplen; + Tcl_UniChar lostChar; + + /* + * allow user to see data we are discarding + */ + + expDiagLog("%s: set %s(spawn_id) \"%s\"\r\n", + caller_name,array_name,esPtr->name); + Tcl_SetVar2(interp,array_name,"spawn_id",esPtr->name,save_flags); + + /* + * The internal storage buffer object should only be referred + * to by the channel that uses it. We always copy the contents + * out of the object before passing the data to anyone outside + * of these routines. This ensures that the object always has + * a refcount of 1 so we can safely modify the contents in place. + */ + + str = esPtr->input.buffer; + numchars = esPtr->input.use; + + skiplen = numchars/3; + p = str + skiplen; + + /* + * before doing move, show user data we are discarding + */ + + lostChar = *p; + /* temporarily stick null in middle of string */ + *p = 0; + + expDiagLog("%s: set %s(buffer) \"",caller_name,array_name); + expDiagLogU(expPrintifyUni(str,numchars)); + expDiagLogU("\"\r\n"); + Tcl_SetVar2Ex(interp,array_name,"buffer", + Tcl_NewUnicodeObj (str, skiplen), + save_flags); + + /* + * restore damage + */ + *p = lostChar; + + /* + * move 2nd half of string down to 1st half + */ + + newlen = numchars - skiplen; + memmove(str, p, newlen * sizeof(Tcl_UniChar)); + esPtr->input.use = newlen; + + esPtr->printed -= skiplen; + if (esPtr->printed < 0) esPtr->printed = 0; +} + +/* map EXP_ style return value to TCL_ style return value */ +/* not defined to work on TCL_OK */ +int +exp_tcl2_returnvalue(int x) +{ + switch (x) { + case TCL_ERROR: return EXP_TCLERROR; + case TCL_RETURN: return EXP_TCLRET; + case TCL_BREAK: return EXP_TCLBRK; + case TCL_CONTINUE: return EXP_TCLCNT; + case EXP_CONTINUE: return EXP_TCLCNTEXP; + case EXP_CONTINUE_TIMER: return EXP_TCLCNTTIMER; + case EXP_TCL_RETURN: return EXP_TCLRETTCL; + } + /* Must not reach this location. Can happen only if x is an + * illegal value. Added return to suppress compiler warning. + */ + return -1000; +} + +/* map from EXP_ style return value to TCL_ style return values */ +int +exp_2tcl_returnvalue(int x) +{ + switch (x) { + case EXP_TCLERROR: return TCL_ERROR; + case EXP_TCLRET: return TCL_RETURN; + case EXP_TCLBRK: return TCL_BREAK; + case EXP_TCLCNT: return TCL_CONTINUE; + case EXP_TCLCNTEXP: return EXP_CONTINUE; + case EXP_TCLCNTTIMER: return EXP_CONTINUE_TIMER; + case EXP_TCLRETTCL: return EXP_TCL_RETURN; + } + /* Must not reach this location. Can happen only if x is an + * illegal value. Added return to suppress compiler warning. + */ + return -1000; +} + +/* variables predefined by expect are retrieved using this routine +which looks in the global space if they are not in the local space. +This allows the user to localize them if desired, and also to +avoid having to put "global" in procedure definitions. +*/ +char * +exp_get_var( + Tcl_Interp *interp, + char *var) +{ + char *val; + + if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */))) + return(val); + return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY)); +} + +static int +get_timeout(Tcl_Interp *interp) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + CONST char *t; + + if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) { + tsdPtr->timeout = atoi(t); + } + return(tsdPtr->timeout); +} + +/* make a copy of a linked list (1st arg) and attach to end of another (2nd +arg) */ +static int +update_expect_states( + struct exp_i *i_list, + struct exp_state_list **i_union) +{ + struct exp_i *p; + + /* for each i_list in an expect statement ... */ + for (p=i_list;p;p=p->next) { + struct exp_state_list *slPtr; + + /* for each esPtr in the i_list */ + for (slPtr=p->state_list;slPtr;slPtr=slPtr->next) { + struct exp_state_list *tmpslPtr; + struct exp_state_list *u; + + if (expStateAnyIs(slPtr->esPtr)) continue; + + /* check this one against all so far */ + for (u = *i_union;u;u=u->next) { + if (slPtr->esPtr == u->esPtr) goto found; + } + /* if not found, link in as head of list */ + tmpslPtr = exp_new_state(slPtr->esPtr); + tmpslPtr->next = *i_union; + *i_union = tmpslPtr; + found:; + } + } + return TCL_OK; +} + +char * +exp_cmdtype_printable(int cmdtype) +{ + switch (cmdtype) { + case EXP_CMD_FG: return("expect"); + case EXP_CMD_BG: return("expect_background"); + case EXP_CMD_BEFORE: return("expect_before"); + case EXP_CMD_AFTER: return("expect_after"); + } + /*#ifdef LINT*/ + return("unknown expect command"); + /*#endif*/ +} + +/* exp_indirect_update2 is called back via Tcl's trace handler whenever */ +/* an indirect spawn id list is changed */ +/*ARGSUSED*/ +static char * +exp_indirect_update2( + ClientData clientData, + Tcl_Interp *interp, /* Interpreter containing variable. */ + char *name1, /* Name of variable. */ + char *name2, /* Second part of variable name. */ + int flags) /* Information about what happened. */ +{ + char *msg; + + struct exp_i *exp_i = (struct exp_i *)clientData; + exp_configure_count++; + msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i); + + exp_background_channelhandlers_run_all(); + + return msg; +} + +static char * +exp_indirect_update1( + Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + struct exp_i *exp_i) +{ + struct exp_state_list *slPtr; /* temp for interating over state_list */ + + /* + * disarm any ExpState's that lose all their active spawn ids + */ + + if (ecmd->cmdtype == EXP_CMD_BG) { + /* clean up each spawn id used by this exp_i */ + for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { + ExpState *esPtr = slPtr->esPtr; + + if (expStateAnyIs(esPtr)) continue; + + /* silently skip closed or preposterous fds */ + /* since we're just disabling them anyway */ + /* preposterous fds will have been reported */ + /* by code in next section already */ + if (!expStateCheck(interp,slPtr->esPtr,1,0,"")) continue; + + /* check before decrementing, ecount may not be */ + /* positive if update is called before ecount is */ + /* properly synchronized */ + if (esPtr->bg_ecount > 0) { + esPtr->bg_ecount--; + } + if (esPtr->bg_ecount == 0) { + exp_disarm_background_channelhandler(esPtr); + esPtr->bg_interp = 0; + } + } + } + + /* + * reread indirect variable + */ + + exp_i_update(interp,exp_i); + + /* + * check validity of all fd's in variable + */ + + for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { + /* validate all input descriptors */ + + if (expStateAnyIs(slPtr->esPtr)) continue; + + if (!expStateCheck(interp,slPtr->esPtr,1,1, + exp_cmdtype_printable(ecmd->cmdtype))) { + /* Note: Cannot construct a Tcl_Obj* here, the function is a + * Tcl_VarTraceProc and the API wants a char*. + * + * DANGER: The buffer may overflow if either the existing result, + * the variable name, or both become to large. + */ + static char msg[200]; + sprintf(msg,"%s from indirect variable (%s)", + Tcl_GetStringResult (interp),exp_i->variable); + return msg; + } + } + + /* for each spawn id in list, arm if necessary */ + if (ecmd->cmdtype == EXP_CMD_BG) { + state_list_arm(interp,exp_i->state_list); + } + + return (char *)0; +} + +int +expMatchProcess( + Tcl_Interp *interp, + struct eval_out *eo, /* final case of interest */ + int cc, /* EOF, TIMEOUT, etc... */ + int bg, /* 1 if called from background handler, */ + /* else 0 */ + char *detail) +{ + ExpState *esPtr = 0; + Tcl_Obj *body = 0; + Tcl_UniChar *buffer; + struct ecase *e = 0; /* points to current ecase */ + int match = -1; /* characters matched */ + /* uprooted by a NULL */ + int result = TCL_OK; + +#define out(indexName, value) \ + expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \ + expDiagLogU(expPrintify(value)); \ + expDiagLogU("\"\r\n"); \ + Tcl_SetVar2(interp, EXPECT_OUT,indexName,value,(bg ? TCL_GLOBAL_ONLY : 0)); + + /* The numchars argument allows us to avoid sticking a \0 into the buffer */ +#define outuni(indexName, value,numchars) \ + expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \ + expDiagLogU(expPrintifyUni(value,numchars)); \ + expDiagLogU("\"\r\n"); \ + Tcl_SetVar2Ex(interp, EXPECT_OUT,indexName,Tcl_NewUnicodeObj(value,numchars),(bg ? TCL_GLOBAL_ONLY : 0)); + + if (eo->e) { + e = eo->e; + body = e->body; + if (cc != EXP_TIMEOUT) { + esPtr = eo->esPtr; + match = eo->matchlen; + buffer = eo->matchbuf; + } + } else if (cc == EXP_EOF) { + /* read an eof but no user-supplied case */ + esPtr = eo->esPtr; + match = eo->matchlen; + buffer = eo->matchbuf; + } + + if (match >= 0) { + char name[20], value[20]; + int i; + + if (e && e->use == PAT_RE) { + Tcl_RegExp re; + int flags; + Tcl_RegExpInfo info; + Tcl_Obj *buf; + + /* No gate keeper required here, we know that the RE + * matches, we just do it again to get all the captured + * pieces + */ + + if (e->Case == CASE_NORM) { + flags = TCL_REG_ADVANCED; + } else { + flags = TCL_REG_ADVANCED | TCL_REG_NOCASE; + } + + re = Tcl_GetRegExpFromObj(interp, e->pat, flags); + Tcl_RegExpGetInfo(re, &info); + + buf = Tcl_NewUnicodeObj (buffer,esPtr->input.use); + for (i=0;i<=info.nsubs;i++) { + int start, end; + Tcl_Obj *val; + + start = info.matches[i].start; + end = info.matches[i].end-1; + if (start == -1) continue; + + if (e->indices) { + /* start index */ + sprintf(name,"%d,start",i); + sprintf(value,"%d",start); + out(name,value); + + /* end index */ + sprintf(name,"%d,end",i); + sprintf(value,"%d",end); + out(name,value); + } + + /* string itself */ + sprintf(name,"%d,string",i); + val = Tcl_GetRange(buf, start, end); + expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,name); + expDiagLogU(expPrintifyObj(val)); + expDiagLogU("\"\r\n"); + Tcl_SetVar2Ex(interp,EXPECT_OUT,name,val,(bg ? TCL_GLOBAL_ONLY : 0)); + } + Tcl_DecrRefCount (buf); + } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) { + Tcl_UniChar *str; + + if (e->indices) { + /* start index */ + sprintf(value,"%d",e->simple_start); + out("0,start",value); + + /* end index */ + sprintf(value,"%d",e->simple_start + match - 1); + out("0,end",value); + } + + /* string itself */ + str = esPtr->input.buffer + e->simple_start; + outuni("0,string",str,match); + + /* redefine length of string that */ + /* matched for later extraction */ + match += e->simple_start; + } else if (e && e->use == PAT_NULL && e->indices) { + /* start index */ + sprintf(value,"%d",match-1); + out("0,start",value); + /* end index */ + sprintf(value,"%d",match-1); + out("0,end",value); + } else if (e && e->use == PAT_FULLBUFFER) { + expDiagLogU("expect_background: full buffer\r\n"); + } + } + + /* this is broken out of (match > 0) (above) since it can be */ + /* that an EOF occurred with match == 0 */ + if (eo->esPtr) { + Tcl_UniChar *str; + int numchars; + + out("spawn_id",esPtr->name); + + str = esPtr->input.buffer; + numchars = esPtr->input.use; + + /* Save buf[0..match] */ + outuni("buffer",str,match); + + /* "!e" means no case matched - transfer by default */ + if (!e || e->transfer) { + int remainder = numchars-match; + /* delete matched chars from input buffer */ + esPtr->printed -= match; + if (numchars != 0) { + memmove(str,str+match,remainder*sizeof(Tcl_UniChar)); + } + esPtr->input.use = remainder; + } + + if (cc == EXP_EOF) { + /* exp_close() deletes all background bodies */ + /* so save eof body temporarily */ + if (body) { Tcl_IncrRefCount(body); } + if (esPtr->close_on_eof) { + exp_close(interp,esPtr); + } + } + } + + if (body) { + if (!bg) { + result = Tcl_EvalObjEx(interp,body,0); + } else { + result = Tcl_EvalObjEx(interp,body,TCL_EVAL_GLOBAL); + if (result != TCL_OK) Tcl_BackgroundError(interp); + } + if (cc == EXP_EOF) { Tcl_DecrRefCount(body); } + } + return result; +} + +/* this function is called from the background when input arrives */ +/*ARGSUSED*/ +void +exp_background_channelhandler( /* INTL */ + ClientData clientData, + int mask) +{ + char backup[EXP_CHANNELNAMELEN+1]; /* backup copy of esPtr channel name! */ + + ExpState *esPtr; + Tcl_Interp *interp; + int cc; /* number of bytes returned in a single read */ + /* or negative EXP_whatever */ + struct eval_out eo; /* final case of interest */ + ExpState *last_esPtr; /* for differentiating when multiple esPtrs */ + /* to print out better debugging messages */ + int last_case; /* as above but for case */ + + /* restore our environment */ + esPtr = (ExpState *)clientData; + + /* backup just in case someone zaps esPtr in the middle of our work! */ + strcpy(backup,esPtr->name); + + interp = esPtr->bg_interp; + + /* temporarily prevent this handler from being invoked again */ + exp_block_background_channelhandler(esPtr); + + /* + * if mask == 0, then we've been called because the patterns changed not + * because the waiting data has changed, so don't actually do any I/O + */ + if (mask == 0) { + cc = 0; + } else { + esPtr->notifiedMask = mask; + esPtr->notified = FALSE; + cc = expRead(interp,(ExpState **)0,0,&esPtr,EXP_TIME_INFINITY,0); + } + +do_more_data: + eo.e = 0; /* no final case yet */ + eo.esPtr = 0; /* no final file selected yet */ + eo.matchlen = 0; /* nothing matched yet */ + + /* force redisplay of buffer when debugging */ + last_esPtr = 0; + + if (cc == EXP_EOF) { + /* do nothing */ + } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/ + goto finish; + /* + * if we were going to do this right, we should differentiate between + * things like HP ioctl-open-traps that fall out here and should + * rightfully be ignored and real errors that should be reported. Come + * to think of it, the only errors will come from HP ioctl handshake + * botches anyway. + */ + } else { + /* normal case, got data */ + /* new data if cc > 0, same old data if cc == 0 */ + + /* below here, cc as general status */ + cc = EXP_NOMATCH; + } + + cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE], + esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background"); + cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG], + esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background"); + cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], + esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background"); + if (cc == EXP_TCLERROR) { + /* only likely problem here is some internal regexp botch */ + Tcl_BackgroundError(interp); + goto finish; + } + /* special eof code that cannot be done in eval_cases */ + /* or above, because it would then be executed several times */ + if (cc == EXP_EOF) { + eo.esPtr = esPtr; + eo.matchlen = expSizeGet(eo.esPtr); + eo.matchbuf = eo.esPtr->input.buffer; + expDiagLogU("expect_background: read eof\r\n"); + goto matched; + } + if (!eo.e) { + /* if we get here, there must not have been a match */ + goto finish; + } + + matched: + expMatchProcess(interp, &eo, cc, 1 /* bg */,"expect_background"); + + /* + * Event handler will not call us back if there is more input + * pending but it has already arrived. bg_status will be + * "blocked" only if armed. + */ + + /* + * Connection could have been closed on us. In this case, + * exitWhenBgStatusUnblocked will be 1 and we should disable the channel + * handler and release the esPtr. + */ + + /* First check that the esPtr is even still valid! */ + /* This ought to be sufficient. */ + if (0 == Tcl_GetChannel(interp,backup,(int *)0)) { + expDiagLog("expect channel %s lost in background handler\n",backup); + return; + } + + if ((!esPtr->freeWhenBgHandlerUnblocked) && (esPtr->bg_status == blocked)) { + if (0 != (cc = expSizeGet(esPtr))) { + goto do_more_data; + } + } + finish: + exp_unblock_background_channelhandler(esPtr); + if (esPtr->freeWhenBgHandlerUnblocked) + expStateFree(esPtr); +} + +/*ARGSUSED*/ +int +Exp_ExpectObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int cc; /* number of chars returned in a single read */ + /* or negative EXP_whatever */ + ExpState *esPtr = 0; + + int i; /* misc temporary */ + struct exp_cmd_descriptor eg; + struct exp_state_list *state_list; /* list of ExpStates to watch */ + struct exp_state_list *slPtr; /* temp for interating over state_list */ + ExpState **esPtrs; + int mcount; /* number of esPtrs to watch */ + + struct eval_out eo; /* final case of interest */ + + int result; /* Tcl result */ + + time_t start_time_total; /* time at beginning of this procedure */ + time_t start_time = 0; /* time when restart label hit */ + time_t current_time = 0; /* current time (when we last looked)*/ + time_t end_time; /* future time at which to give up */ + + ExpState *last_esPtr; /* for differentiating when multiple f's */ + /* to print out better debugging messages */ + int last_case; /* as above but for case */ + int first_time = 1; /* if not "restarted" */ + + int key; /* identify this expect command instance */ + int configure_count; /* monitor exp_configure_count */ + + int timeout; /* seconds */ + int remtime; /* remaining time in timeout */ + int reset_timer; /* should timer be reset after continue? */ + Tcl_Time temp_time; + Tcl_Obj* new_cmd = NULL; + + if ((objc == 2) && exp_one_arg_braced(objv[1])) { + /* expect {...} */ + + new_cmd = exp_eval_with_one_arg(clientData,interp,objv); + if (!new_cmd) return TCL_ERROR; + } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { + /* expect -brace {...} ... fake command line for reparsing */ + + Tcl_Obj *new_objv[2]; + new_objv[0] = objv[0]; + new_objv[1] = objv[2]; + + new_cmd = exp_eval_with_one_arg(clientData,interp,new_objv); + if (!new_cmd) return TCL_ERROR; + } + + if (new_cmd) { + /* Replace old arguments with result of the reparse */ + Tcl_ListObjGetElements (interp, new_cmd, &objc, (Tcl_Obj***) &objv); + } + + Tcl_GetTime (&temp_time); + start_time_total = temp_time.sec; + start_time = start_time_total; + reset_timer = TRUE; + + if (&StdinoutPlaceholder == (ExpState *)clientData) { + clientData = (ClientData) expStdinoutGet(); + } else if (&DevttyPlaceholder == (ExpState *)clientData) { + clientData = (ClientData) expDevttyGet(); + } + + /* make arg list for processing cases */ + /* do it dynamically, since expect can be called recursively */ + + exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY); + state_list = 0; + esPtrs = 0; + if (TCL_ERROR == parse_expect_args(interp,&eg, (ExpState *)clientData, + objc,objv)) { + if (new_cmd) { Tcl_DecrRefCount (new_cmd); } + return TCL_ERROR; + } + + restart_with_update: + /* validate all descriptors and flatten ExpStates into array */ + + if ((TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_BEFORE].i_list,&state_list)) + || (TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_AFTER].i_list, &state_list)) + || (TCL_ERROR == update_expect_states(eg.i_list,&state_list))) { + result = TCL_ERROR; + goto cleanup; + } + + /* declare ourselves "in sync" with external view of close/indirect */ + configure_count = exp_configure_count; + + /* count and validate state_list */ + mcount = 0; + for (slPtr=state_list;slPtr;slPtr=slPtr->next) { + mcount++; + /* validate all input descriptors */ + if (!expStateCheck(interp,slPtr->esPtr,1,1,"expect")) { + result = TCL_ERROR; + goto cleanup; + } + } + + /* make into an array */ + esPtrs = (ExpState **)ckalloc(mcount * sizeof(ExpState *)); + for (slPtr=state_list,i=0;slPtr;slPtr=slPtr->next,i++) { + esPtrs[i] = slPtr->esPtr; + } + + restart: + if (first_time) first_time = 0; + else { + Tcl_GetTime (&temp_time); + start_time = temp_time.sec; + } + + if (eg.timeout_specified_by_flag) { + timeout = eg.timeout; + } else { + /* get the latest timeout */ + timeout = get_timeout(interp); + } + + key = expect_key++; + + result = TCL_OK; + last_esPtr = 0; + + /* + * end of restart code + */ + + eo.e = 0; /* no final case yet */ + eo.esPtr = 0; /* no final ExpState selected yet */ + eo.matchlen = 0; /* nothing matched yet */ + + /* timeout code is a little tricky, be very careful changing it */ + if (timeout != EXP_TIME_INFINITY) { + /* if exp_continue -continue_timer, do not update end_time */ + if (reset_timer) { + Tcl_GetTime (&temp_time); + current_time = temp_time.sec; + end_time = current_time + timeout; + } else { + reset_timer = TRUE; + } + } + + /* remtime and current_time updated at bottom of loop */ + remtime = timeout; + + for (;;) { + if ((timeout != EXP_TIME_INFINITY) && (remtime < 0)) { + cc = EXP_TIMEOUT; + } else { + cc = expRead(interp,esPtrs,mcount,&esPtr,remtime,key); + } + + /*SUPPRESS 530*/ + if (cc == EXP_EOF) { + /* do nothing */ + } else if (cc == EXP_TIMEOUT) { + expDiagLogU("expect: timed out\r\n"); + } else if (cc == EXP_RECONFIGURE) { + reset_timer = FALSE; + goto restart_with_update; + } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/ + goto error; + } else { + /* new data if cc > 0, same old data if cc == 0 */ + + /* below here, cc as general status */ + cc = EXP_NOMATCH; + + /* force redisplay of buffer when debugging */ + last_esPtr = 0; + } + + cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE], + esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,""); + cc = eval_cases(interp,&eg, + esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,""); + cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], + esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,""); + if (cc == EXP_TCLERROR) goto error; + /* special eof code that cannot be done in eval_cases */ + /* or above, because it would then be executed several times */ + if (cc == EXP_EOF) { + eo.esPtr = esPtr; + eo.matchlen = expSizeGet(eo.esPtr); + eo.matchbuf = eo.esPtr->input.buffer; + expDiagLogU("expect: read eof\r\n"); + break; + } else if (cc == EXP_TIMEOUT) break; + + /* break if timeout or eof and failed to find a case for it */ + + if (eo.e) break; + + /* no match was made with current data, force a read */ + esPtr->force_read = TRUE; + + if (timeout != EXP_TIME_INFINITY) { + Tcl_GetTime (&temp_time); + current_time = temp_time.sec; + remtime = end_time - current_time; + } + } + + goto done; + +error: + result = exp_2tcl_returnvalue(cc); + done: + if (result != TCL_ERROR) { + result = expMatchProcess(interp, &eo, cc, 0 /* not bg */,"expect"); + } + + cleanup: + if (result == EXP_CONTINUE_TIMER) { + reset_timer = FALSE; + result = EXP_CONTINUE; + } + + if ((result == EXP_CONTINUE) && (configure_count == exp_configure_count)) { + expDiagLogU("expect: continuing expect\r\n"); + goto restart; + } + + if (state_list) { + exp_free_state(state_list); + state_list = 0; + } + if (esPtrs) { + ckfree((char *)esPtrs); + esPtrs = 0; + } + + if (result == EXP_CONTINUE) { + expDiagLogU("expect: continuing expect after update\r\n"); + goto restart_with_update; + } + + free_ecases(interp,&eg,0); /* requires i_lists to be avail */ + exp_free_i(interp,eg.i_list,exp_indirect_update2); + + if (new_cmd) { Tcl_DecrRefCount (new_cmd); } + return(result); +} + +/*ARGSUSED*/ +static int +Exp_TimestampObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + char *format = 0; + time_t seconds = -1; + int gmt = FALSE; /* local time by default */ + struct tm *tm; + Tcl_DString dstring; + int i; + + static char* options[] = { + "-format", + "-gmt", + "-seconds", + NULL + }; + enum options { + TS_FORMAT, + TS_GMT, + TS_SECONDS + }; + + for (i=1; i<objc; i++) { + char *name; + int index; + + name = Tcl_GetString(objv[i]); + if (name[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum options) index) { + case TS_FORMAT: + i++; + if (i >= objc) goto usage_error; + format = Tcl_GetString (objv[i]); + break; + case TS_GMT: + gmt = TRUE; + break; + case TS_SECONDS: { + int sec; + i++; + if (i >= objc) goto usage_error; + if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &sec)) { + goto usage_error; + } + seconds = sec; + } + break; + } + } + + if (i < objc) goto usage_error; + + if (seconds == -1) { + time(&seconds); + } + + if (format) { + if (gmt) { + tm = gmtime(&seconds); + } else { + tm = localtime(&seconds); + } + Tcl_DStringInit(&dstring); + exp_strftime(format,tm,&dstring); + Tcl_DStringResult(interp,&dstring); + } else { + Tcl_SetObjResult (interp, Tcl_NewIntObj (seconds)); + } + + return TCL_OK; + usage_error: + exp_error(interp,"args: [-seconds #] [-format format] [-gmt]"); + return TCL_ERROR; + +} + +/* Helper function hnadling the common processing of -d and -i options of + * various commands. + */ + +static int +process_di _ANSI_ARGS_ ((Tcl_Interp* interp, + int objc, + Tcl_Obj *CONST objv[], /* Argument objects. */ + int* at, + int* Default, + ExpState **esOut, + CONST char* cmd)); + +static int +process_di ( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[], /* Argument objects. */ + int* at, + int* Default, + ExpState **esOut, + CONST char* cmd) +{ + static char* options[] = { + "-d", + "-i", + NULL + }; + enum options { + DI_DEFAULT, + DI_ID + }; + int def = FALSE; + char* chan = NULL; + int i; + ExpState *esPtr; + + for (i=1; i<objc; i++) { + char *name; + int index; + + name = Tcl_GetString(objv[i]); + if (name[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum options) index) { + case DI_DEFAULT: + def = TRUE; + break; + case DI_ID: + i++; + if (i >= objc) { + exp_error(interp,"-i needs argument"); + return(TCL_ERROR); + } + chan = Tcl_GetString (objv[i]); + break; + } + } + + if (def && chan) { + exp_error(interp,"cannot do -d and -i at the same time"); + return(TCL_ERROR); + } + + /* Not all arguments processed, more than two remaining, only at most one + * remaining is expected/allowed. + */ + if (i < (objc-1)) { + exp_error(interp,"too many arguments"); + return(TCL_OK); + } + + if (!def) { + if (!chan) { + esPtr = expStateCurrent(interp,0,0,0); + } else { + esPtr = expStateFromChannelName(interp,chan,0,0,0,(char*)cmd); + } + if (!esPtr) return(TCL_ERROR); + } + + *at = i; + *Default = def; + *esOut = esPtr; + return TCL_OK; +} + + +/*ARGSUSED*/ +int +Exp_MatchMaxObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int size = -1; + ExpState *esPtr = 0; + int Default = FALSE; + int i; + + if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "match_max")) + return TCL_ERROR; + + /* No size argument */ + if (i == objc) { + if (Default) { + size = exp_default_match_max; + } else { + size = esPtr->umsize; + } + Tcl_SetObjResult (interp, Tcl_NewIntObj (size)); + return(TCL_OK); + } + + /* + * All that's left is to set the size + */ + + if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &size)) { + return TCL_ERROR; + } + + if (size <= 0) { + exp_error(interp,"must be positive"); + return(TCL_ERROR); + } + + if (Default) exp_default_match_max = size; + else esPtr->umsize = size; + + return(TCL_OK); +} + +/*ARGSUSED*/ +int +Exp_RemoveNullsObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int value = -1; + ExpState *esPtr = 0; + int Default = FALSE; + int i; + + if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "remove_nulls")) + return TCL_ERROR; + + /* No flag argument */ + if (i == objc) { + if (Default) { + value = exp_default_rm_nulls; + } else { + value = esPtr->rm_nulls; + } + Tcl_SetObjResult (interp, Tcl_NewIntObj (value)); + return(TCL_OK); + } + + /* all that's left is to set the value */ + + if (TCL_OK != Tcl_GetBooleanFromObj (interp, objv[i], &value)) { + return TCL_ERROR; + } + + if ((value != 0) && (value != 1)) { + exp_error(interp,"must be 0 or 1"); + return(TCL_ERROR); + } + + if (Default) exp_default_rm_nulls = value; + else esPtr->rm_nulls = value; + + return(TCL_OK); +} + +/*ARGSUSED*/ +int +Exp_ParityObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int parity; + ExpState *esPtr = 0; + int Default = FALSE; + int i; + + if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "parity")) + return TCL_ERROR; + + /* No parity argument */ + if (i == objc) { + if (Default) { + parity = exp_default_parity; + } else { + parity = esPtr->parity; + } + Tcl_SetObjResult (interp, Tcl_NewIntObj (parity)); + return(TCL_OK); + } + + /* all that's left is to set the parity */ + + if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &parity)) { + return TCL_ERROR; + } + + if (Default) exp_default_parity = parity; + else esPtr->parity = parity; + + return(TCL_OK); +} + +/*ARGSUSED*/ +int +Exp_CloseOnEofObjCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + int close_on_eof; + ExpState *esPtr = 0; + int Default = FALSE; + int i; + + if (TCL_OK != process_di (interp, objc, objv, &i, &Default, &esPtr, "close_on_eof")) + return TCL_ERROR; + + /* No flag argument */ + if (i == objc) { + if (Default) { + close_on_eof = exp_default_close_on_eof; + } else { + close_on_eof = esPtr->close_on_eof; + } + Tcl_SetObjResult (interp, Tcl_NewIntObj (close_on_eof)); + return(TCL_OK); + } + + /* all that's left is to set the close_on_eof */ + + if (TCL_OK != Tcl_GetIntFromObj (interp, objv[i], &close_on_eof)) { + return TCL_ERROR; + } + + if (Default) exp_default_close_on_eof = close_on_eof; + else esPtr->close_on_eof = close_on_eof; + + return(TCL_OK); +} + +#if DEBUG_PERM_ECASES +/* This big chunk of code is just for debugging the permanent */ +/* expect cases */ +void +exp_fd_print(struct exp_state_list *slPtr) +{ + if (!slPtr) return; + printf("%d ",slPtr->esPtr); + exp_fd_print(slPtr->next); +} + +void +exp_i_print(struct exp_i *exp_i) +{ + if (!exp_i) return; + printf("exp_i %x",exp_i); + printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect"); + printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp"); + printf(" ecount = %d\n",exp_i->ecount); + printf("variable %s, value %s\n", + ((exp_i->variable)?exp_i->variable:"--"), + ((exp_i->value)?exp_i->value:"--")); + printf("ExpStates: "); + exp_fd_print(exp_i->state_list); printf("\n"); + exp_i_print(exp_i->next); +} + +void +exp_ecase_print(struct ecase *ecase) +{ + printf("pat <%s>\n",ecase->pat); + printf("exp_i = %x\n",ecase->i_list); +} + +void +exp_ecases_print(struct exp_cases_descriptor *ecd) +{ + int i; + + printf("%d cases\n",ecd->count); + for (i=0;i<ecd->count;i++) exp_ecase_print(ecd->cases[i]); +} + +void +exp_cmd_print(struct exp_cmd_descriptor *ecmd) +{ + printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype)); + printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp "); + /* printdict */ + exp_ecases_print(&ecmd->ecd); + exp_i_print(ecmd->i_list); +} + +void +exp_cmds_print(void) +{ + exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]); + exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]); + exp_cmd_print(&exp_cmds[EXP_CMD_BG]); +} + +/*ARGSUSED*/ +int +cmdX( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[]) /* Argument objects. */ +{ + exp_cmds_print(); + return TCL_OK; +} +#endif /*DEBUG_PERM_ECASES*/ + +void +expExpectVarsInit(void) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->timeout = INIT_EXPECT_TIMEOUT; +} + +static struct exp_cmd_data +cmd_data[] = { +{"expect", Exp_ExpectObjCmd, 0, (ClientData)0, 0}, +{"expect_after",Exp_ExpectGlobalObjCmd, 0, (ClientData)&exp_cmds[EXP_CMD_AFTER],0}, +{"expect_before",Exp_ExpectGlobalObjCmd,0, (ClientData)&exp_cmds[EXP_CMD_BEFORE],0}, +{"expect_user", Exp_ExpectObjCmd, 0, (ClientData)&StdinoutPlaceholder,0}, +{"expect_tty", Exp_ExpectObjCmd, 0, (ClientData)&DevttyPlaceholder,0}, +{"expect_background",Exp_ExpectGlobalObjCmd,0, (ClientData)&exp_cmds[EXP_CMD_BG],0}, + {"match_max", Exp_MatchMaxObjCmd, 0, (ClientData)0, 0}, + {"remove_nulls", Exp_RemoveNullsObjCmd, 0, (ClientData)0, 0}, + {"parity", Exp_ParityObjCmd, 0, (ClientData)0, 0}, + {"close_on_eof", Exp_CloseOnEofObjCmd, 0, (ClientData)0, 0}, + {"timestamp", Exp_TimestampObjCmd, 0, (ClientData)0, 0}, +{0}}; + +void +exp_init_expect_cmds(Tcl_Interp *interp) +{ + exp_create_commands(interp,cmd_data); + + Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0); + + exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT); + exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT); + exp_cmd_init(&exp_cmds[EXP_CMD_BG ],EXP_CMD_BG, EXP_PERMANENT); + exp_cmd_init(&exp_cmds[EXP_CMD_FG ],EXP_CMD_FG, EXP_TEMPORARY); + + /* preallocate to one element, so future realloc's work */ + exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0; + exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0; + exp_cmds[EXP_CMD_BG ].ecd.cases = 0; + + pattern_style[PAT_EOF] = "eof"; + pattern_style[PAT_TIMEOUT] = "timeout"; + pattern_style[PAT_DEFAULT] = "default"; + pattern_style[PAT_FULLBUFFER] = "full buffer"; + pattern_style[PAT_GLOB] = "glob pattern"; + pattern_style[PAT_RE] = "regular expression"; + pattern_style[PAT_EXACT] = "exact string"; + pattern_style[PAT_NULL] = "null"; + +#if 0 + Tcl_CreateObjCommand(interp,"x",cmdX,(ClientData)0,exp_deleteProc); +#endif +} + +void +exp_init_sig(void) { +#if 0 + signal(SIGALRM,sigalarm_handler); + signal(SIGINT,sigint_handler); +#endif +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |