Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,119 @@ +2002-02-25 Andreas Kupries + + * expect.c: Applied patch by Don Libes fixing improper + internationalization. + +2002-02-21 Andreas Kupries + + * expect.man: Changed the paragraph about [exp_continue] to + contain information about the flag "-continue_timer". This fixes + the bug SF #520630. + + * exp_main_sub.c (Expect_Init): Applied Don Porter's patch which + excludes the initialization of Tcl/Expect packages and the + creation of the ExitHandler from the 'firsttime' guard. This + allows the full use of Expect in slave-iterpreters. This fixes + the bug SF #459646. + +2002-02-08 Andreas Kupries + + * expect.man: Changed abbreviation of "-notransfer" from "-n" to + "-not". "-n" is no longer unique due to the addition of + "-nocase". This fixes the bug SF #514994. + +2002-02-07 Andreas Kupries + + * Applied patch for SF #514590 to correct behaviour of expect when + expecting and send from and to bogus spawn id's. + + * exp_log.c (expStdoutLogU): Use Tcl_WriteChars/Tcl_Flush instead + of 'fwrite' for tcl 8.1 and beyond to enforce correct conversion + of the internal UTF/8 into the external representation. + +2002-01-16 Andreas Kupries + + * Resynchronization of SourceForge with Don's sources to Expect + version 5.34. The changes are + + Don Porter provided package-related fixes + for test suite. + + Brian Theado noted that interact's -re + support broke when offsets kicked in. Turned out that the + regexp engine supports them during execution but the results are + delivered RELATIVE to the offset. (I suspect this was done + due to expediency.) + +2001-12-05 Andreas Kupries + + * exp_inter.c: Applied patch posted by Don libes to c.l.t. on his + behalf to keep the SF repository in sync with his changes. Don's + notes: I obviously missed the fact that although + "Tcl_RegExpExecObj" supports offsets, they aren't delivered to + "Tcl_RegExpGetInfo". + +2001-08-01 Jeff Hobbs + + * Dbg.c (Dbg_On): fixed handling of stepping. [Bug: #446412] + +2001-07-06 Andreas Kupries + + * exp_main_exp.c: + * exp_main_sub.c: + * exp_main_tk.c: + * exp_tty.c: Changed calls to 'Tcl_Exit' into calls to the command + [exit], to allow scripts and users to overide the functionality. + +2001-06-05 Andreas Kupries + + * exp_main_sub.c: Fixed bug [#418892]. + +2000-04-26 Rob Savoye + + * pty_termios.h: Only include stropts.h if it exists, rather than + deciding it exists based on HAVE_PTMX. + * configure.in: Make sure libpt exists, rather than blindly using + it for all our configure tests, which then all fail. Also assume + our svr4 style ptys are broken, if /dev/ptmx exists, but stropts.h + doesn't exist. + +1999-08-31 Jennifer Hom + + * Makefile.in: Changed test target to source tests/all.tcl instead + of tests/all + + * tests/README: Modified documentation to reflect the change from + usage of a defs file to the use of package tcltest to run the tests + + * tests/all: + * tests/defs: + * tests/all.tcl: + * tests/cat.test: + * tests/expect.test: + * tests/logfile.test: + * tests/pid.test: + * tests/send.test: + * tests/spawn.test + * tests/stty.test: Modified test files to use package tcltest, + removed tests/all and tests/defs, and added tests/all.tcl + +1999-06-22 + + * expect.c: Fixed bug in token parsing where index was not being + incremented properly. + + * configure.in: Changed version number to 5.31. + + * aclocal.m4: Fixed CY_AC_LOAD_TKCONFIG so it tests for Tk_Init + instead of Tk_Main (which is only a macro in 8.1 and later). Also + added TCL_BUILD_LIB_SPEC to the set of flags used in this test to + avoid linker errors. + + * Dbgconfig.in: move CY_*_TCLCONFIG tests below AC_PROG_CC so it + will work with gcc + Thu Mar 20 14:27:45 1997 Geoffrey Noer * configure.in: don't check if stty reads stdout for i[[3456]]86-*-sysv4.2MP during config; hard code instead Index: Dbg.c ================================================================== --- Dbg.c +++ Dbg.c @@ -4,10 +4,12 @@ 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. + RCS: @(#) $Id: Dbg.c,v 5.31 2001/08/02 00:30:14 hobbs Exp $ + */ #include #include "tcldbgcf.h" @@ -86,16 +88,16 @@ #define NO_LINE -1 /* if break point is not set by line number */ struct breakpoint { int id; - char *file; /* file where breakpoint is */ + Tcl_Obj *file; /* file where breakpoint is */ int line; /* line where breakpoint is */ - char *pat; /* pattern defining where breakpoint can be */ - regexp *re; /* regular expression to trigger breakpoint */ - char *expr; /* expr to trigger breakpoint */ - char *cmd; /* cmd to eval at breakpoint */ + int re; /* 1 if this is regexp pattern */ + Tcl_Obj *pat; /* pattern defining where breakpoint can be */ + Tcl_Obj *expr; /* expr to trigger breakpoint */ + Tcl_Obj *cmd; /* cmd to eval at breakpoint */ struct breakpoint *next, *previous; }; static struct breakpoint *break_base = 0; static int breakpoint_max_id = 0; @@ -122,89 +124,100 @@ void breakpoint_print(interp,b) Tcl_Interp *interp; struct breakpoint *b; { - print(interp,"breakpoint %d: ",b->id); - - if (b->re) { - print(interp,"-re \"%s\" ",b->pat); - } else if (b->pat) { - print(interp,"-glob \"%s\" ",b->pat); - } else if (b->line != NO_LINE) { - if (b->file) { - print(interp,"%s:",b->file); - } - print(interp,"%d ",b->line); - } - - if (b->expr) - print(interp,"if {%s} ",b->expr); - - if (b->cmd) - print(interp,"then {%s}",b->cmd); - - print(interp,"\n"); + print(interp,"breakpoint %d: ",b->id); + + if (b->re) { + print(interp,"-re \"%s\" ",Tcl_GetString(b->pat)); + } else if (b->pat) { + print(interp,"-glob \"%s\" ",Tcl_GetString(b->pat)); + } else if (b->line != NO_LINE) { + if (b->file) { + print(interp,"%s:",Tcl_GetString(b->file)); + } + print(interp,"%d ",b->line); + } + + if (b->expr) + print(interp,"if {%s} ",Tcl_GetString(b->expr)); + + if (b->cmd) + print(interp,"then {%s}",Tcl_GetString(b->cmd)); + + print(interp,"\n"); } static void -save_re_matches(interp,re) -Tcl_Interp *interp; -regexp *re; -{ - int i; - char name[20]; - char match_char;/* place to hold char temporarily */ - /* uprooted by a NULL */ - - for (i=0;istartp[i] == 0) break; - - sprintf(name,"%d",i); - /* temporarily null-terminate in middle */ - match_char = *re->endp[i]; - *re->endp[i] = 0; - Tcl_SetVar2(interp,Dbg_VarName,name,re->startp[i],0); - - /* undo temporary null-terminator */ - *re->endp[i] = match_char; - } +save_re_matches(interp, re, objPtr) +Tcl_Interp *interp; +Tcl_RegExp re; +Tcl_Obj *objPtr; +{ + Tcl_RegExpInfo info; + int i, start; + char name[20]; + + Tcl_RegExpGetInfo(re, &info); + for (i=0;i<=info.nsubs;i++) { + start = info.matches[i].start; + /* end = info.matches[i].end-1;*/ + + if (start == -1) continue; + + sprintf(name,"%d",i); + Tcl_SetVar2Ex(interp, Dbg_VarName, name, Tcl_GetRange(objPtr, + info.matches[i].start, info.matches[i].end-1), 0); + } } /* return 1 to break, 0 to continue */ static int breakpoint_test(interp,cmd,bp) Tcl_Interp *interp; char *cmd; /* command about to be executed */ struct breakpoint *bp; /* breakpoint to test */ { - if (bp->re) { - if (0 == TclRegExec(bp->re,cmd,cmd)) return 0; - save_re_matches(interp,bp->re); - } else if (bp->pat) { - if (0 == Tcl_StringMatch(cmd,bp->pat)) return 0; - } else if (bp->line != NO_LINE) { - /* not yet implemented - awaiting support from Tcl */ - return 0; - } - - if (bp->expr) { - int value; - - /* ignore errors, since they are likely due to */ - /* simply being out of scope a lot */ - if (TCL_OK != Tcl_ExprBoolean(interp,bp->expr,&value) - || (value == 0)) return 0; - } - - if (bp->cmd) { - Tcl_Eval(interp,bp->cmd); - } else { - breakpoint_print(interp,bp); - } - - return 1; + if (bp->re) { + int found = 0; + Tcl_Obj *cmdObj; + Tcl_RegExp re = Tcl_GetRegExpFromObj(NULL, bp->pat, + TCL_REG_ADVANCED); + cmdObj = Tcl_NewStringObj(cmd,-1); + Tcl_IncrRefCount(cmdObj); + if (Tcl_RegExpExecObj(NULL, re, cmdObj, 0 /* offset */, + -1 /* nmatches */, 0 /* eflags */) > 0) { + save_re_matches(interp, re, cmdObj); + found = 1; + } + Tcl_DecrRefCount(cmdObj); + if (!found) return 0; + } else if (bp->pat) { + if (0 == Tcl_StringMatch(cmd, + Tcl_GetString(bp->pat))) return 0; + } else if (bp->line != NO_LINE) { + /* not yet implemented - awaiting support from Tcl */ + return 0; + } + + if (bp->expr) { + int value; + + /* ignore errors, since they are likely due to */ + /* simply being out of scope a lot */ + if (TCL_OK != Tcl_ExprBooleanObj(interp,bp->expr,&value) + || (value == 0)) return 0; + } + + if (bp->cmd) { + Tcl_EvalObjEx(interp, bp->cmd, 0); + } else { + breakpoint_print(interp,bp); + } + + return 1; } static char *already_at_top_level = "already at top level"; /* similar to TclGetFrame but takes two frame ptrs and a direction. @@ -289,53 +302,53 @@ static char *printify(s) char *s; { - static int destlen = 0; - char *d; /* ptr into dest */ - unsigned int need; - static char buf_basic[DEFAULT_WIDTH+1]; - static char *dest = buf_basic; - - if (s == 0) return(""); - - /* worst case is every character takes 4 to printify */ - need = strlen(s)*4; - if (need > destlen) { - if (dest && (dest != buf_basic)) ckfree(dest); - dest = (char *)ckalloc(need+1); - destlen = need; - } - - for (d = dest;*s;s++) { - /* since we check at worst by every 4 bytes, play */ - /* conservative and subtract 4 from the limit */ - if (d-dest > destlen-4) break; - - if (*s == '\b') { - strcpy(d,"\\b"); d += 2; - } else if (*s == '\f') { - strcpy(d,"\\f"); d += 2; - } else if (*s == '\v') { - strcpy(d,"\\v"); d += 2; - } else if (*s == '\r') { - strcpy(d,"\\r"); d += 2; - } else if (*s == '\n') { - strcpy(d,"\\n"); d += 2; - } else if (*s == '\t') { - strcpy(d,"\\t"); d += 2; - } else if ((unsigned)*s < 0x20) { /* unsigned strips parity */ - sprintf(d,"\\%03o",*s); d += 4; - } else if (*s == 0177) { - strcpy(d,"\\177"); d += 4; - } else { - *d = *s; d += 1; - } - } - *d = '\0'; - return(dest); + static int destlen = 0; + char *d; /* ptr into dest */ + unsigned int need; + static char buf_basic[DEFAULT_WIDTH+1]; + static char *dest = buf_basic; + Tcl_UniChar ch; + + if (s == 0) return(""); + + /* worst case is every character takes 4 to printify */ + need = strlen(s)*6; + if (need > destlen) { + if (dest && (dest != buf_basic)) ckfree(dest); + dest = (char *)ckalloc(need+1); + destlen = need; + } + + for (d = dest;*s;) { + s += Tcl_UtfToUniChar(s, &ch); + if (ch == '\b') { + strcpy(d,"\\b"); d += 2; + } else if (ch == '\f') { + strcpy(d,"\\f"); d += 2; + } else if (ch == '\v') { + strcpy(d,"\\v"); d += 2; + } else if (ch == '\r') { + strcpy(d,"\\r"); d += 2; + } else if (ch == '\n') { + strcpy(d,"\\n"); d += 2; + } else if (ch == '\t') { + strcpy(d,"\\t"); d += 2; + } else if ((unsigned)ch < 0x20) { /* unsigned strips parity */ + sprintf(d,"\\%03o",ch); d += 4; + } else if (ch == 0177) { + strcpy(d,"\\177"); d += 4; + } else if ((ch < 0x80) && isprint(UCHAR(ch))) { + *d = (char)ch; d += 1; + } else { + sprintf(d,"\\u%04x",ch); d += 6; + } + } + *d = '\0'; + return(dest); } static char * print_argv(interp,argc,argv) @@ -365,12 +378,12 @@ bufp = buf + len; argc--; argv++; arg_index = 1; while (argc && (space > 0)) { - char *elementPtr; - char *nextPtr; + CONST char *elementPtr; + CONST char *nextPtr; int wrap; /* braces/quotes have been stripped off arguments */ /* so put them back. We wrap everything except lists */ /* with one argument. One exception is to always wrap */ @@ -427,11 +440,11 @@ Tcl_Obj *objv[]; { char **argv; int argc; int len; - argv = ckalloc(objc+1 * sizeof(char *)); + argv = (char **)ckalloc(objc+1 * sizeof(char *)); for (argc=0 ; argcfile) ckfree(b->file); - if (b->pat) ckfree(b->pat); - if (b->re) ckfree((char *)b->re); - if (b->cmd) ckfree(b->cmd); + if (b->file) Tcl_DecrRefCount(b->file); + if (b->pat) Tcl_DecrRefCount(b->pat); + if (b->cmd) Tcl_DecrRefCount(b->cmd); + if (b->expr) Tcl_DecrRefCount(b->expr); /* unlink from chain */ if ((b->previous == 0) && (b->next == 0)) { break_base = 0; } else if (b->previous == 0) { @@ -771,16 +784,16 @@ ckfree((char *)b); } static void -savestr(straddr,str) -char **straddr; +savestr(objPtr,str) +Tcl_Obj **objPtr; char *str; { - *straddr = ckalloc(strlen(str)+1); - strcpy(*straddr,str); + *objPtr = Tcl_NewStringObj(str, -1); + Tcl_IncrRefCount(*objPtr); } /* return 1 if a string is substring of a flag */ static int flageq(flag,string,minlen) @@ -878,13 +891,19 @@ b = breakpoint_new(); if (flageq("-regexp",argv[0],2)) { argc--; argv++; - if ((argc > 0) && (b->re = TclRegComp(argv[0]))) { - savestr(&b->pat,argv[0]); - argc--; argv++; + if (argc > 0) { + b->re = 1; + savestr(&b->pat,argv[0]); + if (Tcl_GetRegExpFromObj(interp, b->pat, TCL_REG_ADVANCED) + == NULL) { + breakpoint_destroy(b); + return TCL_ERROR; + } + argc--; argv++; } else { breakpoint_fail("bad regular expression") } } else if (flageq("-glob",argv[0],2)) { argc--; argv++; @@ -915,11 +934,11 @@ argc--; argv++; print(interp,"setting breakpoints by line number is currently unimplemented - use patterns or expressions\n"); } else { /* not an int? - unwind & assume it is an expression */ - if (b->file) ckfree(b->file); + if (b->file) Tcl_DecrRefCount(b->file); } } if (argc > 0) { int do_if = FALSE; @@ -1279,15 +1298,16 @@ /* should only be used in safe places */ /* i.e., when Tcl_Eval can be called */ { if (!debugger_active) init_debugger(interp); - /* intuitively, it would seem natural to initialize the - debugger with the step command. However, it's too late at - this point. It must be done before the command reader - (whatever it is) has gotten control. */ - /* debug_cmd = step;*/ + /* Initialize debugger in single-step mode. + * + * Note: if the command reader is already active, it's too late + * which is why we also statically initialize debug_cmd to step. + */ + debug_cmd = step; step_count = 1; if (immediate) { static char *fake_cmd = "--interrupted-- (command_unknown)"; Index: DbgMkfl.in ================================================================== --- DbgMkfl.in +++ DbgMkfl.in @@ -210,10 +210,14 @@ # Targets for pushing out releases ###################################### FTPDIR = /proj/itl/www/div826/subject/expect/tcl-debug +# make a private tar file for myself +tar: tcl-debug-$(VERSION).tar + mv tcl-debug-$(VERSION).tar tcl-debug.tar + ftp: tcl-debug-$(VERSION).tar.Z tcl-debug-$(VERSION).tar.gz cp tcl-debug-$(VERSION).tar.Z $(FTPDIR)/tcl-debug.tar.Z cp tcl-debug-$(VERSION).tar.gz $(FTPDIR)/tcl-debug.tar.gz cp HISTORY $(FTPDIR) cp README $(FTPDIR)/README.distribution Index: Dbgconfig.in ================================================================== --- Dbgconfig.in +++ Dbgconfig.in @@ -9,15 +9,18 @@ DBG_VERSION_FULL=$DBG_VERSION.$DBG_MICRO_VERSION # Tcl's handling of shared_lib_suffix requires this symbol exist VERSION=$DBG_MAJOR_VERSION.$DBG_MINOR_VERSION AC_CONFIG_HEADER(tcldbgcf.h) + +OLD_CFLAGS=$CFLAGS +AC_PROG_CC +CFLAGS=$OLD_CFLAGS CY_AC_PATH_TCLCONFIG CY_AC_LOAD_TCLCONFIG CC=$TCL_CC -AC_PROG_CC CY_AC_C_WORKS # this'll use a BSD compatible install or our included install-sh AC_PROG_INSTALL Index: Dbgconfigure ================================================================== --- Dbgconfigure +++ Dbgconfigure @@ -1,9 +1,9 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.11 +# Generated automatically using autoconf version 2.9 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. @@ -57,12 +57,10 @@ mandir='${prefix}/man' # Initialize some other variables. subdirs= MFLAGS= MAKEFLAGS= -# Maximum number of lines to put in a shell here document. -ac_max_here_lines=12 ac_prev= for ac_option do @@ -340,11 +338,11 @@ -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.11" + echo "configure generated by autoconf version 2.9" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. @@ -533,10 +531,136 @@ # Tcl's handling of shared_lib_suffix requires this symbol exist VERSION=$DBG_MAJOR_VERSION.$DBG_MINOR_VERSION +OLD_CFLAGS=$CFLAGS +# Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="gcc" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + ac_prog_rejected=no + for ac_dir in $PATH; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + break + fi + done + IFS="$ac_save_ifs" +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# -gt 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + set dummy "$ac_dir/$ac_word" "$@" + shift + ac_cv_prog_CC="$@" + fi +fi +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + + test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } +fi + +echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 +if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then + ac_cv_prog_gcc=yes +else + ac_cv_prog_gcc=no +fi +fi + +echo "$ac_t""$ac_cv_prog_gcc" 1>&6 +if test $ac_cv_prog_gcc = yes; then + GCC=yes + if test "${CFLAGS+set}" != set; then + echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 +if eval "test \"`echo '$''{'ac_cv_prog_gcc_g'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + echo 'void f(){}' > conftest.c +if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then + ac_cv_prog_gcc_g=yes +else + ac_cv_prog_gcc_g=no +fi +rm -f conftest* + +fi + +echo "$ac_t""$ac_cv_prog_gcc_g" 1>&6 + if test $ac_cv_prog_gcc_g = yes; then + CFLAGS="-g -O" + else + CFLAGS="-O" + fi + fi +else + GCC= + test "${CFLAGS+set}" = set || CFLAGS="-g" +fi + +CFLAGS=$OLD_CFLAGS + # # Ok, lets find the tcl configuration # First, look for one uninstalled. # the alternative search directory is invoked by --with-tclconfig @@ -550,11 +674,10 @@ withval="$with_tclconfig" with_tclconfig=${withval} fi echo $ac_n "checking for Tcl configuration""... $ac_c" 1>&6 -echo "configure:556: checking for Tcl configuration" >&5 if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else @@ -622,11 +745,11 @@ - + # Tcl defines TCL_SHLIB_SUFFIX but TCL_SHARED_LIB_SUFFIX then looks for it # as just SHLIB_SUFFIX. How bizarre. @@ -638,27 +761,28 @@ # if Tcl's build directory has been removed, TCL_LIB_SPEC should # be used instead of TCL_BUILD_LIB_SPEC SAVELIBS=$LIBS # eval used to expand out TCL_DBGX eval "LIBS=\"$TCL_BUILD_LIB_SPEC $TCL_LIBS\"" +echo $ac_n "checking Tcl build library""... $ac_c" 1>&6 +echo "$ac_t""$LIBS" 1>&6 + echo $ac_n "checking for Tcl_CreateCommand""... $ac_c" 1>&6 -echo "configure:645: checking for Tcl_CreateCommand" >&5 if eval "test \"`echo '$''{'ac_cv_func_Tcl_CreateCommand'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char Tcl_CreateCommand(); -int main() { +int main() { return 0; } +int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_Tcl_CreateCommand) || defined (__stub___Tcl_CreateCommand) @@ -667,16 +791,14 @@ Tcl_CreateCommand(); #endif ; return 0; } EOF -if { (eval echo configure:673: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:797: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_Tcl_CreateCommand=yes" else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_Tcl_CreateCommand=no" fi rm -f conftest* @@ -683,21 +805,19 @@ fi if eval "test \"`echo '$ac_cv_func_'Tcl_CreateCommand`\" = yes"; then echo "$ac_t""yes" 1>&6 echo $ac_n "checking if Tcl library build specification is valid""... $ac_c" 1>&6 -echo "configure:689: checking if Tcl library build specification is valid" >&5 echo "$ac_t""yes" 1>&6 else echo "$ac_t""no" 1>&6 TCL_BUILD_LIB_SPEC=$TCL_LIB_SPEC # Can't pull the following CHECKING call out since it will be # broken up by the CHECK_FUNC just above. echo $ac_n "checking if Tcl library build specification is valid""... $ac_c" 1>&6 -echo "configure:699: checking if Tcl library build specification is valid" >&5 echo "$ac_t""no" 1>&6 fi LIBS=$SAVELIBS @@ -707,212 +827,44 @@ CC=$TCL_CC -# Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:716: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="gcc" - break - fi - done - IFS="$ac_save_ifs" -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:745: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - ac_prog_rejected=no - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - break - fi - done - IFS="$ac_save_ifs" -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# -gt 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - set dummy "$ac_dir/$ac_word" "$@" - shift - ac_cv_prog_CC="$@" - fi -fi -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - - test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } -fi - -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:793: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 - -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' - -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - ac_cv_prog_cc_works=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_prog_cc_works=no -fi -rm -f conftest* - - -echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 -if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: Installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } -fi - -echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:827: checking whether we are using GNU C" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - ac_cv_prog_gcc=yes -else - ac_cv_prog_gcc=no -fi -fi - -echo "$ac_t""$ac_cv_prog_gcc" 1>&6 - -if test $ac_cv_prog_gcc = yes; then - GCC=yes - ac_test_CFLAGS="${CFLAGS+set}" - ac_save_CFLAGS="$CFLAGS" - CFLAGS= - echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:851: checking whether ${CC-cc} accepts -g" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_gcc_g'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - echo 'void f(){}' > conftest.c -if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_gcc_g=yes -else - ac_cv_prog_gcc_g=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$ac_cv_prog_gcc_g" 1>&6 - if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" - elif test $ac_cv_prog_gcc_g = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-O2" - fi -else - GCC= - test "${CFLAGS+set}" = set || CFLAGS="-g" -fi - # If we cannot compile and link a trivial program, we can't expect anything to work echo $ac_n "checking whether the compiler ($CC) actually works""... $ac_c" 1>&6 -echo "configure:880: checking whether the compiler ($CC) actually works" >&5 cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:844: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* c_compiles=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* c_compiles=no fi rm -f conftest* cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:863: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* c_links=yes else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* c_links=no fi rm -f conftest* @@ -956,11 +908,10 @@ # AIX /bin/install # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:962: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" @@ -1010,11 +961,10 @@ # Tcl sets TCL_RANLIB appropriately for shared library if --enable-shared # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1016: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -1046,11 +996,10 @@ # -X is for the old "cc" and "gcc" (based on 1.42) # -mposix is for the new gcc (at least 2.5.8) # This modifies the value of $CC to have the POSIX flag added # so it'll configure correctly echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:1052: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then @@ -1061,41 +1010,37 @@ # substituted into the Makefile and "${CC-cc}" will confuse make. CPP="${CC-cc} -E" # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1073: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1022: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1090: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1037: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : else echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* CPP=/lib/cpp fi rm -f conftest* fi @@ -1108,16 +1053,15 @@ fi echo "$ac_t""$CPP" 1>&6 echo $ac_n "checking if running LynxOS""... $ac_c" 1>&6 -echo "configure:1114: checking if running LynxOS" >&5 if eval "test \"`echo '$''{'ac_cv_os_lynx'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <> confdefs.h <<\EOF #define LYNX 1 EOF echo $ac_n "checking whether -mposix or -X is available""... $ac_c" 1>&6 -echo "configure:1149: checking whether -mposix or -X is available" >&5 if eval "test \"`echo '$''{'ac_cv_c_posix_flag'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1114: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_posix_flag=" -mposix" else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_c_posix_flag=" -X" fi rm -f conftest* @@ -1195,11 +1137,10 @@ # be careful that we don't match stuff like tclX by accident. # the alternative search directory is involked by --with-tclinclude # no_tcl=true echo $ac_n "checking for Tcl private headers""... $ac_c" 1>&6 -echo "configure:1201: checking for Tcl private headers" >&5 # Check whether --with-tclinclude or --without-tclinclude was given. if test "${with_tclinclude+set}" = set; then withval="$with_tclinclude" with_tclinclude=${withval} fi @@ -1259,31 +1200,28 @@ fi done fi # see if one is installed if test x"${ac_cv_c_tclh}" = x ; then - ac_safe=`echo "tclInt.h" | sed 'y%./+-%__p_%'` + ac_safe=`echo "tclInt.h" | tr './\055' '___'` echo $ac_n "checking for tclInt.h""... $ac_c" 1>&6 -echo "configure:1267: checking for tclInt.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1277: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1217: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi @@ -1332,11 +1270,10 @@ exit 1 fi # Use -g on all systems but Linux where it upsets the dynamic X libraries. echo $ac_n "checking if we are running Linux""... $ac_c" 1>&6 -echo "configure:1338: checking if we are running Linux" >&5 if test "x`(uname) 2>/dev/null`" = xLinux; then echo "$ac_t""yes" 1>&6 linux=1 DBG_CFLAGS= else @@ -1347,26 +1284,24 @@ # # Look for functions that may be missing # echo $ac_n "checking for strchr""... $ac_c" 1>&6 -echo "configure:1353: checking for strchr" >&5 if eval "test \"`echo '$''{'ac_cv_func_strchr'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ char strchr(); -int main() { +int main() { return 0; } +int t() { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_strchr) || defined (__stub___strchr) @@ -1375,16 +1310,14 @@ strchr(); #endif ; return 0; } EOF -if { (eval echo configure:1381: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1316: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_strchr=yes" else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_strchr=no" fi rm -f conftest* @@ -1401,31 +1334,28 @@ # # Look for various header files # -ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'` +ac_safe=`echo "stdlib.h" | tr './\055' '___'` echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6 -echo "configure:1409: checking for stdlib.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1419: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1351: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_header_$ac_safe=no" fi rm -f conftest* fi @@ -1462,11 +1392,10 @@ DBG_UNSHARED_LIB_FILE=libtcldbg.a echo $ac_n "checking type of library to build""... $ac_c" 1>&6 -echo "configure:1468: checking type of library to build" >&5 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" enable_shared=yes else @@ -1521,13 +1450,12 @@ # --recheck option to rerun configure. # EOF # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. -# HP-UX 10.01 sh prints single quotes around any value that contains spaces. (set) 2>&1 | -sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)='*\([^']*\)'*/\1=\${\1='\2'}/p"\ + sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \ >> confcache if cmp -s $cache_file confcache; then : else if test -w $cache_file; then @@ -1579,11 +1507,11 @@ case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.11" + echo "$CONFIG_STATUS generated by autoconf version 2.9" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac @@ -1620,20 +1548,21 @@ s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g +s%@CC@%$CC%g s%@TCL_DEFS@%$TCL_DEFS%g s%@TCL_DELETEME@%$TCL_DELETEME%g s%@TCL_DBGX@%$TCL_DBGX%g +s%@TCL_EXEC_PREFIX@%$TCL_EXEC_PREFIX%g s%@TCL_SHLIB_LD@%$TCL_SHLIB_LD%g s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g s%@TCL_LD_FLAGS@%$TCL_LD_FLAGS%g s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g -s%@CC@%$CC%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@RANLIB@%$RANLIB%g s%@CPP@%$CPP%g s%@TCLHDIR@%$TCLHDIR%g @@ -1652,46 +1581,10 @@ s%@DBG_CFLAGS@%$DBG_CFLAGS%g s%@UNSHARED_RANLIB@%$UNSHARED_RANLIB%g CEOF EOF - -cat >> $CONFIG_STATUS <<\EOF - -# Split the substitutions into bite-sized pieces for seds with -# small command number limits, like on Digital OSF/1 and HP-UX. -ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. -ac_file=1 # Number of current file. -ac_beg=1 # First line for current file. -ac_end=$ac_max_sed_cmds # Line after last line for current file. -ac_more_lines=: -ac_sed_cmds="" -while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file - else - sed "${ac_end}q" conftest.subs > conftest.s$ac_file - fi - if test ! -s conftest.s$ac_file; then - ac_more_lines=false - rm -f conftest.s$ac_file - else - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f conftest.s$ac_file" - else - ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" - fi - ac_file=`expr $ac_file + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_cmds` - fi -done -if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat -fi -EOF - cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF @@ -1701,11 +1594,11 @@ *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac - # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + # Adjust relative srcdir, etc. for subdirectories. # Remove last slash and all that follows it. Not all systems have dirname. ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then # The file is in a subdirectory. @@ -1729,11 +1622,10 @@ case "$ac_given_INSTALL" in [/$]*) INSTALL="$ac_given_INSTALL" ;; *) INSTALL="$ac_dots$ac_given_INSTALL" ;; esac - echo creating "$ac_file" rm -f "$ac_file" configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." case "$ac_file" in *Makefile*) ac_comsub="1i\\ @@ -1743,13 +1635,13 @@ sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g s%@INSTALL@%$INSTALL%g -" $ac_given_srcdir/$ac_file_in | eval "$ac_sed_cmds" > $ac_file +" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file fi; done -rm -f conftest.s* +rm -f conftest.subs # These sed commands are passed to sed as "A NAME B NAME C VALUE D", where # NAME is the cpp macro being defined and VALUE is the value it is being given. # # ac_d sets the value in "#define NAME VALUE" lines. @@ -1766,17 +1658,11 @@ ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_eB='$%\1#\2define\3' ac_eC=' ' ac_eD='%g' -if test -z "$CONFIG_HEADERS"; then -EOF -cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF -fi +CONFIG_HEADERS=${CONFIG_HEADERS-"tcldbgcf.h"} for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then # Support "outfile[:infile]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; @@ -1812,10 +1698,12 @@ s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */% EOF # Break up conftest.vals because some shells have a limit on # the size of here documents, and old seds have small limits too. +# Maximum number of lines to put in a single here document. +ac_max_here_lines=12 rm -f conftest.tail while : do ac_lines=`grep -c . conftest.vals` @@ -1842,16 +1730,10 @@ rm -f conftest.in if cmp -s $ac_file conftest.h 2>/dev/null; then echo "$ac_file is unchanged" rm -f conftest.h else - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - fi rm -f $ac_file mv conftest.h $ac_file fi fi; done Index: HISTORY ================================================================== --- HISTORY +++ HISTORY @@ -1,10 +1,261 @@ This is the HISTORY file for Expect. Modifications made by Cygnus support are in ChangeLog. - Don Date Version Description ------- ------- ------------------------------------------------------ +12/20/01 5.34.0 Don Porter provided package-related + fixes for test suite. + + Brian Theado noted that interact's -re + support broke when offsets kicked in. Turned out that the + regexp engine supports them during execution but the results + are delivered RELATIVE to the offset. (I suspect this was done + due to expediency.) + +10/1/01 5.33.0 found that expect's diagnostics + didn't include the "no" after testing for a full buffer. + + Hemang Lavana noted that "debug" (Dbg_On) + calls didn't always force the debugger into step mode. + + Martin Kammerhofer noted that the man + page neglected to document interpreter -eof. + + Chris Clare provided fix for + multiple decl in C lib. + + Sheng Wang found interact's + can-match code had broken. It was missing the special hook + that Henry had added just for this purpose. How strange. + + Dieter Fiebelkorn requested addition + to config.guess for Power*Macintosh:Darwin for MacOSX. + Aside - to download latest config.guess: + cvs -d :pserver:anoncvs@subversions.gnu.org:/cvs checkout \ + config + + Added pipeline example to unbuffer man page. + +8/4/00 5.32.2 Allen J. Newton provided code for + generating passwords with special characters in mkpasswd. + + Brent Welch changed the fix1line + install script so that "autoexpect" and other scripts that + get installed into the platform-independent bin directory + generically invoke "expect" from the users PATH instead + of hardwiring the platform-specific expect pathname. + + TclPro 1.4 released with 5.32.2 bundled. + +7/13/00 5.32.1 Uwe Klein reported segfaults from reading + nulls. Due to code rewrite in 5.30->5.31 transition. + +5/14/00 5.32.0 New version for timing with Ajuba TclPro 1.4. This version + of Expect has no new features or behaviors but a lot has been + fixed since 5.31.0. + + Martin Buchholz noted that his + alphaev56-dec-osf4.0e has ptmx and ptmx_bsd (and ptm, pts, + pty, ptym). He suggested that BSD things are now usually + deprecated so to skip ptmx_bsd if ptmx avail. + + Chang Li noted that debugger's bp cmd + broke on every command. Was a bug in breakpoint_trace from + when we installed the new regexp engine. + + Jonathan Kamens fixed printf formats in several pty diags. + + rm_nulls -d was set to wrong value. + +5/12/00 5.31.8 After receiving yet another request for fully versioned + archives, gave in. + + Signal handler sometimes sent error to stderr inappropriately. + +4/27/00 5.31.7 Rob Savoye fixed Debian ptys and properly checking of libpt. + +3/8/00 5.31.6 Petrus Vloet noted that Expect + installed tclRegexp.h which included regex.h which of course + misbehaves when it reads the system's version. This is new + since 8.0. Since I need to revise the Clib anyway (which + is what this install was for), I'll back this out for now. + +3/6/00 5.31.5 Larry Virden noted that configure checked for threads twice. + +2/19/00 5.31.4 Omer Azmon note errors in + pty_termios.c in exp_pty_test that caused problems during + pty testing. + + Jeffrey Hobbs recommended having configure accept and warn + about --enable-threads. + + John Ellson noted configure's autoconf + testing had leftover debugging code. Also provided a fix for + building w/shared libs on HP - appeared to be leftover from + earlier Tcl-required configuration that has now disappeared. + + Susan Muston noted that exp_wait with + no spawned processes exited immediately which is different + than 5.29 behavior which reported "no children". This new + behavior was evidentally a gratuitous change during the + channel driver addition. Backed out. At the same time, + neither behavior matches documentation - doc should be fixed + and improved except I'm not sure if the behavior should yet + be something else (depending if stdin closed or not). + + istvan.nadas@epfl.ch reported "spawn cat;exp_open" failed. + Uninited variable. + + Scriptics reported memory leak. Was bug in parse_expect_args. + + "Michael P. Reilly" noted clib was hanging + in spawn code. status_pipe wasn't being closed. + + Egil Kvaleberg provided fix due to new gcc + which defines strchr as a macro. + + Dave Morrison noted some printfs + in exp_log.c that misinterpreted embedded %'s with resulting + core dumps. + + Dick Goodwin noted that "system echo + foo" returned with no apparent effect. Due to closeonexec + in expect's channel driver. Added skip if std channel. + Fixed similar bug in stty command. Minor bug left in stty + which isn't passing output back from underlying exec. + + Stacy W. Smith provided patch that uses + sigsetjmp instead of setjmp that he says fixes a problem he + encountered with C lib where it stopped timing out in expect() + as if the signals were corrupted. The man page doesn't + explain the difference between these calls in a way that makes + sense as to why they should make a difference, but I'll the + names are certainly suggestive so I'll try it. He says "it + appears that the linux setjmp behaves a little differently + compared to setjmp on some other OSs. Specifically, setjmp + on linux does not save the signal context. It seems most + BSDish OSs do save the signal context with setjmp. On those + machines, it appears setjmp(env) is equivalent to + sigsetjmp(env,1) whereas on linux, setjmp(env) is equivalent + to sigsetjmp(env,0). My patch made a (probably bad) + assumption that if siglongjmp() exists that we should use + the sigXXX versions. I specifically tested for siglongjmp + rather than sigsetjmp because on linux, sigsetjmp is just a + #define for __sigsetjmp. It appears that linux will give + the BSD behaviour if __FAVOR_BSD is defined, but I didn't + know what other implications that might have. + + Michael Schumacher provided fix so that test for whether + configure was out-of-date worked when not using the default + build dir. + +11/1/99 5.31.3 Shlomi Mahlab noted all.tcl in CVS + but not distribution. + + More notes from Keith Brown on HP cc complaints in exp_pty.c. + +10/28/99 5.31.2 "Keith Brown" noted that HP cc + objected to auto aggregate initialization in + expLogChannelOpen. + +10/22/99 5.31.1 Official release! + + P Darcy Barnett noted Makefile could + produce "autoconf not found" for non-developers using CVS. + Made configure detect and provide advice on workaround. + + Fixed bug in interact -echo exhibited in rftp example. + + Ryan Murray noted Expect wasn't + handling handling 8-bit bytes correctly. I had accidentally + used Tcl_Write instead of Tcl_WriteChar. + + Ashley Pittman noted that digital unix + V5.0 prefers openpty (4000 ptys) over ptmx (60 ptys), so I'm + reversing the login in pty_termios.c. This also controls + linux, but no linux hackers have weighed in on this subject + yet. + + Andrew Tannenbaum noted exp_internal + command and "expect -exact" were broken. + +6/29/99 5.31.0 See the NEWS file for this date for an overview. (I'm + too tired to add all the details. Maybe later.) + + Fixed exp_clib so that it immediately reported failure of + exec (in spawn) rather than passing it back through pipe. + + Removed error checking from ioctl(TIOCSCTTY) to pacify the + variety of (but not all) Linux systems and a few others which + define TIOCSCTTY but return an error although seem to work + anyway. + + Added configure test for 0 vs 2-arg setpgrp. + + Kenji Kamizono noted it was possible + to compile Linux (2.2.5) so that it recognized both openpty + and ptmx leading to conflicts. I arbitrarily chose ptmx. + +10/15/99 5.30.2 Herve Tireford noted extraneous + sleep(20) in clib. Apparently left over from debugging, oops. + +8/18/99 5.30.1 Added test for newer versions of Tcl that are incompatible. + + Kenji Kamizono noted it was possible + to compile Linux (2.2.5) so that it recognized both openpty + and ptmx leading to conflicts. I arbitrarily chose ptmx. + +4/1/99 5.30.0 Martin Forssen provided fix to allow configure + to start with LDFLAGS from environment. + + Paul Tazzyman noted that log_file didn't + check for logging twice without turning off logging first. + + Ben provided updated host for + weather example. + + Jonathon Kamens noted that Expect didn't build properly if + Tcl and/or Tk used build/install directories out of the usual + hierarchy. At the same time, I fixed a number of other related + problems in Makefile/configure. + + Pierre Pomes provided fix + to ftp-inband. It blew up from an unprotected send that + was handed a uuencoded line that started with a -. + + Autoexpect was thrown off by simple-minded [file executable] + test picking up expect directory while searching for + executable. + +1/21/99 5.29.0 Martin Forssen provides mods to support INSTALL_ROOT. + + Bryan Surles modified configure.in to + map DBGX to the same value as TCL_DBGX so the .so is named + correctly. + + Suresh Sastry forced $LIBS to be + added to EXP_SHLIB_LD_LIBS. It's not clear to me why this is + necessary (since Tk doesn't) but he was having a problem + with openpty not being found during runtime on Linux. + + Martin Forssen noted expectk was crashing if a Tcl error was + encountered. He found that exp_exit_handlers() was trying + to write into interp->result after interp had been deleted. + + Added another copy to distribution site - with version number. + + Stanislav Shalunov closed race in pty code. + + Fixed man page: -brace should be -nobrace. + + Dan O'Brien noted that Expect needed to + call Tcl_FindExecutable at startup for info nameofexecutable. + + Robbie Gilbert noted indirect spawn + ids occasionally failed. Fixed. + 9/30/98 5.28.1 Brian France noted that his compiler rejected label with no statement. 9/28/98 5.28.0 Fixed two bugs in tcl-debugger (see that HISTORY file). @@ -42,11 +293,11 @@ didn't see a definition for SHELL and HOME. They need to be set. (Doesn't have to be anything useful; the empty string is fine!) Solution: documented this in Expect man page. Zachariah Baum noted that config.sub - didn't grok Intel 686. Found a newer version that did in + didn't recognize Intel 686. Found a newer version that did in autoconf-2.11. POTENTIAL INCOMPATIBILITY: Changed interact so that it observes parity while matching. It used to ignore parity. This impacts people who use interact to connect through to a real serial @@ -245,11 +496,11 @@ 8/12/96 5.20b17 Glen Biagioni noted interact -re "A(xx)" failed to match. Problem turned out to be that Tcl 7.5 changed a constant which in the regexp code, which Expect didn't see because it provides its own defn for interact. Alas, the one thing Expect reuses from Tcl was where the change was. This - should really be fixed so Expect doesn't rely on Expect in this + should really be fixed so Expect doesn't rely on Tcl in this way, but there's no point in putting in a lot of work on regexp when we're anticipating a new one soon anyway. Bjorn S. Nilsson noted fixcat hangs. Turned out that new Tcl (7.5p1) now waits for all children to @@ -1616,11 +1867,11 @@ 4/12/93 4.5.1 At request of Rusty Wilson , added "-console" to spawn. Pang Wai Man Raymond reported that - passmass didn't grok DEC's passwd prompts for root. + passmass didn't recognize DEC's passwd prompts for root. 4/7/93 4.5.0 Fixed bug in interact regexp preventing match of multichar literals. 4/6/93 4.4.3 Bennett Todd noted missing example scripts @@ -1649,12 +1900,11 @@ Added command "parity" to enable parity stripping. Fixed match_max to do -i correctly. 3/15/93 4.2.4 Fixed to work on new SGI which returns slave-close via excep - (select) or POLLERR (poll) rather than thru read(). Why do you - people do things like this? + (select) or POLLERR (poll) rather than thru read(). 3/12/93 4.2.3 Fixed to work on AIX (using /dev/ptc) and UTS (using getpty). 3/11/93 4.2.1-2 Fixed numerous bugs relating to HP ptys. It's amazing that for their bewildering complexity, they couldn't support generation @@ -1940,13 +2190,12 @@ 2/21/92 3.18.0 Worked on the HP port some more. The HP causes a real problem by insisting SIGCLD be delivered in order for wait to return a status. This royally complicated the code, partly because of the special casing all over the place in the trap command, the asynchronous delivery of SIGCLD and also because Tcl itself - is not prepared to have system calls be interrupted. Cleverly, - the HP also defines both CLD and CHLD which threw my macros - off at first. Thanks, but I don't this kind of help! + is not prepared to have system calls be interrupted. The HP + also defines both CLD and CHLD which threw my macros off. Anyway, the end result is that on the HP, SIGCLD is ignored. The manual claims wait status will not be delivered but it seems to be anyway. Good grief! (Even if it were ignored, it would not be such a calamity, since wait is used mainly @@ -1963,11 +2212,11 @@ Bob Proulx and Jeff Okamoto supplied me with patches for inter_select.c. HP transmits some pty interactions via the exception field in select. - Michael Grant gave me a mod to grok ~ in the logfile and + Michael Grant gave me a mod to recognize ~ in the logfile and debug commands. 2/17/92 3.17.1 Brian Keves pointed out that the man page still referred to "expect_match" instead of "expect_out". @@ -2204,11 +2453,11 @@ 10/31/91 3.3.0 Converted most of the examples. Three more to go. Worked on man page some more. Modified expect so that if timeout > 0, and nothing in the buffer matched, it will force a read, no matter how long the - preceeding code took. This may be hard to understand, but is + preceding code took. This may be hard to understand, but is the intuitive behavior that I always desired. 10/30/91 3.2.0 Fixed bug in eof handling. Converted some more of the examples, and added to Makefile. @@ -2922,13 +3171,13 @@ 3/16/90 Am really irritated by USENIX. My paper has been put in a session against another session, the BSD people. Furthermore, they called my paper an application, when it is no more so than any other shell or language. Better I should be in "lessons - learned". Mashey said take a hike, i.e., it was too late to - change the schedule. On top of that, our session has four - people in it, so I'll have very little time to speak. Grrrr. + learned". But it was too late to change the schedule. On top + of that, our session has four people in it, so I'll have very + little time to speak. Grrrr. 3/13/90 1.6 Added "stty", because without it you can't do things like turning off echo to accept a password. 3/8/90 1.5 Abstract was accepted into USENIX!!!! Time to start writing Index: INSTALL ================================================================== --- INSTALL +++ INSTALL @@ -80,13 +80,14 @@ -------------------- Trying Expect Without Installing Tcl -------------------- Once expect is built, you can try it out. If Tcl has not been -installed, you will need to define the environment variable -TCL_LIBRARY. It should name the directory contain the Tcl libraries. -For example, if you are using csh with Tcl 8.0.3: +installed (but it has been compiled), you will need to define the +environment variable TCL_LIBRARY. It should name the directory +contain the Tcl libraries. For example, if you are using csh with Tcl +8.0.3: $ setenv TCL_LIBRARY ../tcl8.0.3/library Now you can run expect. @@ -137,17 +138,21 @@ that way. It is not safe to modify the Makefile to use gcc by hand. If you do this, then information related to dynamic linking will be incorrect. - --with-tclconfig=... Specifies the directory containing Tcl's + --enable-threads This switch is ignored so that you can + configure Expect with the same configure + command as Tcl. + + --with-tcl=... Specifies the directory containing Tcl's configure file (tclConfig.sh). --with-tclinclude=... Specifies the directory containing Tcl's private include files (such as tclInt.h) - --with-tkconfig=... Specifies the directory containing Tk's + --with-tk=... Specifies the directory containing Tk's configure file (tkConfig.sh). --with-tkinclude=... Specifies the directory containing Tk's private include files (such as tkInt.h) @@ -184,14 +189,14 @@ release you want. If you can't or don't want to create symbolic links, you can instead indicate where Tcl and Tk are by using the following environment variables: -with_tclconfig Directory containing Tcl configure file (tclConfig.h) +with_tcl Directory containing Tcl configure file (tclConfig.h) with_tclinclude Directory containing Tcl include files with_tkinclude Directory containing Tk include files -with_tkconfig Directory containing Tk binary library (tkConfig.h) +with_tk Directory containing Tk binary library (tkConfig.h) -------------------- Multiple-Architecture Installation -------------------- Index: Makefile.in ================================================================== --- Makefile.in +++ Makefile.in @@ -59,12 +59,13 @@ # the linker from using them. So do not use -g on such systems. CFLAGS = @CFLAGS@ #XCFLAGS = @CFLAGS@ @EXP_CFLAGS@ @EXP_SHLIB_CFLAGS@ XCFLAGS = @CFLAGS@ @EXP_CFLAGS@ -# Tcl libraries built with optimization switches have this additional extension +# Libraries built with optimization switches have this additional extension TCL_DBGX = @TCL_DBGX@ +TK_DBGX = @TK_DBGX@ # From now on, CFLAGS is never used. Instead, use XCFLAGS. This is done so # that we can provide a public interface for CFLAGS thereby allowing users # to add to it on the Make command-line and still get the rest of the flags # computed by configure. Do this at your own risk - it obvious goes against @@ -92,10 +93,17 @@ prefix = @prefix@ # You can specify a separate installation prefix for architecture-specific # files such as binaries and libraries. exec_prefix = @exec_prefix@ + +# The following definition can be set to non-null for special systems +# like AFS with replication. It allows the pathnames used for installation +# to be different than those used for actually reference files at +# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix +# when installing files. +INSTALL_ROOT = # The following Expect scripts are not necessary to have installed as # commands, but are very useful. Edit out what you don't want installed. # The INSTALL file describes these and others in more detail. # Some Make's screw up if you delete all of them because SCRIPTS is a @@ -159,21 +167,21 @@ # End of things you may want to change # # Do not change anything after this ###################################################################### -bindir = @bindir@ -bindir_arch_indep = $(prefix)/bin -tcl_libdir = @libdir@ -libdir = @libdir@/expect$(VERSION) -libdir_arch_indep = $(prefix)/lib/expect$(VERSION) +bindir = $(INSTALL_ROOT)@bindir@ +bindir_arch_indep = $(INSTALL_ROOT)$(prefix)/bin +tcl_libdir = $(INSTALL_ROOT)@libdir@ +libdir = $(INSTALL_ROOT)@libdir@/expect$(VERSION) +libdir_arch_indep = $(INSTALL_ROOT)$(prefix)/lib/expect$(VERSION) -mandir = @mandir@ +mandir = $(INSTALL_ROOT)@mandir@ man1dir = $(mandir)/man1 man3dir = $(mandir)/man3 -infodir = @infodir@ -includedir = @includedir@ +infodir = $(INSTALL_ROOT)@infodir@ +includedir = $(INSTALL_ROOT)@includedir@ # Expect's utility script directories - arch-independent and arch-non- # independent. These correspond to the variables "exp_library" and # "exp_exec_library". SCRIPTDIR = $(libdir_arch_indep) @@ -186,11 +194,11 @@ INSTALL_DATA = @INSTALL_DATA@ AR = ar ARFLAGS = cr -LOCAL_EXPECT=LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH ./expect +LOCAL_EXPECT=LD_LIBRARY_PATH=.:@TCL_EXEC_PREFIX@/lib:$(tcl_libdir):$$LD_LIBRARY_PATH ./expect # These definitions are used by the "subdirs_do" target to pass # the compile flags down recursively. FLAGS_TO_PASS = \ "CC=$(CC)" \ @@ -227,27 +235,30 @@ PTY_TYPE = @PTY_TYPE@ PTY = pty_$(PTY_TYPE) CFILES = exp_command.c expect.c $(PTY).c \ exp_inter.c exp_regexp.c exp_tty.c \ exp_log.c exp_main_sub.c exp_pty.c \ - exp_printify.c exp_trap.c exp_strf.c \ - exp_console.c exp_glob.c exp_win.c Dbg.c exp_clib.c \ + exp_trap.c exp_strf.c \ + exp_console.c exp_glob.c exp_win.c exp_clib.c \ exp_closetcl.c exp_memmove.c exp_tty_comm.c \ - exp_$(EVENT_TYPE).c exp_$(EVENT_ABLE).c + exp_$(EVENT_TYPE).c exp_$(EVENT_ABLE).c \ + exp_chan.c Dbg.c OFILES = exp_command.o expect.o $(PTY).o exp_inter.o exp_regexp.o exp_tty.o \ - exp_log.o exp_main_sub.o exp_pty.o exp_printify.o exp_trap.o \ - exp_console.o exp_strf.o exp_glob.o exp_win.o Dbg.o exp_clib.o \ + exp_log.o exp_main_sub.o exp_pty.o exp_trap.o \ + exp_console.o exp_strf.o exp_glob.o exp_win.o exp_clib.o \ exp_closetcl.o exp_memmove.o exp_tty_comm.o \ - exp_$(EVENT_TYPE).o exp_$(EVENT_ABLE).o + exp_$(EVENT_TYPE).o exp_$(EVENT_ABLE).o \ + exp_chan.o Dbg.o SHARED_OFILES = shared/exp_command.o shared/expect.o shared/$(PTY).o \ shared/exp_inter.o shared/exp_regexp.o shared/exp_tty.o \ shared/exp_log.o shared/exp_main_sub.o shared/exp_pty.o \ - shared/exp_printify.o shared/exp_trap.o \ + shared/exp_trap.o \ shared/exp_console.o shared/exp_strf.o shared/exp_glob.o \ - shared/exp_win.o shared/Dbg.o shared/exp_clib.o \ + shared/exp_win.o shared/exp_clib.o \ shared/exp_closetcl.o shared/exp_memmove.o shared/exp_tty_comm.o \ - shared/exp_$(EVENT_TYPE).o shared/exp_$(EVENT_ABLE).o + shared/exp_$(EVENT_TYPE).o shared/exp_$(EVENT_ABLE).o \ + shared/exp_chan.o shared/Dbg.o # Expect libraries (both .a and shared) EXP_LIB_FILES = @EXP_LIB_FILES@ # default Expect library (shared if possible, otherwise static) EXP_LIB_FILE = @EXP_LIB_FILE@ @@ -314,17 +325,24 @@ mkdir shared ; \ else true; fi ; \ $(CC) -c $(CFLAGS_INT) @EXP_SHLIB_CFLAGS@ $(STTY) $(HDEFS) $< -o shared/$@ ; \ fi -all: expect $(EXP_LIB_FILES) ${X11_PROGS} +all: binaries libraries doc + +binaries: expect $(EXP_LIB_FILES) ${X11_PROGS} @$(MAKE) subdir_do DO=$@ $(FLAGS_TO_PASS) +libraries: + +doc: info dvi + info: dvi: # build expect binary that does not depend on Expect's shared libs +# IFF static Tcl/Tk libraries are available. expect: exp_main_exp.o $(EXP_UNSHARED_LIB_FILE) $(CC) $(XCFLAGS) @TCL_LD_FLAGS@ -o expect exp_main_exp.o $(EXP_UNSHARED_LIB_FILE) $(TCLLIB) $(EXP_AND_TCL_LIBS) $(SETUID) expect # install Expect library @@ -357,11 +375,12 @@ # Build Expect with TestCenter expect.tc: exp_main_exp.o $(OFILES) proof $(CC) $(XCFLAGS) @EXP_SHLIB_CFLAGS@ @TCL_LD_FLAGS@ -o expect.tc $(OFILES) exp_main_exp.o $(TCLLIB) $(EXP_AND_TCL_LIBS) $(SETUID) expect.tc -# Build an executable with both Expect and Tk. +# Build an executable with both Expect and Tk +# IFF static Tcl/Tk libraries are available. # Yes, I know that the link line can have libraries repeated. This is a # consequence of Tcl's configure combining the Tcl and X dependent libs # together. I could fix it by testing all the libraries (again, in Expect's # configure) separately for Expectk, but as far as I know, it doesn't hurt # anything here, so I'm not worrying about it. @@ -376,63 +395,76 @@ # Build Expectk with TestCenter expectk.tc: exp_main_tk.o $(OFILES) proof $(CC) $(XCFLAGS) @TCL_LD_FLAGS@ -o expectk.tc $(OFILES) exp_main_tk.o $(TKLIB) $(TCLLIB) $(X11_LD_FLAGS) $(EXP_AND_TK_LIBS) $(SETUID) expectk.tc +expect-unshared-lib-file :: $(EXP_UNSHARED_LIB_FILE) $(EXP_UNSHARED_LIB_FILE): $(OFILES) -rm -f $(EXP_UNSHARED_LIB_FILE) $(AR) $(ARFLAGS) $(EXP_UNSHARED_LIB_FILE) $(OFILES) -$(UNSHARED_RANLIB) $(EXP_UNSHARED_LIB_FILE) # the dependency should really be SHARED_OFILES rather than OFILES # but there's no way to write a rule that says shared/XYZ.o should # depend on XYZ.c in a different directory (except by writing the # rule out for each file, sigh). +expect-shared-lib-file :: $(EXP_SHARED_LIB_FILE) $(EXP_SHARED_LIB_FILE): $(OFILES) -rm -f $(EXP_SHARED_LIB_FILE) @TCL_SHLIB_LD@ -o $(EXP_SHARED_LIB_FILE) $(SHARED_OFILES) @EXP_LD_SEARCH_FLAGS@ @EXP_SHLIB_LD_LIBS@ .PHONY: install-info install info install-info: -install: expect expect_installed ${X11_PROGS_INSTALLED} $(SCRIPTS) +install: all install-binaries install-libraries install-doc + +install-binaries: expect expect_installed ${X11_PROGS_INSTALLED} $(SCRIPTS) ${srcdir}/mkinstalldirs $(man1dir) $(man3dir) $(bindir) $(tcl_libdir) $(includedir) # install Expect $(INSTALL_PROGRAM) expect_installed $(bindir)/expect # install Expectk (and man page) if present -if [ -s expectk_installed ] ; then \ $(INSTALL_PROGRAM) expectk_installed $(bindir)/expectk ; \ - $(INSTALL_DATA) $(srcdir)/expectk.man $(man1dir)/expectk.1 ; \ else true; fi -# install Expect man page - $(INSTALL_DATA) $(srcdir)/expect.man $(man1dir)/expect.1 -# install man page for Expect and Expectk libraries - $(INSTALL_DATA) $(srcdir)/libexpect.man $(man3dir)/libexpect.3 # install Expect's public include files # $(INSTALL_DATA) expect_cf.h $(includedir) $(INSTALL_DATA) $(srcdir)/expect.h $(includedir) $(INSTALL_DATA) $(srcdir)/expect_tcl.h $(includedir) $(INSTALL_DATA) $(srcdir)/expect_comm.h $(includedir) # force installation of Tcl's private regexp definition - we simply have to # make it public in order for people to use Expect's C lib. - $(INSTALL_DATA) $(TCLHDIR)/tclRegexp.h $(includedir) +# hmm - no longer appropriate for Tcl 8.2+ - work on better solution? +# $(INSTALL_DATA) $(TCLHDIR)/tclRegexp.h $(includedir) # install Debugger's public include file (just in case it's not there) $(INSTALL_DATA) $(srcdir)/tcldbg.h $(includedir) # some people don't install Tcl, sigh TCL_LIBRARY=$(TCL_LIBRARY) ; \ export TCL_LIBRARY ; \ if $(LOCAL_EXPECT) $(srcdir)/fixcat ; then \ $(INSTALL_DATA) $(srcdir)/fixcat $(EXECSCRIPTDIR)/cat-buffers ; \ else true; fi + +install-libraries: # install standalone scripts and their man pages, if requested ${srcdir}/mkinstalldirs $(bindir_arch_indep) $(man1dir) $(SCRIPTDIR) $(EXECSCRIPTDIR) -for i in $(SCRIPT_LIST) ; do \ if [ -f $$i ] ; then \ $(INSTALL_PROGRAM) $$i $(bindir_arch_indep)/$$i ; \ rm -f $$i ; \ else true; fi ; \ done + +install-doc: + ${srcdir}/mkinstalldirs $(man1dir) $(man3dir) +# install Expectk man page if present + -if [ -s expectk_installed ] ; then \ + $(INSTALL_DATA) $(srcdir)/expectk.man $(man1dir)/expectk.1 ; \ + else true; fi +# install Expect man page + $(INSTALL_DATA) $(srcdir)/expect.man $(man1dir)/expect.1 +# install man page for Expect and Expectk libraries + $(INSTALL_DATA) $(srcdir)/libexpect.man $(man3dir)/libexpect.3 -for i in $(SCRIPT_MANPAGE_LIST) ; do \ if [ -f $(srcdir)/example/$$i.man ] ; then \ $(INSTALL_DATA) $(srcdir)/example/$$i.man $(man1dir)/$$i.1 ; \ else true; fi ; \ done @@ -602,13 +634,16 @@ GCCINC = -I$(GCCROOT)/include # following only on Sparcs SABERDEFINE = -D__sparc__ # Following target builds expect under CodeCenter. +# Note that CodeCenter doesn't understand backslashes in STTY - there is a +# default value in the code itself that is used. So if you don't use the default, +# you'll have to hand-edit the source. # If using ObjectCenter, before loading, type: setopt primary_language C exp: $(CFILES) exp_main_exp.c - #load $(CPPFLAGS) $(STTY) $(CFILES) exp_main_exp.c $(TCLLIB) $(GCCLIB) $(EXP_AND_TCL_LIBS) + #load $(CPPFLAGS) $(CFILES) exp_main_exp.c $(TCLLIB) $(GCCLIB) $(EXP_AND_TCL_LIBS) # Following target builds expectk under CodeCenter. Notes: # Because of explicit #includes of in tk.h, you need to create # a symlink from your X11 include directory to this directory tk: $(CFILES) exp_main_tk.c @@ -623,39 +658,29 @@ ###################################### # Targets for pushing out releases ###################################### -# until we are completely switched over, keep updating old ftp site too -OLDFTPDIR = /proj/elib/online/pub/expect FTPDIR = /proj/itl/www/div826/subject/expect # make a private tar file for myself tar: expect-$(VERSION).tar mv expect-$(VERSION).tar expect.tar # make a release and install it on ftp server -ftp: expect-$(VERSION).tar.Z expect-$(VERSION).tar.gz +# update web page to reflect new version +ftp: expect-$(VERSION).tar.Z expect-$(VERSION).tar.gz install-html cp expect-$(VERSION).tar.Z $(FTPDIR)/expect.tar.Z cp expect-$(VERSION).tar.gz $(FTPDIR)/expect.tar.gz + cp expect-$(VERSION).tar.gz $(FTPDIR)/old/expect-@EXP_VERSION_FULL@.tar.gz cp HISTORY $(FTPDIR) cp README $(FTPDIR)/README.distribution cp example/README $(FTPDIR)/example cp `pubfile example` $(FTPDIR)/example ls -l $(FTPDIR)/expect.tar* -# update old ftp site too - cp expect-$(VERSION).tar.Z $(OLDFTPDIR)/expect.tar.Z - cp expect-$(VERSION).tar.gz $(OLDFTPDIR)/expect.tar.gz - cp HISTORY $(OLDFTPDIR) - cp README $(OLDFTPDIR)/README.distribution - cp example/README $(OLDFTPDIR)/example - cp `pubfile example` $(OLDFTPDIR)/example - ls -l $(OLDFTPDIR)/expect.tar* # delete temp files rm expect-$(VERSION).tar* - - # make an alpha release and install it on ftp server alpha: expect-$(VERSION).tar.Z expect-$(VERSION).tar.gz cp expect-$(VERSION).tar.Z $(FTPDIR)/alpha.tar.Z cp expect-$(VERSION).tar.gz $(FTPDIR)/alpha.tar.gz @@ -689,11 +714,11 @@ echo "set objdir" `pwd` > .tmp if [ "$(srcdir)" = "." ] ; then \ echo "set srcdir" `pwd` >> .tmp ; \ else echo "set srcdir" $(srcdir) >> .tmp ; fi echo "cd \$${srcdir}/tests" >> .tmp - echo "source all" >> .tmp + echo "source all.tcl" >> .tmp rootme=`pwd`; export rootme; \ srcdir=${srcdir} ; export srcdir ; \ if [ -f ./expect ] ; then \ TCL_LIBRARY=$(TCL_LIBRARY) ; \ export TCL_LIBRARY ; fi ; \ @@ -746,22 +771,25 @@ exp_command.h exp_event.h exp_$(EVENT_TYPE).o: $(srcdir)/exp_$(EVENT_TYPE).c expect_cf.h expect.h \ exp_command.h exp_event.h exp_command.o: $(srcdir)/exp_command.c expect_cf.h exp_tty.h \ exp_rename.h expect.h exp_command.h \ - exp_log.h exp_printify.h exp_event.h exp_pty.h + exp_log.h exp_event.h exp_pty.h +exp_console.o: $(srcdir)/exp_console.c expect_cf.h exp_rename.h exp_prog.h \ + exp_log.h +exp_glob.o: $(srcdir)/exp_glob.c expect_cf.h exp_inter.o: $(srcdir)/exp_inter.c expect_cf.h \ exp_tty_in.h exp_tty.h exp_rename.h expect.h exp_command.h \ - exp_log.h exp_printify.h exp_regexp.h exp_tstamp.h + exp_log.h exp_regexp.h exp_tstamp.h exp_log.o: $(srcdir)/exp_log.c expect_cf.h expect.h \ - exp_rename.h exp_log.h exp_printify.h + exp_rename.h exp_log.h exp_main_exp.o: $(srcdir)/exp_main_exp.c expect_cf.h \ - expect.h exp_rename.h exp_command.h exp_log.h exp_printify.h + expect.h exp_rename.h exp_command.h exp_log.h exp_main_sub.o: $(srcdir)/exp_main_sub.c expect_cf.h \ exp_rename.h \ expect.h exp_command.h exp_tty_in.h exp_tty.h exp_log.h \ - exp_printify.h exp_event.h + exp_event.h exp_main_tk.o: $(srcdir)/exp_main_tk.c expect_cf.h tcldbg.h $(CC) -c @TK_DEFS@ $(CFLAGS_INT) $(HDEFS) $< shared/exp_main_tk.o: $(srcdir)/exp_main_tk.c expect_cf.h tcldbg.h $(CC) -c @TK_DEFS@ $(CFLAGS_INT) $(HDEFS) $< exp_noevent.o: $(srcdir)/exp_noevent.c expect_cf.h exp_prog.h exp_command.h \ @@ -770,30 +798,28 @@ exp_command.h exp_event.h $(CC) -c $(CFLAGS_INT) @TCL_DEFS@ $(HDEFS) $< shared/exp_poll.o: $(srcdir)/exp_poll.c expect_cf.h expect.h \ exp_command.h exp_event.h $(CC) -c $(CFLAGS_INT) @EXP_SHLIB_CFLAGS@ @TCL_DEFS@ $(HDEFS) $< -o shared/$@ -exp_printify.o: $(srcdir)/exp_printify.c expect_cf.h exp_pty.o: $(srcdir)/exp_pty.c expect_cf.h exp_rename.h exp_pty.h exp_regexp.o: $(srcdir)/exp_regexp.c expect_cf.h \ expect.h exp_regexp.h exp_select.o: $(srcdir)/exp_select.c expect_cf.h \ expect.h exp_command.h exp_event.h exp_simple.o: $(srcdir)/exp_simple.c expect_cf.h \ expect.h exp_command.h exp_event.h -exp_strf.o: $(srcdir)/exp_strf.c +exp_strf.o: $(srcdir)/exp_strf.c expect_cf.h exp_trap.o: $(srcdir)/exp_trap.c expect_cf.h expect.h \ - exp_command.h exp_log.h exp_printify.h + exp_command.h exp_log.h exp_tty.o: $(srcdir)/exp_tty.c expect_cf.h \ expect.h exp_rename.h exp_tty_in.h exp_tty.h exp_log.h \ - exp_printify.h exp_command.h -exp_win.o: $(srcdir)/exp_win.c exp_win.h + exp_command.h +exp_win.o: $(srcdir)/exp_win.c exp_win.h expect_cf.h expect.o: $(srcdir)/expect.c expect_cf.h \ exp_rename.h expect.h exp_command.h \ - exp_log.h exp_printify.h exp_event.h exp_tty.h exp_tstamp.h -lib_exp.o: $(srcdir)/lib_exp.c expect_cf.h exp_rename.h expect.h \ - exp_printify.h + exp_log.h exp_event.h exp_tty.h exp_tstamp.h +lib_exp.o: $(srcdir)/lib_exp.c expect_cf.h exp_rename.h expect.h pty_sgttyb.o: $(srcdir)/pty_sgttyb.c expect_cf.h exp_rename.h exp_tty_in.h \ exp_tty.h exp_pty.h pty_termios.o: $(srcdir)/pty_termios.c expect_cf.h exp_win.h \ exp_tty_in.h exp_tty.h exp_rename.h exp_pty.h pty_unicos.o: $(srcdir)/pty_unicos.c expect_cf.h exp_rename.h Index: NEWS ================================================================== --- NEWS +++ NEWS @@ -1,19 +1,175 @@ This file is the NEWS file from the Expect distribution. ====================================================================== ====================================================================== +Date: 08/01/00 + +** SUMMARY + +Expect 5.32 is being released in conjuction with Tcl 8.3.2. +This is a fairly minor update with no feature changes but with +a number of useful bug fixes in the way expects uses the new +regular expression engine and the UTF-8 features of Tcl. +Details are in the HISTORY and ChangeLog files. + +====================================================================== +====================================================================== + +Date: 10/22/99 + +** SUMMARY + +Expect 5.31 now works with Tcl 8.2. Expect 5.31 does NOT work with +prior releases of Tcl. Thanks to an incredible amount of work by +Scott Stanton, Henry Spencer, Melissa Hirschl, and funding from +Scriptics for making this possible. + +** NEW FEATURES + +What? You mean that working with Tcl 8.2 isn't enough????? + +Expect supports Tcl's new regexp engine. + +Expect supports null bytes in strings directly. (You no longer have +to use the "null" keyword to send or match nulls. Of course, the +"null" keyword will continue to be supported.) Null removal (on +input) is still enabled by default since nulls are almost never +intended for end-user consumption in interactive dialogues. + +** CHANGES IN BEHAVIOR (POTENTIAL INCOMPATIBILITIES) + +The interpreter command used to exit upon eof. Now it uses "-eof +script" to control this behavior. The default behavior is to return. +(This change was required because Expect now gives control to Tcl upon +exit and Tcl waits (potentially forever) for all processes to die on +exit.) Explicit calls to interpreter are almost non-existent. +However, you should look for *implicit* calls via interact commands +with a pattern but no action. This required changes in the examples: +dislocate, dvorak, kibitz, and xkibitz. + +Indirect variables can no longer start with "exp". Such variables +will be interpreted as channel names. + +Old-style regexps may need conversion. If you have been protecting +regexps containing backslashes with {}, then you need to examine all +your backslashes since the new regexp engine interprets backslash +sequences (such as \n) itself. For example: + + expect "\n" (works the same in Tcl 8.0 and 8.1) + expect {\n} (works differently in Tcl 8.0 and 8.1) + +Scriptics has also created a new-regexp-features page which you should +read: http://www.scriptics.com/support/howto/regexp81.html. Some of +the new features allow much more efficient regexps than before. For +example, non-greedy quantifiers can replace [split] looping +constructions with a single regexp, enabling Tcl to parse very +efficiently. For the whole story, read the re_syntax man page. + +The interact command's regexp matching no longer skips nulls. (I'd be +surprised if anyone misses this. At least I hope ....) + +Expect's C library now reports failures in spawn's underlying exec +directly (by returning -1) rather than the way it used to (as data in +the pty). This makes user code more robust. However, it requires you +to simplify your code, alas. See the chesslib.c example. + +Linking with Expect's C library no longer requires the Tcl library +(unless, of course, you make Tcl calls yourself). Tcl is still +required to build the library in the first place, however. + +** CHANGES IN BEHAVIOR (SHOULD NOT CAUSE INCOMPATIBILITIES) + +The match_max command now controls by bytes, not chars. This won't +cause problems unless your existing scripts are interacting using +sizeable chunks of multibyte characters. (If you don't know what I'm +talking about, ignore this.) + +The Make/configure suite now corresponds to the TEA conventions (at +least in theory; the conventions are changing regularly so it's hard +to be less vague on this point). Significantly, this means that you +should be able to use the same configure flags as when compiling Tcl +or any other TEA-compatible extension. (See the INSTALL file.) + +The values of special variables such as exp_spawn_id_any have changed. +(The values were never documented so you shouldn't have been using +them anyway.) + +Spawn ids now appear as "exp...". (They used to be small integers.) +Do not assume that spawn ids will continue to be represented in any +particular way (other than unique strings). + +** OTHER NOTES + +Expect uses channels. There is an Expect channel type. It is +possible to use Tcl's channel commands, such as fconfigure, to change +the encoding. However, Expect layers its own buffering system on top +of Tcl's channel handler so don't expect intuitive behavior when using +commands such as gets and puts. Unless you know what you're doing, I +recommend manipulating the Expect channels only with the expect +commands. + +Some effort was made to make Expect support threads, however it is not +complete. You can compile Expect with threads enabled but don't run +Expect in multiple threads just yet. + +So much code has changed, there are bound to be bugs in dark corners. +Please let me know of such cases. The best response will come by +supplying a simple test case that can be added to Expect's test suite. + +In places where the behavior of Expect was not precisely documented, +full advantage was taken to do something different :-) + +Several esoteric bugs were fixed. + +Although Expect itself uses Henry Spencer's new regexp engine, +Expect's C library still uses his original regexp engine. + +No testing has been done of the poll and non-event subsystems. (These +are used on systems which don't support select on ptys or ttys. Some +minor work needs to be done on them (because the event subsystem was +rewritten) which I'll probably do only if anyone requests it. + +Many deprecated features (deprecated for many years!) have been +removed. All such features were deprecated prior to Exploring Expect +so if that's how you learned Expect, you have nothing to worry about. +For example, Expect's getpid command predates Tcl's pid command and +it's been deprecated for, oh.... 6 years - wow! Other deprecated features +include: + expect -timestamp (flag only; behavior itself was removed years ago) + expect -iwrite (flag only; behavior occurs all the time) + expect_version (use "exp_version" command) + expect_library (use "exp_library" global variable) + interact -eof (use "eof" keyword) + interact -timeout (use "timeout" keyword) + interact -timestamp (use "clock" command) + getpid (use "pid" command) + system stty (use "stty" command) + +With this release, the following are deprecated: + timestamp (use "clock" command) + debugger (use a different one; there are very nice replacements + around. Fortunately the Expect debugger is not something anyone + is wiring into their scripts, so for now, consider it on the + endangered species list. Anyone still want this debugger?) + +From now on, the most current snapshots of Expect will be found in the +Scriptics CVS repository. Not all snapshots are official releases. + +====================================================================== +====================================================================== + Date: 8/18/96 Expect now works with Tcl 8.0. No changes were made to take advantage of 8.0 features such as namespaces. (If you want to put the Expect commands in a namespace, declare a namespace before loading them in.) -Even thought Tcl allows embedded nulls in commands, Expect still does +Even though Tcl allows embedded nulls in commands, Expect still does not. Tcl still doesn't support embedded in patterns and regexps. I'll wait til Tcl supports that before rewriting Expect's null support. @@ -550,10 +706,10 @@ expect -re. 4) exec is no longer necessary to retrieve environment variables, since they can now be retrieved from $env. -5) If you have been really anal about testing for timeout and eof, you -can dramatically reduce the size of your scripts by using expect_before -and expect_after. This is more efficient, as well, since those actions -are only parsed once. +5) If you have been really careful about testing for timeout and eof, +you can dramatically reduce the size of your scripts by using +expect_before and expect_after. This is more efficient, as well, +since those actions are only parsed once. Index: README ================================================================== --- README +++ README @@ -7,13 +7,12 @@ This is the README file for Expect, a program that performs programmed dialogue with other interactive programs. It is briefly described by its man page, expect(1). This directory contains the source and man page for Expect. -This is Expect 5 for Tcl 7.5, 7.6, and 8.0. Tk 4.1, 4.2, 8.0 and the -Tcl Debugger are also supported. Significant changes and other news -can be found in the NEWS file. +This is Expect 5.32 for Tcl 8.2 and Tk 8.2 (and Tcl and Tk 8.3). +Significant changes and other news can be found in the NEWS file. The Expect home page is: http://expect.nist.gov The Expect FAQ is: http://expect.nist.gov/FAQ.html -------------------- @@ -223,11 +222,11 @@ the control language. Since you may already have Tcl, it is available separately. Tcl may be retrieved as tcl.tar.Z in the same way as described above for Expect. When new releases of Tcl appear, I will try to check them out for Expect as soon as possible. If you would like to get the newest Tcl release without waiting, ftp it from -ftp.smli.com (directory pub/tcl). +ftp.scriptics.com (directory pub/tcl). Expect may also be built using the Tk library, a Tcl interface to the X Window System. Tk is available in the same way as Tcl. It is possible to embed the Expect/Tcl core and optionally Tk in your Index: aclocal.m4 ================================================================== --- aclocal.m4 +++ aclocal.m4 @@ -98,15 +98,18 @@ # # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tclh}" = x ; then for i in \ ${srcdir}/../tcl \ - `ls -dr ${srcdir}/../tcl[[7-9]].[[0-9]].[[0-9]] ${srcdir}/../tcl[[7-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[9]].[[0-9]].[[0-9]] ${srcdir}/../tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8]].[[2-9]].[[0-9]] ${srcdir}/../tcl[[8]].[[2-9]] 2>/dev/null` \ ${srcdir}/../../tcl \ - `ls -dr ${srcdir}/../../tcl[[7-9]].[[0-9]].[[0-9]] ${srcdir}/../../tcl[[7-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../../tcl[[9]].[[0-9]].[[0-9]] ${srcdir}/../../tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../../tcl[[8]].[[2-9]].[[0-9]] ${srcdir}/../../tcl[[8]].[[2-9]] 2>/dev/null` \ ${srcdir}/../../../tcl \ - `ls -dr ${srcdir}/../../../tcl[[7-9]].[[0-9]].[[0-9]] ${srcdir}/../../../tcl[[7-9]].[[0-9]] 2>/dev/null ` ; do + `ls -dr ${srcdir}/../../../tcl[[9]].[[0-9]].[[0-9]] ${srcdir}/../../../tcl[[9]].[[0-9]] 2>/dev/null ` \ + `ls -dr ${srcdir}/../../../tcl[[8]].[[2-9]].[[0-9]] ${srcdir}/../../../tcl[[8]].[[2-9]] 2>/dev/null ` ; do if test -f $i/generic/tclInt.h ; then ac_cv_c_tclh=`(cd $i/generic; pwd)` break fi done @@ -114,12 +117,14 @@ # finally check in a few common install locations # # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tclh}" = x ; then for i in \ - `ls -dr /usr/local/src/tcl[[7-9]].[[0-9]].[[0-9]] /usr/local/src/tcl[[7-9]].[[0-9]] 2>/dev/null` \ - `ls -dr /usr/local/lib/tcl[[7-9]].[[0-9]].[[0-9]] /usr/local/lib/tcl[[7-9]].[[0-9]] 2>/dev/null` \ + `ls -dr /usr/local/src/tcl[[9]].[[0-9]].[[0-9]] /usr/local/src/tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr /usr/local/src/tcl[[8]].[[2-9]].[[0-9]] /usr/local/src/tcl[[8]].[[2-9]] 2>/dev/null` \ + `ls -dr /usr/local/lib/tcl[[9]].[[0-9]].[[0-9]] /usr/local/lib/tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr /usr/local/lib/tcl[[8]].[[2-9]].[[0-9]] /usr/local/lib/tcl[[8]].[[2-9]] 2>/dev/null` \ /usr/local/src/tcl \ /usr/local/lib/tcl \ ${prefix}/include ; do if test -f $i/generic/tclInt.h ; then ac_cv_c_tclh=`(cd $i/generic; pwd)` @@ -161,22 +166,22 @@ AC_DEFUN(CY_AC_PATH_TCLCONFIG, [ # # Ok, lets find the tcl configuration # First, look for one uninstalled. -# the alternative search directory is invoked by --with-tclconfig +# the alternative search directory is invoked by --with-tcl # if test x"${no_tcl}" = x ; then # we reset no_tcl in case something fails here no_tcl=true - AC_ARG_WITH(tclconfig, [ --with-tclconfig directory containing tcl configuration (tclConfig.sh)], + AC_ARG_WITH(tcl, [ --with-tcl directory containing tcl configuration (tclConfig.sh)], with_tclconfig=${withval}) AC_MSG_CHECKING([for Tcl configuration]) AC_CACHE_VAL(ac_cv_c_tclconfig,[ - # First check to see if --with-tclconfig was specified. + # First check to see if --with-tcl was specified. if test x"${with_tclconfig}" != x ; then if test -f "${with_tclconfig}/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)` else AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) @@ -185,15 +190,18 @@ # then check for a private Tcl installation if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ../tcl \ - `ls -dr ../tcl[[7-9]].[[0-9]].[[0-9]] ../tcl[[7-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[9]].[[0-9]].[[0-9]] ../tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[8]].[[2-9]].[[0-9]] ../tcl[[8]].[[2-9]] 2>/dev/null` \ ../../tcl \ - `ls -dr ../../tcl[[7-9]].[[0-9]].[[0-9]] ../../tcl[[7-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[9]].[[0-9]].[[0-9]] ../../tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[8]].[[2-9]].[[0-9]] ../../tcl[[8]].[[2-9]] 2>/dev/null` \ ../../../tcl \ - `ls -dr ../../../tcl[[7-9]].[[0-9]].[[0-9]] ../../../tcl[[7-9]].[[0-9]] 2>/dev/null` ; do + `ls -dr ../../../tcl[[9]].[[0-9]].[[0-9]] ../../../tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tcl[[8]].[[2-9]].[[0-9]] ../../../tcl[[8]].[[2-9]] 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i/unix; pwd)` break fi done @@ -209,11 +217,12 @@ fi # check in a few other private locations if test x"${ac_cv_c_tclconfig}" = x ; then for i in \ ${srcdir}/../tcl \ - `ls -dr ${srcdir}/../tcl[[7-9]].[[0-9]].[[0-9]] ${srcdir}/../tcl[[7-9]].[[0-9]] 2>/dev/null` ; do + `ls -dr ${srcdir}/../tcl[[9]].[[0-9]].[[0-9]] ${srcdir}/../tcl[[9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8]].[[2-9]].[[0-9]] ${srcdir}/../tcl[[8]].[[2-9]] 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then ac_cv_c_tclconfig=`(cd $i/unix; pwd)` break fi done @@ -250,13 +259,11 @@ dnl don't export, not used outside of configure dnl AC_SUBST(TCL_LIBS) dnl not used, don't export to save symbols dnl AC_SUBST(TCL_PREFIX) -dnl not used, don't export to save symbols -dnl AC_SUBST(TCL_EXEC_PREFIX) - + AC_SUBST(TCL_EXEC_PREFIX) dnl not used, don't export to save symbols dnl AC_SUBST(TCL_SHLIB_CFLAGS) AC_SUBST(TCL_SHLIB_LD) dnl don't export, not used outside of configure @@ -278,10 +285,13 @@ # if Tcl's build directory has been removed, TCL_LIB_SPEC should # be used instead of TCL_BUILD_LIB_SPEC SAVELIBS=$LIBS # eval used to expand out TCL_DBGX eval "LIBS=\"$TCL_BUILD_LIB_SPEC $TCL_LIBS\"" +AC_MSG_CHECKING([Tcl build library]) +AC_MSG_RESULT($LIBS) + AC_CHECK_FUNC(Tcl_CreateCommand,[ AC_MSG_CHECKING([if Tcl library build specification is valid]) AC_MSG_RESULT(yes) ],[ TCL_BUILD_LIB_SPEC=$TCL_LIB_SPEC @@ -305,11 +315,11 @@ # Warning: Tk definitions are very similar to Tcl definitions but # are not precisely the same. There are a couple of differences, # so don't do changes to Tcl thinking you can cut and paste it do # the Tk differences and later simply substitute "Tk" for "Tcl". # Known differences: -# - Acceptable Tcl major version #s is 7-9 while Tk is 4-9 +# - Acceptable Tcl major version #s is 8.2-9.* while Tk is 8.2-9.* # - Searching for Tcl includes looking for tclInt.h, Tk looks for tk.h # - Computing major/minor versions is different because Tk depends on # headers to Tcl, Tk, and X. # - Symbols in tkConfig.sh are different than tclConfig.sh # - Acceptable for Tk to be missing but not Tcl. @@ -355,13 +365,16 @@ # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tkh}" = x ; then for i in \ ${srcdir}/../tk \ `ls -dr ${srcdir}/../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../tk[[4-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../tk[[4-9]].[[0-9]] 2>/dev/null` \ ${srcdir}/../../tk \ `ls -dr ${srcdir}/../../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../../tk[[4-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../../tk[[4-9]].[[0-9]] 2>/dev/null` \ ${srcdir}/../../../tk \ + `ls -dr ${srcdir}/../../../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../../../tk[[4-9]].[[0-9]] 2>/dev/null ` \ `ls -dr ${srcdir}/../../../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../../../tk[[4-9]].[[0-9]] 2>/dev/null ` ; do if test -f $i/generic/tk.h ; then ac_cv_c_tkh=`(cd $i/generic; pwd)` break fi @@ -371,10 +384,12 @@ # # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tkh}" = x ; then for i in \ `ls -dr /usr/local/src/tk[[4-9]].[[0-9]].[[0-9]] /usr/local/src/tk[[4-9]].[[0-9]] 2>/dev/null` \ + `ls -dr /usr/local/src/tk[[4-9]].[[0-9]].[[0-9]] /usr/local/src/tk[[4-9]].[[0-9]] 2>/dev/null` \ + `ls -dr /usr/local/lib/tk[[4-9]].[[0-9]].[[0-9]] /usr/local/lib/tk[[4-9]].[[0-9]] 2>/dev/null` \ `ls -dr /usr/local/lib/tk[[4-9]].[[0-9]].[[0-9]] /usr/local/lib/tk[[4-9]].[[0-9]] 2>/dev/null` \ /usr/local/src/tk \ /usr/local/lib/tk \ ${prefix}/include ; do if test -f $i/generic/tk.h ; then @@ -410,22 +425,22 @@ AC_DEFUN(CY_AC_PATH_TKCONFIG, [ # # Ok, lets find the tk configuration # First, look for one uninstalled. -# the alternative search directory is invoked by --with-tkconfig +# the alternative search directory is invoked by --with-tk # if test x"${no_tk}" = x ; then # we reset no_tk in case something fails here no_tk=true - AC_ARG_WITH(tkconfig, [ --with-tkconfig directory containing tk configuration (tkConfig.sh)], + AC_ARG_WITH(tk, [ --with-tk directory containing tk configuration (tkConfig.sh)], with_tkconfig=${withval}) AC_MSG_CHECKING([for Tk configuration]) AC_CACHE_VAL(ac_cv_c_tkconfig,[ - # First check to see if --with-tkconfig was specified. + # First check to see if --with-tk was specified. if test x"${with_tkconfig}" != x ; then if test -f "${with_tkconfig}/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)` else AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) @@ -435,13 +450,16 @@ # then check for a private Tk library if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ../tk \ `ls -dr ../tk[[4-9]].[[0-9]].[[0-9]] ../tk[[4-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[4-9]].[[0-9]].[[0-9]] ../tk[[4-9]].[[0-9]] 2>/dev/null` \ ../../tk \ `ls -dr ../../tk[[4-9]].[[0-9]].[[0-9]] ../../tk[[4-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[4-9]].[[0-9]].[[0-9]] ../../tk[[4-9]].[[0-9]] 2>/dev/null` \ ../../../tk \ + `ls -dr ../../../tk[[4-9]].[[0-9]].[[0-9]] ../../../tk[[4-9]].[[0-9]] 2>/dev/null` \ `ls -dr ../../../tk[[4-9]].[[0-9]].[[0-9]] ../../../tk[[4-9]].[[0-9]] 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i/unix; pwd)` break fi @@ -458,10 +476,11 @@ fi # check in a few other private locations if test x"${ac_cv_c_tkconfig}" = x ; then for i in \ ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../tk[[4-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tk[[4-9]].[[0-9]].[[0-9]] ${srcdir}/../tk[[4-9]].[[0-9]] 2>/dev/null` ; do if test -f "$i/unix/tkConfig.sh" ; then ac_cv_c_tkconfig=`(cd $i/unix; pwd)` break fi @@ -491,10 +510,11 @@ dnl not actually used, don't export to save symbols dnl AC_SUBST(TK_MAJOR_VERSION) dnl AC_SUBST(TK_MINOR_VERSION) AC_SUBST(TK_DEFS) + AC_SUBST(TK_DBGX) dnl not used, don't export to save symbols dnl AC_SUBST(TK_LIB_FILE) dnl not used outside of configure dnl AC_SUBST(TK_LIBS) @@ -504,9 +524,79 @@ dnl not used, don't export to save symbols dnl AC_SUBST(TK_EXEC_PREFIX) AC_SUBST(TK_XINCLUDES) AC_SUBST(TK_XLIBSW) + +# if Tk's build directory has been removed, TK_LIB_SPEC should +# be used instead of TK_BUILD_LIB_SPEC +SAVELIBS=$LIBS +# eval used to expand out TK_DBGX +eval "LIBS=\"$TK_BUILD_LIB_SPEC $TCL_BUILD_LIB_SPEC $TK_LIBS\"" +AC_CHECK_FUNC(Tk_Init,[ + AC_MSG_CHECKING([if Tk library build specification is valid]) + AC_MSG_RESULT(yes) +],[ + TK_BUILD_LIB_SPEC=$TK_LIB_SPEC + # Can't pull the following CHECKING call out since it will be + # broken up by the CHECK_FUNC just above. + AC_MSG_CHECKING([if Tk library build specification is valid]) + AC_MSG_RESULT(no) +]) +LIBS=$SAVELIBS + AC_SUBST(TK_BUILD_LIB_SPEC) AC_SUBST(TK_LIB_SPEC) ]) +#------------------------------------------------------------------------ +# SC_ENABLE_THREADS -- +# +# Specify if thread support should be enabled +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-threads +# +# Sets the following vars: +# THREADS_LIBS Thread library(s) +# +# Defines the following vars: +# TCL_THREADS +# _REENTRANT +# +#------------------------------------------------------------------------ + +AC_DEFUN(SC_ENABLE_THREADS, [ + AC_MSG_CHECKING(for building with threads) + AC_ARG_ENABLE(threads, [ --enable-threads build with threads (not supported)], + [tcl_ok=$enableval], [tcl_ok=no]) + + if test "$tcl_ok" = "yes"; then + AC_MSG_WARN([Expect is not fully thread-enabled. Although significant work has been done towards that goal, it is not complete. Continue compiling at your own risk.]) + fi +# if test "$tcl_ok" = "yes"; then +# AC_MSG_RESULT(yes) +# TCL_THREADS=1 +# AC_DEFINE(TCL_THREADS) +# AC_DEFINE(_REENTRANT) +# +# AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) +# if test "$tcl_ok" = "yes"; then +# # The space is needed +# THREADS_LIBS=" -lpthread" +# else +# TCL_THREADS=0 +# AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...") +# fi +# else +# TCL_THREADS=0 +# AC_MSG_RESULT(no (default)) +# fi + + AC_MSG_RESULT(no (default)) + +]) Index: config.guess ================================================================== --- config.guess +++ config.guess @@ -433,10 +433,13 @@ echo ${UNAME_MACHINE}-sni-sysv4 else echo ns32k-sni-sysv fi exit 0 ;; + Power*Macintosh:Darwin:*:*) + echo powerpc-darwin${UNAME_RELEASE} + exit 0 ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 Index: configure ================================================================== --- configure +++ configure @@ -1,9 +1,9 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.11 +# Generated automatically using autoconf version 2.13 # Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. @@ -10,13 +10,17 @@ # Defaults: ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: ac_help="$ac_help - --with-tclconfig directory containing tcl configuration (tclConfig.sh)" + --enable-threads build with threads (not supported)" +ac_help="$ac_help + --with-tcl directory containing tcl configuration (tclConfig.sh)" +ac_help="$ac_help + --with-tk directory containing tk configuration (tkConfig.sh)" ac_help="$ac_help - --with-tkconfig directory containing tk configuration (tkConfig.sh)" + --enable-symbols allow use of symbols if available" ac_help="$ac_help --with-tclinclude directory where tcl private headers are" ac_help="$ac_help --enable-shared build libexpect as a shared library" ac_help="$ac_help @@ -63,10 +67,11 @@ mandir='${prefix}/man' # Initialize some other variables. subdirs= MFLAGS= MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. ac_max_here_lines=12 ac_prev= for ac_option @@ -346,11 +351,11 @@ -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.11" + echo "configure generated by autoconf version 2.13" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. @@ -448,15 +453,18 @@ *) ac_configure_args="$ac_configure_args $ac_arg" ;; esac done # NLS nuisances. -# Only set LANG and LC_ALL to C if already set. -# These must not be set unconditionally because not all systems understand -# e.g. LANG=C (notably SCO). -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +# Only set these to C if already set. These must not be set unconditionally +# because not all systems understand e.g. LANG=C (notably SCO). +# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +# Non-C LC_CTYPE values break the ctype check. if test "${LANG+set}" = set; then LANG=C; export LANG; fi +if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h @@ -506,12 +514,15 @@ ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross +ac_exeext= +ac_objext=o if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then ac_n= ac_c=' ' ac_t=' ' @@ -525,21 +536,75 @@ # note when updating version numbers here, also update pkgIndex.in (see # comments in Makefile) EXP_MAJOR_VERSION=5 -EXP_MINOR_VERSION=28 -EXP_MICRO_VERSION=1 +EXP_MINOR_VERSION=34 +EXP_MICRO_VERSION=0 EXP_VERSION=$EXP_MAJOR_VERSION.$EXP_MINOR_VERSION EXP_VERSION_NODOTS=$EXP_MAJOR_VERSION$EXP_MINOR_VERSION EXP_VERSION_FULL=$EXP_VERSION.$EXP_MICRO_VERSION # Tcl's handling of shared_lib_suffix requires this symbol exist VERSION=$EXP_MAJOR_VERSION.$EXP_MINOR_VERSION # Too many people send me configure output without identifying the version. # This forced identification should reduce my pain significantly. echo "configuring Expect $EXP_MAJOR_VERSION.$EXP_MINOR_VERSION.$EXP_MICRO_VERSION" + +# People (when downloading Expect from CVS archive) sometimes run into +# Make thinking configure is old and needs to be rebuilt. If they +# don't have a clue about autoconf, they get confused. This is +# particular irritating because the problem only crops up after +# configure has successfully completed. Help them out by checking it +# right now and giving some advice. Alas, we cannot summarily fix the +# problem because it might conceivably be someone doing real +# development. +# Test if configure is older than configure.in and explain if no autoconf +# Extract the first word of "autoconf", so it can be a program name with args. +set dummy autoconf; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:566: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_found'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$found"; then + ac_cv_prog_found="$found" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_found="yes" + break + fi + done + IFS="$ac_save_ifs" + test -z "$ac_cv_prog_found" && ac_cv_prog_found="no" +fi +fi +found="$ac_cv_prog_found" +if test -n "$found"; then + echo "$ac_t""$found" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + +echo $ac_n "checking configure up to date""... $ac_c" 1>&6 +echo "configure:594: checking configure up to date" >&5 +for i in `ls -tr ${srcdir}/configure ${srcdir}/configure.in ${srcdir}/Makefile.in` ; do + newest=$i +done +if test "$srcdir/configure" = "$newest" ; then + echo "$ac_t""yes" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi +if test $found = "no" -a "$newest" != "$srcdir/configure" ; then + echo "configure: warning: $srcdir/configure appears to be old ($srcdir/configure.in and/or $srcdir/Makefile.in are newer) and the autoconf program to fix this situation was not found. If you've no idea what this means, enter the command \"touch $srcdir/configure\" and restart $srcdir/configure." 1>&2 + exit +fi ac_aux_dir= for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do if test -f $ac_dir/install-sh; then ac_aux_dir=$ac_dir @@ -579,37 +644,37 @@ *) { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } ;; esac # Make sure we can run config.sub. -if $ac_config_sub sun4 >/dev/null 2>&1; then : +if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then : else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } fi echo $ac_n "checking host system type""... $ac_c" 1>&6 -echo "configure:590: checking host system type" >&5 +echo "configure:655: checking host system type" >&5 host_alias=$host case "$host_alias" in NONE) case $nonopt in NONE) - if host_alias=`$ac_config_guess`; then : + if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then : else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; } fi ;; *) host_alias=$nonopt ;; esac ;; esac -host=`$ac_config_sub $host_alias` +host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias` host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` echo "$ac_t""$host" 1>&6 echo $ac_n "checking target system type""... $ac_c" 1>&6 -echo "configure:611: checking target system type" >&5 +echo "configure:676: checking target system type" >&5 target_alias=$target case "$target_alias" in NONE) case $nonopt in @@ -616,18 +681,18 @@ NONE) target_alias=$host_alias ;; *) target_alias=$nonopt ;; esac ;; esac -target=`$ac_config_sub $target_alias` +target=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $target_alias` target_cpu=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` target_vendor=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` target_os=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` echo "$ac_t""$target" 1>&6 echo $ac_n "checking build system type""... $ac_c" 1>&6 -echo "configure:629: checking build system type" >&5 +echo "configure:694: checking build system type" >&5 build_alias=$build case "$build_alias" in NONE) case $nonopt in @@ -634,11 +699,11 @@ NONE) build_alias=$host_alias ;; *) build_alias=$nonopt ;; esac ;; esac -build=`$ac_config_sub $build_alias` +build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias` build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` echo "$ac_t""$build" 1>&6 @@ -653,294 +718,20 @@ # /bin/sh on some systems is too deficient (in particular, Ultrix 4.3 # sh lacks unset and we *need* that), but all these systems come with # alternatives, so take user's choice or whatever we're using here and # allow it to be seen by Make. echo $ac_n "checking shell to use within Make""... $ac_c" 1>&6 -echo "configure:659: checking shell to use within Make" >&5 +echo "configure:724: checking shell to use within Make" >&5 EXP_CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} echo "$ac_t""$CONFIG_SHELL" 1>&6 # If `configure' is invoked (in)directly via `make', ensure that it # encounters no `make' conflicts. # MFLAGS= MAKEFLAGS= - -# -# Ok, lets find the tcl configuration -# First, look for one uninstalled. -# the alternative search directory is invoked by --with-tclconfig -# - -if test x"${no_tcl}" = x ; then - # we reset no_tcl in case something fails here - no_tcl=true - # Check whether --with-tclconfig or --without-tclconfig was given. -if test "${with_tclconfig+set}" = set; then - withval="$with_tclconfig" - with_tclconfig=${withval} -fi - - echo $ac_n "checking for Tcl configuration""... $ac_c" 1>&6 -echo "configure:686: checking for Tcl configuration" >&5 - if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - - - # First check to see if --with-tclconfig was specified. - if test x"${with_tclconfig}" != x ; then - if test -f "${with_tclconfig}/tclConfig.sh" ; then - ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)` - else - { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; } - fi - fi - - # then check for a private Tcl installation - if test x"${ac_cv_c_tclconfig}" = x ; then - for i in \ - ../tcl \ - `ls -dr ../tcl[7-9].[0-9].[0-9] ../tcl[7-9].[0-9] 2>/dev/null` \ - ../../tcl \ - `ls -dr ../../tcl[7-9].[0-9].[0-9] ../../tcl[7-9].[0-9] 2>/dev/null` \ - ../../../tcl \ - `ls -dr ../../../tcl[7-9].[0-9].[0-9] ../../../tcl[7-9].[0-9] 2>/dev/null` ; do - if test -f "$i/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig=`(cd $i/unix; pwd)` - break - fi - done - fi - # check in a few common install locations - if test x"${ac_cv_c_tclconfig}" = x ; then - for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do - if test -f "$i/tclConfig.sh" ; then - ac_cv_c_tclconfig=`(cd $i; pwd)` - break - fi - done - fi - # check in a few other private locations - if test x"${ac_cv_c_tclconfig}" = x ; then - for i in \ - ${srcdir}/../tcl \ - `ls -dr ${srcdir}/../tcl[7-9].[0-9].[0-9] ${srcdir}/../tcl[7-9].[0-9] 2>/dev/null` ; do - if test -f "$i/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig=`(cd $i/unix; pwd)` - break - fi - done - fi - -fi - - if test x"${ac_cv_c_tclconfig}" = x ; then - TCLCONFIG="# no Tcl configs found" - echo "configure: warning: Can't find Tcl configuration definitions" 1>&2 - else - no_tcl= - TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh - echo "$ac_t""found $TCLCONFIG" 1>&6 - fi -fi - - - . $TCLCONFIG - - - - - - - - - - - -# Tcl defines TCL_SHLIB_SUFFIX but TCL_SHARED_LIB_SUFFIX then looks for it -# as just SHLIB_SUFFIX. How bizarre. - SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX - - - - -# if Tcl's build directory has been removed, TCL_LIB_SPEC should -# be used instead of TCL_BUILD_LIB_SPEC -SAVELIBS=$LIBS -# eval used to expand out TCL_DBGX -eval "LIBS=\"$TCL_BUILD_LIB_SPEC $TCL_LIBS\"" -echo $ac_n "checking for Tcl_CreateCommand""... $ac_c" 1>&6 -echo "configure:775: checking for Tcl_CreateCommand" >&5 -if eval "test \"`echo '$''{'ac_cv_func_Tcl_CreateCommand'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char Tcl_CreateCommand(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_Tcl_CreateCommand) || defined (__stub___Tcl_CreateCommand) -choke me -#else -Tcl_CreateCommand(); -#endif - -; return 0; } -EOF -if { (eval echo configure:803: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_Tcl_CreateCommand=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_Tcl_CreateCommand=no" -fi -rm -f conftest* - -fi -if eval "test \"`echo '$ac_cv_func_'Tcl_CreateCommand`\" = yes"; then - echo "$ac_t""yes" 1>&6 - - echo $ac_n "checking if Tcl library build specification is valid""... $ac_c" 1>&6 -echo "configure:819: checking if Tcl library build specification is valid" >&5 - echo "$ac_t""yes" 1>&6 - -else - echo "$ac_t""no" 1>&6 - - TCL_BUILD_LIB_SPEC=$TCL_LIB_SPEC - # Can't pull the following CHECKING call out since it will be - # broken up by the CHECK_FUNC just above. - echo $ac_n "checking if Tcl library build specification is valid""... $ac_c" 1>&6 -echo "configure:829: checking if Tcl library build specification is valid" >&5 - echo "$ac_t""no" 1>&6 - -fi - -LIBS=$SAVELIBS - - - - - - - -CC=$TCL_CC -EXP_AND_TCL_LIBS=$TCL_LIBS - -# -# Ok, lets find the tk configuration -# First, look for one uninstalled. -# the alternative search directory is invoked by --with-tkconfig -# - -if test x"${no_tk}" = x ; then - # we reset no_tk in case something fails here - no_tk=true - # Check whether --with-tkconfig or --without-tkconfig was given. -if test "${with_tkconfig+set}" = set; then - withval="$with_tkconfig" - with_tkconfig=${withval} -fi - - echo $ac_n "checking for Tk configuration""... $ac_c" 1>&6 -echo "configure:861: checking for Tk configuration" >&5 - if eval "test \"`echo '$''{'ac_cv_c_tkconfig'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - - - # First check to see if --with-tkconfig was specified. - if test x"${with_tkconfig}" != x ; then - if test -f "${with_tkconfig}/tkConfig.sh" ; then - ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)` - else - { echo "configure: error: ${with_tkconfig} directory doesn't contain tkConfig.sh" 1>&2; exit 1; } - fi - fi - - # then check for a private Tk library - if test x"${ac_cv_c_tkconfig}" = x ; then - for i in \ - ../tk \ - `ls -dr ../tk[4-9].[0-9].[0-9] ../tk[4-9].[0-9] 2>/dev/null` \ - ../../tk \ - `ls -dr ../../tk[4-9].[0-9].[0-9] ../../tk[4-9].[0-9] 2>/dev/null` \ - ../../../tk \ - `ls -dr ../../../tk[4-9].[0-9].[0-9] ../../../tk[4-9].[0-9] 2>/dev/null` ; do - if test -f "$i/unix/tkConfig.sh" ; then - ac_cv_c_tkconfig=`(cd $i/unix; pwd)` - break - fi - done - fi - # check in a few common install locations - if test x"${ac_cv_c_tkconfig}" = x ; then - for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do - if test -f "$i/tkConfig.sh" ; then - ac_cv_c_tkconfig=`(cd $i; pwd)` - break - fi - done - fi - # check in a few other private locations - if test x"${ac_cv_c_tkconfig}" = x ; then - for i in \ - ${srcdir}/../tk \ - `ls -dr ${srcdir}/../tk[4-9].[0-9].[0-9] ${srcdir}/../tk[4-9].[0-9] 2>/dev/null` ; do - if test -f "$i/unix/tkConfig.sh" ; then - ac_cv_c_tkconfig=`(cd $i/unix; pwd)` - break - fi - done - fi - -fi - - if test x"${ac_cv_c_tkconfig}" = x ; then - TKCONFIG="# no Tk configs found" - echo "configure: warning: Can't find Tk configuration definitions" 1>&2 - else - no_tk= - TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh - echo "$ac_t""found $TKCONFIG" 1>&6 - fi -fi - - - - if test -f "$TKCONFIG" ; then - . $TKCONFIG - fi - - - - - - - - - - - - -EXP_AND_TK_LIBS=$TK_LIBS - # An explanation is in order for the strange things going on with the # various LIBS. There are three separate definitions for LIBS. The # reason is that some systems require shared libraries include # references to their dependent libraries, i.e., any additional # libraries that must be linked to. And some systems get upset if the @@ -961,19 +752,20 @@ OLD_CFLAGS=$CFLAGS # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:967: checking for $ac_word" >&5 +echo "configure:758: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_CC="gcc" break fi @@ -990,20 +782,21 @@ if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:996: checking for $ac_word" >&5 +echo "configure:788: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" ac_prog_rejected=no - for ac_dir in $PATH; do + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue @@ -1034,58 +827,105 @@ echo "$ac_t""$CC" 1>&6 else echo "$ac_t""no" 1>&6 fi + if test -z "$CC"; then + case "`uname -s`" in + *win32* | *WIN32*) + # Extract the first word of "cl", so it can be a program name with args. +set dummy cl; ac_word=$2 +echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 +echo "configure:839: checking for $ac_word" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_word; then + ac_cv_prog_CC="cl" + break + fi + done + IFS="$ac_save_ifs" +fi +fi +CC="$ac_cv_prog_CC" +if test -n "$CC"; then + echo "$ac_t""$CC" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi + ;; + esac + fi test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1044: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:871: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +cat > conftest.$ac_ext << EOF + +#line 882 "configure" +#include "confdefs.h" + +main(){return(0);} +EOF +if { (eval echo configure:887: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + ac_cv_prog_cc_works=yes + # If we can't run a trivial program, we are probably using a cross compiler. + if (./conftest; exit) 2>/dev/null; then + ac_cv_prog_cc_cross=no + else + ac_cv_prog_cc_cross=yes + fi +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + ac_cv_prog_cc_works=no +fi +rm -fr conftest* ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='$CPP $CPPFLAGS' ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' - -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - ac_cv_prog_cc_works=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_prog_cc_works=no -fi -rm -f conftest* - +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: Installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } + { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi +echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 +echo "configure:913: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 +cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1078: checking whether we are using GNU C" >&5 +echo "configure:918: checking whether we are using GNU C" >&5 if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:927: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no fi fi @@ -1092,55 +932,462 @@ echo "$ac_t""$ac_cv_prog_gcc" 1>&6 if test $ac_cv_prog_gcc = yes; then GCC=yes - ac_test_CFLAGS="${CFLAGS+set}" - ac_save_CFLAGS="$CFLAGS" - CFLAGS= - echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1102: checking whether ${CC-cc} accepts -g" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_gcc_g'+set}'`\" = set"; then +else + GCC= +fi + +ac_test_CFLAGS="${CFLAGS+set}" +ac_save_CFLAGS="$CFLAGS" +CFLAGS= +echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 +echo "configure:946: checking whether ${CC-cc} accepts -g" >&5 +if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_gcc_g=yes + ac_cv_prog_cc_g=yes else - ac_cv_prog_gcc_g=no + ac_cv_prog_cc_g=no fi rm -f conftest* fi -echo "$ac_t""$ac_cv_prog_gcc_g" 1>&6 - if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" - elif test $ac_cv_prog_gcc_g = yes; then +echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 +if test "$ac_test_CFLAGS" = set; then + CFLAGS="$ac_save_CFLAGS" +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then CFLAGS="-g -O2" else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then CFLAGS="-O2" + else + CFLAGS= fi -else - GCC= - test "${CFLAGS+set}" = set || CFLAGS="-g" fi CFLAGS=$OLD_CFLAGS + +#------------------------------------------------------------------------ +# Hook for when threading is supported in Expect. The --enable-threads +# flag currently has no effect. +#------------------------------------------------------------------------ + + + echo $ac_n "checking for building with threads""... $ac_c" 1>&6 +echo "configure:986: checking for building with threads" >&5 + # Check whether --enable-threads or --disable-threads was given. +if test "${enable_threads+set}" = set; then + enableval="$enable_threads" + tcl_ok=$enableval +else + tcl_ok=no +fi + + + if test "$tcl_ok" = "yes"; then + echo "configure: warning: Expect is not fully thread-enabled. Although significant work has been done towards that goal, it is not complete. Continue compiling at your own risk." 1>&2 + fi +# if test "$tcl_ok" = "yes"; then +# AC_MSG_RESULT(yes) +# TCL_THREADS=1 +# AC_DEFINE(TCL_THREADS) +# AC_DEFINE(_REENTRANT) +# +# AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) +# if test "$tcl_ok" = "yes"; then +# # The space is needed +# THREADS_LIBS=" -lpthread" +# else +# TCL_THREADS=0 +# AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...") +# fi +# else +# TCL_THREADS=0 +# AC_MSG_RESULT(no (default)) +# fi + + echo "$ac_t""no (default)" 1>&6 + + + + +# +# Ok, lets find the tcl configuration +# First, look for one uninstalled. +# the alternative search directory is invoked by --with-tcl +# + +if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + # Check whether --with-tcl or --without-tcl was given. +if test "${with_tcl+set}" = set; then + withval="$with_tcl" + with_tclconfig=${withval} +fi + + echo $ac_n "checking for Tcl configuration""... $ac_c" 1>&6 +echo "configure:1039: checking for Tcl configuration" >&5 + if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)` + else + { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; } + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[9].[0-9].[0-9] ../tcl[9].[0-9] 2>/dev/null` \ + `ls -dr ../tcl[8].[2-9].[0-9] ../tcl[8].[2-9] 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[9].[0-9].[0-9] ../../tcl[9].[0-9] 2>/dev/null` \ + `ls -dr ../../tcl[8].[2-9].[0-9] ../../tcl[8].[2-9] 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[9].[0-9].[0-9] ../../../tcl[9].[0-9] 2>/dev/null` \ + `ls -dr ../../../tcl[8].[2-9].[0-9] ../../../tcl[8].[2-9] 2>/dev/null` ; do + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig=`(cd $i/unix; pwd)` + break + fi + done + fi + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig=`(cd $i; pwd)` + break + fi + done + fi + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[9].[0-9].[0-9] ${srcdir}/../tcl[9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8].[2-9].[0-9] ${srcdir}/../tcl[8].[2-9] 2>/dev/null` ; do + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig=`(cd $i/unix; pwd)` + break + fi + done + fi + +fi + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCLCONFIG="# no Tcl configs found" + echo "configure: warning: Can't find Tcl configuration definitions" 1>&2 + else + no_tcl= + TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh + echo "$ac_t""found $TCLCONFIG" 1>&6 + fi +fi + + + . $TCLCONFIG + + + + + + + + + + + +# Tcl defines TCL_SHLIB_SUFFIX but TCL_SHARED_LIB_SUFFIX then looks for it +# as just SHLIB_SUFFIX. How bizarre. + SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX + + + + +# if Tcl's build directory has been removed, TCL_LIB_SPEC should +# be used instead of TCL_BUILD_LIB_SPEC +SAVELIBS=$LIBS +# eval used to expand out TCL_DBGX +eval "LIBS=\"$TCL_BUILD_LIB_SPEC $TCL_LIBS\"" +echo $ac_n "checking Tcl build library""... $ac_c" 1>&6 +echo "configure:1132: checking Tcl build library" >&5 +echo "$ac_t""$LIBS" 1>&6 + +echo $ac_n "checking for Tcl_CreateCommand""... $ac_c" 1>&6 +echo "configure:1136: checking for Tcl_CreateCommand" >&5 +if eval "test \"`echo '$''{'ac_cv_func_Tcl_CreateCommand'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char Tcl_CreateCommand(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_Tcl_CreateCommand) || defined (__stub___Tcl_CreateCommand) +choke me +#else +Tcl_CreateCommand(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1164: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_Tcl_CreateCommand=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_Tcl_CreateCommand=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'Tcl_CreateCommand`\" = yes"; then + echo "$ac_t""yes" 1>&6 + + echo $ac_n "checking if Tcl library build specification is valid""... $ac_c" 1>&6 +echo "configure:1180: checking if Tcl library build specification is valid" >&5 + echo "$ac_t""yes" 1>&6 + +else + echo "$ac_t""no" 1>&6 + + TCL_BUILD_LIB_SPEC=$TCL_LIB_SPEC + # Can't pull the following CHECKING call out since it will be + # broken up by the CHECK_FUNC just above. + echo $ac_n "checking if Tcl library build specification is valid""... $ac_c" 1>&6 +echo "configure:1190: checking if Tcl library build specification is valid" >&5 + echo "$ac_t""no" 1>&6 + +fi + +LIBS=$SAVELIBS + + + + + + + +CC=$TCL_CC +EXP_AND_TCL_LIBS=$TCL_LIBS + +# +# Ok, lets find the tk configuration +# First, look for one uninstalled. +# the alternative search directory is invoked by --with-tk +# + +if test x"${no_tk}" = x ; then + # we reset no_tk in case something fails here + no_tk=true + # Check whether --with-tk or --without-tk was given. +if test "${with_tk+set}" = set; then + withval="$with_tk" + with_tkconfig=${withval} +fi + + echo $ac_n "checking for Tk configuration""... $ac_c" 1>&6 +echo "configure:1222: checking for Tk configuration" >&5 + if eval "test \"`echo '$''{'ac_cv_c_tkconfig'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + + + # First check to see if --with-tk was specified. + if test x"${with_tkconfig}" != x ; then + if test -f "${with_tkconfig}/tkConfig.sh" ; then + ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)` + else + { echo "configure: error: ${with_tkconfig} directory doesn't contain tkConfig.sh" 1>&2; exit 1; } + fi + fi + + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[4-9].[0-9].[0-9] ../tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr ../tk[4-9].[0-9].[0-9] ../tk[4-9].[0-9] 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[4-9].[0-9].[0-9] ../../tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr ../../tk[4-9].[0-9].[0-9] ../../tk[4-9].[0-9] 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[4-9].[0-9].[0-9] ../../../tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr ../../../tk[4-9].[0-9].[0-9] ../../../tk[4-9].[0-9] 2>/dev/null` ; do + if test -f "$i/unix/tkConfig.sh" ; then + ac_cv_c_tkconfig=`(cd $i/unix; pwd)` + break + fi + done + fi + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig=`(cd $i; pwd)` + break + fi + done + fi + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[4-9].[0-9].[0-9] ${srcdir}/../tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[4-9].[0-9].[0-9] ${srcdir}/../tk[4-9].[0-9] 2>/dev/null` ; do + if test -f "$i/unix/tkConfig.sh" ; then + ac_cv_c_tkconfig=`(cd $i/unix; pwd)` + break + fi + done + fi + +fi + + if test x"${ac_cv_c_tkconfig}" = x ; then + TKCONFIG="# no Tk configs found" + echo "configure: warning: Can't find Tk configuration definitions" 1>&2 + else + no_tk= + TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh + echo "$ac_t""found $TKCONFIG" 1>&6 + fi +fi + + + + if test -f "$TKCONFIG" ; then + . $TKCONFIG + fi + + + + + + + + + + + +# if Tk's build directory has been removed, TK_LIB_SPEC should +# be used instead of TK_BUILD_LIB_SPEC +SAVELIBS=$LIBS +# eval used to expand out TK_DBGX +eval "LIBS=\"$TK_BUILD_LIB_SPEC $TCL_BUILD_LIB_SPEC $TK_LIBS\"" +echo $ac_n "checking for Tk_Init""... $ac_c" 1>&6 +echo "configure:1311: checking for Tk_Init" >&5 +if eval "test \"`echo '$''{'ac_cv_func_Tk_Init'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char Tk_Init(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_Tk_Init) || defined (__stub___Tk_Init) +choke me +#else +Tk_Init(); +#endif + +; return 0; } +EOF +if { (eval echo configure:1339: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_Tk_Init=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_Tk_Init=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'Tk_Init`\" = yes"; then + echo "$ac_t""yes" 1>&6 + + echo $ac_n "checking if Tk library build specification is valid""... $ac_c" 1>&6 +echo "configure:1355: checking if Tk library build specification is valid" >&5 + echo "$ac_t""yes" 1>&6 + +else + echo "$ac_t""no" 1>&6 + + TK_BUILD_LIB_SPEC=$TK_LIB_SPEC + # Can't pull the following CHECKING call out since it will be + # broken up by the CHECK_FUNC just above. + echo $ac_n "checking if Tk library build specification is valid""... $ac_c" 1>&6 +echo "configure:1365: checking if Tk library build specification is valid" >&5 + echo "$ac_t""no" 1>&6 + +fi + +LIBS=$SAVELIBS + + + + +EXP_AND_TK_LIBS=$TK_LIBS + # If we cannot compile and link a trivial program, we can't expect anything to work echo $ac_n "checking whether the compiler ($CC) actually works""... $ac_c" 1>&6 -echo "configure:1133: checking whether the compiler ($CC) actually works" >&5 +echo "configure:1380: checking whether the compiler ($CC) actually works" >&5 cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1389: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* c_compiles=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -1147,30 +1394,28 @@ rm -rf conftest* c_compiles=no fi rm -f conftest* - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1408: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* c_links=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* c_links=no fi rm -f conftest* - if test x"${c_compiles}" = x"no" ; then { echo "configure: error: the native compiler is broken and won't compile." 1>&2; exit 1; } fi @@ -1186,32 +1431,34 @@ # incompatible versions: # SysV /etc/install, /usr/sbin/install # SunOS /usr/etc/install # IRIX /sbin/install # AIX /bin/install +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag # AFS /usr/afsws/bin/install, which mishandles nonexistent args # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:1196: checking for a BSD compatible install" >&5 +echo "configure:1442: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" + IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" for ac_dir in $PATH; do # Account for people who put trailing slashes in PATH elements. case "$ac_dir/" in /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; *) # OSF1 and SCO ODT 3.0 have their own names for install. - for ac_prog in ginstall installbsd scoinst install; do + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do if test -f $ac_dir/$ac_prog; then if test $ac_prog = install && grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. - # OSF/1 installbsd also uses dspmsg, but is usable. : else ac_cv_path_install="$ac_dir/$ac_prog -c" break 2 fi @@ -1218,11 +1465,11 @@ fi done ;; esac done - IFS="$ac_save_ifs" + IFS="$ac_save_IFS" fi if test "${ac_cv_path_install+set}" = set; then INSTALL="$ac_cv_path_install" else @@ -1237,26 +1484,29 @@ # Use test -z because SunOS4 sh mishandles braces in ${var-val}. # It thinks the first close brace ends the variable substitution. test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' + test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' # Tcl sets TCL_RANLIB appropriately for shared library if --enable-shared # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1250: checking for $ac_word" >&5 +echo "configure:1499: checking for $ac_word" >&5 if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_RANLIB="ranlib" break fi @@ -1283,11 +1533,11 @@ # -X is for the old "cc" and "gcc" (based on 1.42) # -mposix is for the new gcc (at least 2.5.8) # This modifies the value of $CC to have the POSIX flag added # so it'll configure correctly echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:1289: checking how to run the C preprocessor" >&5 +echo "configure:1539: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then @@ -1298,43 +1548,62 @@ # substituted into the Makefile and "${CC-cc}" will confuse make. CPP="${CC-cc} -E" # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1310: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:1560: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < +Syntax Error +EOF +ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" +{ (eval echo configure:1577: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` +if test -z "$ac_err"; then + : +else + echo "$ac_err" >&5 + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + CPP="${CC-cc} -nologo -E" + cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1327: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:1594: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then : else echo "$ac_err" >&5 echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* CPP=/lib/cpp +fi +rm -f conftest* fi rm -f conftest* fi rm -f conftest* ac_cv_prog_CPP="$CPP" @@ -1345,16 +1614,16 @@ fi echo "$ac_t""$CPP" 1>&6 echo $ac_n "checking if running LynxOS""... $ac_c" 1>&6 -echo "configure:1351: checking if running LynxOS" >&5 +echo "configure:1620: checking if running LynxOS" >&5 if eval "test \"`echo '$''{'ac_cv_os_lynx'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <> confdefs.h <<\EOF #define LYNX 1 EOF echo $ac_n "checking whether -mposix or -X is available""... $ac_c" 1>&6 -echo "configure:1386: checking whether -mposix or -X is available" >&5 +echo "configure:1655: checking whether -mposix or -X is available" >&5 if eval "test \"`echo '$''{'ac_cv_c_posix_flag'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1676: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_posix_flag=" -mposix" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_c_posix_flag=" -X" fi rm -f conftest* - fi CC="$CC $ac_cv_c_posix_flag" echo "$ac_t""$ac_cv_c_posix_flag" 1>&6 else echo "$ac_t""no" 1>&6 fi -# If we cannot run a trivial program, we are probably using a cross compiler. -echo $ac_n "checking whether using a cross-compiler""... $ac_c" 1>&6 -echo "configure:1429: checking whether using a cross-compiler" >&5 -if eval "test \"`echo '$''{'ac_cv_c_cross'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test "$cross_compiling" = yes; then - ac_cv_c_cross=yes -else - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then - ac_cv_c_cross=no -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_c_cross=yes -fi -rm -fr conftest* -fi - -fi - -echo "$ac_t""$ac_cv_c_cross" 1>&6 -cross_compiling=$ac_cv_c_cross - echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:1459: checking for ANSI C header files" >&5 +echo "configure:1696: checking for ANSI C header files" >&5 if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #include #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1472: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:1709: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* ac_cv_header_stdc=yes else echo "$ac_err" >&5 @@ -1483,11 +1720,11 @@ rm -f conftest* if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "memchr" >/dev/null 2>&1; then @@ -1501,11 +1738,11 @@ fi if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "free" >/dev/null 2>&1; then @@ -1522,11 +1759,11 @@ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. if test "$cross_compiling" = yes; then : else cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') #define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) #define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) @@ -1533,12 +1770,12 @@ int main () { int i; for (i = 0; i < 256; i++) if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); exit (0); } EOF -{ (eval echo configure:1539: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:1776: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then : else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -fr conftest* @@ -1557,25 +1794,25 @@ EOF fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:1563: checking for pid_t" >&5 +echo "configure:1800: checking for pid_t" >&5 if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #if STDC_HEADERS #include #include #endif EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then + egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then rm -rf conftest* ac_cv_type_pid_t=yes else rm -rf conftest* ac_cv_type_pid_t=no @@ -1590,16 +1827,16 @@ EOF fi echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:1596: checking return type of signal handlers" >&5 +echo "configure:1833: checking return type of signal handlers" >&5 if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #ifdef signal #undef signal @@ -1612,55 +1849,53 @@ int main() { int i; ; return 0; } EOF -if { (eval echo configure:1618: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1855: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_type_signal=int fi rm -f conftest* - fi echo "$ac_t""$ac_cv_type_signal" 1>&6 cat >> confdefs.h <&6 -echo "configure:1638: checking whether time.h and sys/time.h may both be included" >&5 +echo "configure:1874: checking whether time.h and sys/time.h may both be included" >&5 if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #include int main() { struct tm *tp; ; return 0; } EOF -if { (eval echo configure:1652: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1888: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_header_time=no fi rm -f conftest* - fi echo "$ac_t""$ac_cv_header_time" 1>&6 if test $ac_cv_header_time = yes; then cat >> confdefs.h <<\EOF @@ -1668,16 +1903,16 @@ EOF fi echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:1674: checking for sys/wait.h that is POSIX.1 compatible" >&5 +echo "configure:1909: checking for sys/wait.h that is POSIX.1 compatible" >&5 if eval "test \"`echo '$''{'ac_cv_header_sys_wait_h'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < #include #ifndef WEXITSTATUS #define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8) @@ -1689,21 +1924,20 @@ int s; wait (&s); s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } EOF -if { (eval echo configure:1695: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:1930: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_sys_wait_h=yes else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* ac_cv_header_sys_wait_h=no fi rm -f conftest* - fi echo "$ac_t""$ac_cv_header_sys_wait_h" 1>&6 if test $ac_cv_header_sys_wait_h = yes; then cat >> confdefs.h <<\EOF @@ -1711,18 +1945,32 @@ EOF fi -EXP_CFLAGS=-g +# Check whether --enable-symbols or --disable-symbols was given. +if test "${enable_symbols+set}" = set; then + enableval="$enable_symbols" + enable_symbols=$enableval +else + enable_symbols=no +fi + +if test "$enable_symbols" = "no"; then + EXP_CFLAGS="$TCL_EXTRA_CFLAGS" +else + EXP_CFLAGS="-g $TCL_EXTRA_CFLAGS" + # This is always "g" for unix. + DBGX=g +fi case "${host}" in # Use -g on all systems but Linux where it upsets the dynamic X libraries. i[3456]86-*-linux*) EXP_CFLAGS="" ;; esac echo $ac_n "checking if running Mach""... $ac_c" 1>&6 -echo "configure:1724: checking if running Mach" >&5 +echo "configure:1972: checking if running Mach" >&5 mach=0 case "${host}" in # Both Next and pure Mach behave identically with respect # to a few things, so just lump them together as "mach" *-*-mach*) mach=1 ;; @@ -1734,51 +1982,51 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking if running MachTen""... $ac_c" 1>&6 -echo "configure:1740: checking if running MachTen" >&5 +echo "configure:1988: checking if running MachTen" >&5 # yet another Mach clone if test -r /MachTen ; then echo "$ac_t""yes" 1>&6 mach=1 else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking if on Pyramid""... $ac_c" 1>&6 -echo "configure:1750: checking if on Pyramid" >&5 +echo "configure:1998: checking if on Pyramid" >&5 if test -r /bin/pyr ; then echo "$ac_t""yes" 1>&6 pyr=1 else echo "$ac_t""no" 1>&6 pyr=0 fi echo $ac_n "checking if on Apollo""... $ac_c" 1>&6 -echo "configure:1760: checking if on Apollo" >&5 +echo "configure:2008: checking if on Apollo" >&5 if test -r /usr/apollo/bin ; then echo "$ac_t""yes" 1>&6 apollo=1 else echo "$ac_t""no" 1>&6 apollo=0 fi echo $ac_n "checking if on Interactive""... $ac_c" 1>&6 -echo "configure:1770: checking if on Interactive" >&5 +echo "configure:2018: checking if on Interactive" >&5 if test "x`(uname -s) 2>/dev/null`" = xIUNIX; then echo "$ac_t""yes" 1>&6 iunix=1 else echo "$ac_t""no" 1>&6 iunix=0 fi echo $ac_n "checking if stty reads stdout""... $ac_c" 1>&6 -echo "configure:1780: checking if stty reads stdout" >&5 +echo "configure:2028: checking if stty reads stdout" >&5 # On some systems stty can't be run in the background (svr4) or get it # wrong because they fail to complain (next, mach), so don't attempt # the test on some systems. @@ -1830,11 +2078,11 @@ fi # Solaris 2.4 and later requires __EXTENSIONS__ in order to see all sorts # of traditional but nonstandard stuff in header files. echo $ac_n "checking if running Solaris""... $ac_c" 1>&6 -echo "configure:1836: checking if running Solaris" >&5 +echo "configure:2084: checking if running Solaris" >&5 solaris=0 case "${host}" in *-*-solaris*) solaris=1;; esac @@ -1850,16 +2098,16 @@ # On a few systems, libm.a is the same as libc.a # Don't bother to test against Tcl and Tk libs, they always include -lm echo $ac_n "checking for sin""... $ac_c" 1>&6 -echo "configure:1856: checking for sin" >&5 +echo "configure:2104: checking for sin" >&5 if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -1878,22 +2126,22 @@ sin(); #endif ; return 0; } EOF -if { (eval echo configure:1884: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2132: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_sin=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_sin=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 @@ -1908,16 +2156,16 @@ # the Makefile, but we include it for consistency.) if test $iunix -eq 1 ; then EXP_LIBS=$LIBS LIBS=$EXP_AND_TCL_LIBS echo $ac_n "checking for strftime""... $ac_c" 1>&6 -echo "configure:1914: checking for strftime" >&5 +echo "configure:2162: checking for strftime" >&5 if eval "test \"`echo '$''{'ac_cv_func_strftime'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -1936,22 +2184,22 @@ strftime(); #endif ; return 0; } EOF -if { (eval echo configure:1942: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2190: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strftime=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_strftime=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'strftime`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 @@ -1976,11 +2224,11 @@ # be careful that we don't match stuff like tclX by accident. # the alternative search directory is involked by --with-tclinclude # no_tcl=true echo $ac_n "checking for Tcl private headers""... $ac_c" 1>&6 -echo "configure:1982: checking for Tcl private headers" >&5 +echo "configure:2230: checking for Tcl private headers" >&5 # Check whether --with-tclinclude or --without-tclinclude was given. if test "${with_tclinclude+set}" = set; then withval="$with_tclinclude" with_tclinclude=${withval} fi @@ -2011,15 +2259,18 @@ # # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tclh}" = x ; then for i in \ ${srcdir}/../tcl \ - `ls -dr ${srcdir}/../tcl[7-9].[0-9].[0-9] ${srcdir}/../tcl[7-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[9].[0-9].[0-9] ${srcdir}/../tcl[9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8].[2-9].[0-9] ${srcdir}/../tcl[8].[2-9] 2>/dev/null` \ ${srcdir}/../../tcl \ - `ls -dr ${srcdir}/../../tcl[7-9].[0-9].[0-9] ${srcdir}/../../tcl[7-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../../tcl[9].[0-9].[0-9] ${srcdir}/../../tcl[9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../../tcl[8].[2-9].[0-9] ${srcdir}/../../tcl[8].[2-9] 2>/dev/null` \ ${srcdir}/../../../tcl \ - `ls -dr ${srcdir}/../../../tcl[7-9].[0-9].[0-9] ${srcdir}/../../../tcl[7-9].[0-9] 2>/dev/null ` ; do + `ls -dr ${srcdir}/../../../tcl[9].[0-9].[0-9] ${srcdir}/../../../tcl[9].[0-9] 2>/dev/null ` \ + `ls -dr ${srcdir}/../../../tcl[8].[2-9].[0-9] ${srcdir}/../../../tcl[8].[2-9] 2>/dev/null ` ; do if test -f $i/generic/tclInt.h ; then ac_cv_c_tclh=`(cd $i/generic; pwd)` break fi done @@ -2027,12 +2278,14 @@ # finally check in a few common install locations # # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tclh}" = x ; then for i in \ - `ls -dr /usr/local/src/tcl[7-9].[0-9].[0-9] /usr/local/src/tcl[7-9].[0-9] 2>/dev/null` \ - `ls -dr /usr/local/lib/tcl[7-9].[0-9].[0-9] /usr/local/lib/tcl[7-9].[0-9] 2>/dev/null` \ + `ls -dr /usr/local/src/tcl[9].[0-9].[0-9] /usr/local/src/tcl[9].[0-9] 2>/dev/null` \ + `ls -dr /usr/local/src/tcl[8].[2-9].[0-9] /usr/local/src/tcl[8].[2-9] 2>/dev/null` \ + `ls -dr /usr/local/lib/tcl[9].[0-9].[0-9] /usr/local/lib/tcl[9].[0-9] 2>/dev/null` \ + `ls -dr /usr/local/lib/tcl[8].[2-9].[0-9] /usr/local/lib/tcl[8].[2-9] 2>/dev/null` \ /usr/local/src/tcl \ /usr/local/lib/tcl \ ${prefix}/include ; do if test -f $i/generic/tclInt.h ; then ac_cv_c_tclh=`(cd $i/generic; pwd)` @@ -2042,22 +2295,22 @@ fi # see if one is installed if test x"${ac_cv_c_tclh}" = x ; then ac_safe=`echo "tclInt.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for tclInt.h""... $ac_c" 1>&6 -echo "configure:2048: checking for tclInt.h" >&5 +echo "configure:2301: checking for tclInt.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2058: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:2311: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -2113,11 +2366,11 @@ exit 1 fi # have to know whether we're generating shared libs before configuring debugger echo $ac_n "checking type of library to build""... $ac_c" 1>&6 -echo "configure:2119: checking type of library to build" >&5 +echo "configure:2372: checking type of library to build" >&5 # Check whether --enable-shared or --disable-shared was given. if test "${enable_shared+set}" = set; then enableval="$enable_shared" enable_shared=$enableval else @@ -2192,16 +2445,16 @@ ###################################################################### # required by Sequent ptx2 unset ac_cv_func_gethostname echo $ac_n "checking for gethostname""... $ac_c" 1>&6 -echo "configure:2198: checking for gethostname" >&5 +echo "configure:2451: checking for gethostname" >&5 if eval "test \"`echo '$''{'ac_cv_func_gethostname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2220,22 +2473,22 @@ gethostname(); #endif ; return 0; } EOF -if { (eval echo configure:2226: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2479: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostname=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_gethostname=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'gethostname`\" = yes"; then echo "$ac_t""yes" 1>&6 gethostname=1 else echo "$ac_t""no" 1>&6 @@ -2243,19 +2496,19 @@ fi if test $gethostname -eq 0 ; then unset ac_cv_lib_inet_gethostname echo $ac_n "checking for gethostname in -linet""... $ac_c" 1>&6 -echo "configure:2249: checking for gethostname in -linet" >&5 +echo "configure:2502: checking for gethostname in -linet" >&5 ac_lib_var=`echo inet'_'gethostname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2521: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2288,16 +2541,16 @@ # save results and retry for Tcl EXP_LIBS=$LIBS LIBS=$EXP_AND_TCL_LIBS unset ac_cv_func_gethostname echo $ac_n "checking for gethostname""... $ac_c" 1>&6 -echo "configure:2294: checking for gethostname" >&5 +echo "configure:2547: checking for gethostname" >&5 if eval "test \"`echo '$''{'ac_cv_func_gethostname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2316,22 +2569,22 @@ gethostname(); #endif ; return 0; } EOF -if { (eval echo configure:2322: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2575: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostname=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_gethostname=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'gethostname`\" = yes"; then echo "$ac_t""yes" 1>&6 gethostname=1 else echo "$ac_t""no" 1>&6 @@ -2339,19 +2592,19 @@ fi if test $gethostname -eq 0 ; then unset ac_cv_lib_inet_gethostname echo $ac_n "checking for gethostname in -linet""... $ac_c" 1>&6 -echo "configure:2345: checking for gethostname in -linet" >&5 +echo "configure:2598: checking for gethostname in -linet" >&5 ac_lib_var=`echo inet'_'gethostname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2617: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2384,16 +2637,16 @@ # save Tcl results and retry for Tk EXP_AND_TCL_LIBS=$LIBS LIBS=$EXP_AND_TK_LIBS unset ac_cv_func_gethostname echo $ac_n "checking for gethostname""... $ac_c" 1>&6 -echo "configure:2390: checking for gethostname" >&5 +echo "configure:2643: checking for gethostname" >&5 if eval "test \"`echo '$''{'ac_cv_func_gethostname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2412,22 +2665,22 @@ gethostname(); #endif ; return 0; } EOF -if { (eval echo configure:2418: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2671: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_gethostname=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_gethostname=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'gethostname`\" = yes"; then echo "$ac_t""yes" 1>&6 gethostname=1 else echo "$ac_t""no" 1>&6 @@ -2435,19 +2688,19 @@ fi if test $gethostname -eq 0 ; then unset ac_cv_lib_inet_gethostname echo $ac_n "checking for gethostname in -linet""... $ac_c" 1>&6 -echo "configure:2441: checking for gethostname in -linet" >&5 +echo "configure:2694: checking for gethostname in -linet" >&5 ac_lib_var=`echo inet'_'gethostname | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2713: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2483,16 +2736,16 @@ ###################################################################### # required by Fischman's ISC 4.0 unset ac_cv_func_socket echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:2489: checking for socket" >&5 +echo "configure:2742: checking for socket" >&5 if eval "test \"`echo '$''{'ac_cv_func_socket'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2511,22 +2764,22 @@ socket(); #endif ; return 0; } EOF -if { (eval echo configure:2517: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2770: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_socket=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_socket=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'socket`\" = yes"; then echo "$ac_t""yes" 1>&6 socket=1 else echo "$ac_t""no" 1>&6 @@ -2534,19 +2787,19 @@ fi if test $socket -eq 0 ; then unset ac_cv_lib_inet_socket echo $ac_n "checking for socket in -linet""... $ac_c" 1>&6 -echo "configure:2540: checking for socket in -linet" >&5 +echo "configure:2793: checking for socket in -linet" >&5 ac_lib_var=`echo inet'_'socket | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2812: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2579,16 +2832,16 @@ # save results and retry for Tcl EXP_LIBS=$LIBS LIBS=$EXP_AND_TCL_LIBS unset ac_cv_func_socket echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:2585: checking for socket" >&5 +echo "configure:2838: checking for socket" >&5 if eval "test \"`echo '$''{'ac_cv_func_socket'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2607,22 +2860,22 @@ socket(); #endif ; return 0; } EOF -if { (eval echo configure:2613: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2866: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_socket=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_socket=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'socket`\" = yes"; then echo "$ac_t""yes" 1>&6 socket=1 else echo "$ac_t""no" 1>&6 @@ -2630,19 +2883,19 @@ fi if test $socket -eq 0 ; then unset ac_cv_lib_inet_socket echo $ac_n "checking for socket in -linet""... $ac_c" 1>&6 -echo "configure:2636: checking for socket in -linet" >&5 +echo "configure:2889: checking for socket in -linet" >&5 ac_lib_var=`echo inet'_'socket | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2908: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2675,16 +2928,16 @@ # save Tcl results and retry for Tk EXP_AND_TCL_LIBS=$LIBS LIBS=$EXP_AND_TK_LIBS unset ac_cv_func_socket echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:2681: checking for socket" >&5 +echo "configure:2934: checking for socket" >&5 if eval "test \"`echo '$''{'ac_cv_func_socket'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2703,22 +2956,22 @@ socket(); #endif ; return 0; } EOF -if { (eval echo configure:2709: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2962: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_socket=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_socket=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'socket`\" = yes"; then echo "$ac_t""yes" 1>&6 socket=1 else echo "$ac_t""no" 1>&6 @@ -2726,19 +2979,19 @@ fi if test $socket -eq 0 ; then unset ac_cv_lib_inet_socket echo $ac_n "checking for socket in -linet""... $ac_c" 1>&6 -echo "configure:2732: checking for socket in -linet" >&5 +echo "configure:2985: checking for socket in -linet" >&5 ac_lib_var=`echo inet'_'socket | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3004: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2773,16 +3026,16 @@ LIBS=$EXP_LIBS ###################################################################### unset ac_cv_func_select echo $ac_n "checking for select""... $ac_c" 1>&6 -echo "configure:2779: checking for select" >&5 +echo "configure:3032: checking for select" >&5 if eval "test \"`echo '$''{'ac_cv_func_select'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2801,22 +3054,22 @@ select(); #endif ; return 0; } EOF -if { (eval echo configure:2807: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3060: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_select=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_select=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'select`\" = yes"; then echo "$ac_t""yes" 1>&6 select=1 else echo "$ac_t""no" 1>&6 @@ -2824,19 +3077,19 @@ fi if test $select -eq 0 ; then unset ac_cv_lib_inet_select echo $ac_n "checking for select in -linet""... $ac_c" 1>&6 -echo "configure:2830: checking for select in -linet" >&5 +echo "configure:3083: checking for select in -linet" >&5 ac_lib_var=`echo inet'_'select | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3102: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2869,16 +3122,16 @@ # save results and retry for Tcl EXP_LIBS=$LIBS LIBS=$EXP_AND_TCL_LIBS unset ac_cv_func_select echo $ac_n "checking for select""... $ac_c" 1>&6 -echo "configure:2875: checking for select" >&5 +echo "configure:3128: checking for select" >&5 if eval "test \"`echo '$''{'ac_cv_func_select'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2897,22 +3150,22 @@ select(); #endif ; return 0; } EOF -if { (eval echo configure:2903: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3156: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_select=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_select=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'select`\" = yes"; then echo "$ac_t""yes" 1>&6 select=1 else echo "$ac_t""no" 1>&6 @@ -2920,19 +3173,19 @@ fi if test $select -eq 0 ; then unset ac_cv_lib_inet_select echo $ac_n "checking for select in -linet""... $ac_c" 1>&6 -echo "configure:2926: checking for select in -linet" >&5 +echo "configure:3179: checking for select in -linet" >&5 ac_lib_var=`echo inet'_'select | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3198: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -2965,16 +3218,16 @@ # save Tcl results and retry for Tk EXP_AND_TCL_LIBS=$LIBS LIBS=$EXP_AND_TK_LIBS unset ac_cv_func_select echo $ac_n "checking for select""... $ac_c" 1>&6 -echo "configure:2971: checking for select" >&5 +echo "configure:3224: checking for select" >&5 if eval "test \"`echo '$''{'ac_cv_func_select'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -2993,22 +3246,22 @@ select(); #endif ; return 0; } EOF -if { (eval echo configure:2999: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3252: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_select=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_select=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'select`\" = yes"; then echo "$ac_t""yes" 1>&6 select=1 else echo "$ac_t""no" 1>&6 @@ -3016,19 +3269,19 @@ fi if test $select -eq 0 ; then unset ac_cv_lib_inet_select echo $ac_n "checking for select in -linet""... $ac_c" 1>&6 -echo "configure:3022: checking for select in -linet" >&5 +echo "configure:3275: checking for select in -linet" >&5 ac_lib_var=`echo inet'_'select | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-linet $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3294: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3063,16 +3316,16 @@ LIBS=$EXP_LIBS ###################################################################### unset ac_cv_func_getpseudotty echo $ac_n "checking for getpseudotty""... $ac_c" 1>&6 -echo "configure:3069: checking for getpseudotty" >&5 +echo "configure:3322: checking for getpseudotty" >&5 if eval "test \"`echo '$''{'ac_cv_func_getpseudotty'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -3091,22 +3344,22 @@ getpseudotty(); #endif ; return 0; } EOF -if { (eval echo configure:3097: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3350: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_getpseudotty=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_getpseudotty=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'getpseudotty`\" = yes"; then echo "$ac_t""yes" 1>&6 getpseudotty=1 else echo "$ac_t""no" 1>&6 @@ -3114,19 +3367,19 @@ fi if test $getpseudotty -eq 0 ; then unset ac_cv_lib_seq_getpseudotty echo $ac_n "checking for getpseudotty in -lseq""... $ac_c" 1>&6 -echo "configure:3120: checking for getpseudotty in -lseq" >&5 +echo "configure:3373: checking for getpseudotty in -lseq" >&5 ac_lib_var=`echo seq'_'getpseudotty | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lseq $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3392: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3166,16 +3419,16 @@ # save results and retry for Tcl EXP_LIBS=$LIBS LIBS=$EXP_AND_TCL_LIBS unset ac_cv_func_getpseudotty echo $ac_n "checking for getpseudotty""... $ac_c" 1>&6 -echo "configure:3172: checking for getpseudotty" >&5 +echo "configure:3425: checking for getpseudotty" >&5 if eval "test \"`echo '$''{'ac_cv_func_getpseudotty'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -3194,22 +3447,22 @@ getpseudotty(); #endif ; return 0; } EOF -if { (eval echo configure:3200: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3453: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_getpseudotty=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_getpseudotty=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'getpseudotty`\" = yes"; then echo "$ac_t""yes" 1>&6 getpseudotty=1 else echo "$ac_t""no" 1>&6 @@ -3217,19 +3470,19 @@ fi if test $getpseudotty -eq 0 ; then unset ac_cv_lib_seq_getpseudotty echo $ac_n "checking for getpseudotty in -lseq""... $ac_c" 1>&6 -echo "configure:3223: checking for getpseudotty in -lseq" >&5 +echo "configure:3476: checking for getpseudotty in -lseq" >&5 ac_lib_var=`echo seq'_'getpseudotty | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lseq $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3495: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3269,16 +3522,16 @@ # save Tcl results and retry for Tk EXP_AND_TCL_LIBS=$LIBS LIBS=$EXP_AND_TK_LIBS unset ac_cv_func_getpseudotty echo $ac_n "checking for getpseudotty""... $ac_c" 1>&6 -echo "configure:3275: checking for getpseudotty" >&5 +echo "configure:3528: checking for getpseudotty" >&5 if eval "test \"`echo '$''{'ac_cv_func_getpseudotty'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -3297,22 +3550,22 @@ getpseudotty(); #endif ; return 0; } EOF -if { (eval echo configure:3303: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3556: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_getpseudotty=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_getpseudotty=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'getpseudotty`\" = yes"; then echo "$ac_t""yes" 1>&6 getpseudotty=1 else echo "$ac_t""no" 1>&6 @@ -3320,19 +3573,19 @@ fi if test $getpseudotty -eq 0 ; then unset ac_cv_lib_seq_getpseudotty echo $ac_n "checking for getpseudotty in -lseq""... $ac_c" 1>&6 -echo "configure:3326: checking for getpseudotty in -lseq" >&5 +echo "configure:3579: checking for getpseudotty in -lseq" >&5 ac_lib_var=`echo seq'_'getpseudotty | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lseq $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3598: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3375,16 +3628,16 @@ ###################################################################### # Check for FreeBSD/NetBSD openpty() unset ac_cv_func_openpty echo $ac_n "checking for openpty""... $ac_c" 1>&6 -echo "configure:3381: checking for openpty" >&5 +echo "configure:3634: checking for openpty" >&5 if eval "test \"`echo '$''{'ac_cv_func_openpty'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -3403,22 +3656,22 @@ openpty(); #endif ; return 0; } EOF -if { (eval echo configure:3409: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3662: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_openpty=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_openpty=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'openpty`\" = yes"; then echo "$ac_t""yes" 1>&6 openpty=1 else echo "$ac_t""no" 1>&6 @@ -3426,19 +3679,19 @@ fi if test $openpty -eq 0 ; then unset ac_cv_lib_util_openpty echo $ac_n "checking for openpty in -lutil""... $ac_c" 1>&6 -echo "configure:3432: checking for openpty in -lutil" >&5 +echo "configure:3685: checking for openpty in -lutil" >&5 ac_lib_var=`echo util'_'openpty | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lutil $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3704: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3480,16 +3733,16 @@ # save results and retry for Tcl EXP_LIBS=$LIBS LIBS=$EXP_AND_TCL_LIBS unset ac_cv_func_openpty echo $ac_n "checking for openpty""... $ac_c" 1>&6 -echo "configure:3486: checking for openpty" >&5 +echo "configure:3739: checking for openpty" >&5 if eval "test \"`echo '$''{'ac_cv_func_openpty'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -3508,22 +3761,22 @@ openpty(); #endif ; return 0; } EOF -if { (eval echo configure:3514: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3767: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_openpty=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_openpty=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'openpty`\" = yes"; then echo "$ac_t""yes" 1>&6 openpty=1 else echo "$ac_t""no" 1>&6 @@ -3531,19 +3784,19 @@ fi if test $openpty -eq 0 ; then unset ac_cv_lib_util_openpty echo $ac_n "checking for openpty in -lutil""... $ac_c" 1>&6 -echo "configure:3537: checking for openpty in -lutil" >&5 +echo "configure:3790: checking for openpty in -lutil" >&5 ac_lib_var=`echo util'_'openpty | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lutil $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3809: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3582,16 +3835,16 @@ # save Tcl results and retry for Tk EXP_AND_TCL_LIBS=$LIBS LIBS=$EXP_AND_TK_LIBS unset ac_cv_func_openpty echo $ac_n "checking for openpty""... $ac_c" 1>&6 -echo "configure:3588: checking for openpty" >&5 +echo "configure:3841: checking for openpty" >&5 if eval "test \"`echo '$''{'ac_cv_func_openpty'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -3610,22 +3863,22 @@ openpty(); #endif ; return 0; } EOF -if { (eval echo configure:3616: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3869: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_openpty=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_openpty=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'openpty`\" = yes"; then echo "$ac_t""yes" 1>&6 openpty=1 else echo "$ac_t""no" 1>&6 @@ -3633,19 +3886,19 @@ fi if test $openpty -eq 0 ; then unset ac_cv_lib_util_openpty echo $ac_n "checking for openpty in -lutil""... $ac_c" 1>&6 -echo "configure:3639: checking for openpty in -lutil" >&5 +echo "configure:3892: checking for openpty in -lutil" >&5 ac_lib_var=`echo util'_'openpty | sed 'y%./+-%__p_%'` if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_save_LIBS="$LIBS" LIBS="-lutil $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 @@ -3686,29 +3939,40 @@ LIBS=$EXP_LIBS ###################################################################### # End of library/func checking ###################################################################### + +# Hand patches to library/func checking. + +echo $ac_n "checking if running Sequent running SVR4""... $ac_c" 1>&6 +echo "configure:3949: checking if running Sequent running SVR4" >&5 +if test "$host_alias" = "i386-sequent-sysv4" ; then + EXP_AND_TCL_LIBS="-lnsl -lsocket -lm" + echo "$ac_t""yes" 1>&6 +else + echo "$ac_t""no" 1>&6 +fi ###################################################################### # # Look for various header files # ac_safe=`echo "sys/sysmacros.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/sysmacros.h""... $ac_c" 1>&6 -echo "configure:3699: checking for sys/sysmacros.h" >&5 +echo "configure:3963: checking for sys/sysmacros.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3709: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:3973: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3729,22 +3993,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6 -echo "configure:3735: checking for stdlib.h" >&5 +echo "configure:3999: checking for stdlib.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3745: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4009: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3766,22 +4030,22 @@ fi ac_safe=`echo "inttypes.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for inttypes.h""... $ac_c" 1>&6 -echo "configure:3772: checking for inttypes.h" >&5 +echo "configure:4036: checking for inttypes.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3782: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4046: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3806,22 +4070,22 @@ # Oddly, some systems have stdarg but don't support prototypes # Tcl avoids the whole issue by not using stdarg on UNIX at all! ac_safe=`echo "varargs.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for varargs.h""... $ac_c" 1>&6 -echo "configure:3812: checking for varargs.h" >&5 +echo "configure:4076: checking for varargs.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3822: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4086: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3842,22 +4106,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "unistd.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for unistd.h""... $ac_c" 1>&6 -echo "configure:3848: checking for unistd.h" >&5 +echo "configure:4112: checking for unistd.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3858: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4122: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3876,24 +4140,26 @@ else echo "$ac_t""no" 1>&6 fi +# If no stropts.h, then the svr4 implementation is broken. +# At least it is on my Debian "potato" system. - Rob Savoye ac_safe=`echo "sys/stropts.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/stropts.h""... $ac_c" 1>&6 -echo "configure:3884: checking for sys/stropts.h" >&5 +echo "configure:4150: checking for sys/stropts.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3894: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4160: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3910,26 +4176,27 @@ #define HAVE_STROPTS_H 1 EOF else echo "$ac_t""no" 1>&6 +svr4_ptys_broken=1 fi ac_safe=`echo "sys/sysconfig.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/sysconfig.h""... $ac_c" 1>&6 -echo "configure:3920: checking for sys/sysconfig.h" >&5 +echo "configure:4187: checking for sys/sysconfig.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3930: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4197: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3950,22 +4217,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "sys/fcntl.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/fcntl.h""... $ac_c" 1>&6 -echo "configure:3956: checking for sys/fcntl.h" >&5 +echo "configure:4223: checking for sys/fcntl.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3966: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4233: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -3986,22 +4253,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "sys/select.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/select.h""... $ac_c" 1>&6 -echo "configure:3992: checking for sys/select.h" >&5 +echo "configure:4259: checking for sys/select.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4002: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4269: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -4022,22 +4289,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "sys/time.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/time.h""... $ac_c" 1>&6 -echo "configure:4028: checking for sys/time.h" >&5 +echo "configure:4295: checking for sys/time.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4038: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4305: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -4058,22 +4325,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "sys/ptem.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/ptem.h""... $ac_c" 1>&6 -echo "configure:4064: checking for sys/ptem.h" >&5 +echo "configure:4331: checking for sys/ptem.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4074: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4341: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -4094,22 +4361,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "sys/strredir.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/strredir.h""... $ac_c" 1>&6 -echo "configure:4100: checking for sys/strredir.h" >&5 +echo "configure:4367: checking for sys/strredir.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4110: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4377: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -4130,22 +4397,22 @@ echo "$ac_t""no" 1>&6 fi ac_safe=`echo "sys/strpty.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for sys/strpty.h""... $ac_c" 1>&6 -echo "configure:4136: checking for sys/strpty.h" >&5 +echo "configure:4403: checking for sys/strpty.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4146: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4413: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -4167,30 +4434,30 @@ fi echo $ac_n "checking for sys/bsdtypes.h""... $ac_c" 1>&6 -echo "configure:4173: checking for sys/bsdtypes.h" >&5 +echo "configure:4440: checking for sys/bsdtypes.h" >&5 if test "ISC_${ISC}" = "ISC_1" ; then echo "$ac_t""yes" 1>&6 # if on ISC 1, we need to get FD_SET macros for ac_hdr in sys/bsdtypes.h do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:4181: checking for $ac_hdr" >&5 +echo "configure:4448: checking for $ac_hdr" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4191: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:4458: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -4219,16 +4486,16 @@ # # Look for functions that may be missing # echo $ac_n "checking for memmove""... $ac_c" 1>&6 -echo "configure:4225: checking for memmove" >&5 +echo "configure:4492: checking for memmove" >&5 if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4247,22 +4514,22 @@ memmove(); #endif ; return 0; } EOF -if { (eval echo configure:4253: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4520: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_memmove=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_memmove=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'memmove`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_MEMMOVE 1 EOF @@ -4270,16 +4537,16 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for sysconf""... $ac_c" 1>&6 -echo "configure:4276: checking for sysconf" >&5 +echo "configure:4543: checking for sysconf" >&5 if eval "test \"`echo '$''{'ac_cv_func_sysconf'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4298,22 +4565,22 @@ sysconf(); #endif ; return 0; } EOF -if { (eval echo configure:4304: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4571: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_sysconf=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_sysconf=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'sysconf`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_SYSCONF 1 EOF @@ -4321,16 +4588,16 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for strftime""... $ac_c" 1>&6 -echo "configure:4327: checking for strftime" >&5 +echo "configure:4594: checking for strftime" >&5 if eval "test \"`echo '$''{'ac_cv_func_strftime'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4349,22 +4616,22 @@ strftime(); #endif ; return 0; } EOF -if { (eval echo configure:4355: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4622: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strftime=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_strftime=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'strftime`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_STRFTIME 1 EOF @@ -4372,16 +4639,16 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for strchr""... $ac_c" 1>&6 -echo "configure:4378: checking for strchr" >&5 +echo "configure:4645: checking for strchr" >&5 if eval "test \"`echo '$''{'ac_cv_func_strchr'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4400,22 +4667,22 @@ strchr(); #endif ; return 0; } EOF -if { (eval echo configure:4406: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4673: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_strchr=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_strchr=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'strchr`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_STRCHR 1 EOF @@ -4423,16 +4690,16 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for timezone""... $ac_c" 1>&6 -echo "configure:4429: checking for timezone" >&5 +echo "configure:4696: checking for timezone" >&5 if eval "test \"`echo '$''{'ac_cv_func_timezone'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4451,27 +4718,78 @@ timezone(); #endif ; return 0; } EOF -if { (eval echo configure:4457: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4724: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_timezone=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_timezone=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'timezone`\" = yes"; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_TIMEZONE 1 EOF + +else + echo "$ac_t""no" 1>&6 +fi + +echo $ac_n "checking for siglongjmp""... $ac_c" 1>&6 +echo "configure:4747: checking for siglongjmp" >&5 +if eval "test \"`echo '$''{'ac_cv_func_siglongjmp'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char siglongjmp(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_siglongjmp) || defined (__stub___siglongjmp) +choke me +#else +siglongjmp(); +#endif + +; return 0; } +EOF +if { (eval echo configure:4775: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_siglongjmp=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_siglongjmp=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'siglongjmp`\" = yes"; then + echo "$ac_t""yes" 1>&6 + cat >> confdefs.h <<\EOF +#define HAVE_SIGLONGJMP 1 +EOF else echo "$ac_t""no" 1>&6 fi @@ -4478,23 +4796,23 @@ # dnl check for memcpy by hand # because Unixware 2.0 handles it specially and refuses to compile # autoconf's automatic test that is a call with no arguments echo $ac_n "checking for memcpy""... $ac_c" 1>&6 -echo "configure:4484: checking for memcpy" >&5 +echo "configure:4802: checking for memcpy" >&5 cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4814: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_MEMCPY 1 EOF @@ -4507,23 +4825,22 @@ echo "$ac_t""no" 1>&6 fi rm -f conftest* - # Some systems only define WNOHANG if _POSIX_SOURCE is defined # The following merely tests that sys/wait.h can be included # and if so that WNOHANG is not defined. The only place I've # seen this is ISC. echo $ac_n "checking if WNOHANG requires _POSIX_SOURCE""... $ac_c" 1>&6 -echo "configure:4519: checking if WNOHANG requires _POSIX_SOURCE" >&5 +echo "configure:4836: checking if WNOHANG requires _POSIX_SOURCE" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < main() { #ifndef WNOHANG @@ -4531,12 +4848,12 @@ #else return 1; #endif } EOF -{ (eval echo configure:4537: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:4854: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define WNOHANG_REQUIRES_POSIX_SOURCE 1 EOF @@ -4551,18 +4868,18 @@ rm -fr conftest* fi echo $ac_n "checking if any value exists for WNOHANG""... $ac_c" 1>&6 -echo "configure:4557: checking if any value exists for WNOHANG" >&5 +echo "configure:4874: checking if any value exists for WNOHANG" >&5 rm -rf wnohang if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < #include main() { @@ -4574,12 +4891,12 @@ #else return 1; #endif } EOF -{ (eval echo configure:4580: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:4897: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then echo "$ac_t""yes" 1>&6 cat >> confdefs.h < defines the type +# "union wait" correctly. It's needed because of weirdness in +# HP-UX where "union wait" is defined in both the BSD and SYS-V +# environments. Checking the usability of WIFEXITED seems to do +# the trick. +#-------------------------------------------------------------------- + +echo $ac_n "checking union wait""... $ac_c" 1>&6 +echo "configure:4930: checking union wait" >&5 +cat > conftest.$ac_ext < +#include +int main() { + +union wait x; +WIFEXITED(x); /* Generates compiler error if WIFEXITED + * uses an int. */ + +; return 0; } +EOF +if { (eval echo configure:4944: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + tcl_ok=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + tcl_ok=no +fi +rm -f conftest* +echo "$ac_t""$tcl_ok" 1>&6 +if test $tcl_ok = no; then + cat >> confdefs.h <<\EOF +#define NO_UNION_WAIT 1 +EOF + +fi + + # # check how signals work # @@ -4608,11 +4968,11 @@ # This picks up HP braindamage which defines fd_set and then # proceeds to ignore it and use int. # Pattern matching on int could be loosened. # Can't use ac_header_egrep since that doesn't see prototypes with K&R cpp. echo $ac_n "checking mask type of select""... $ac_c" 1>&6 -echo "configure:4614: checking mask type of select" >&5 +echo "configure:4974: checking mask type of select" >&5 if egrep "select\(size_t, int" /usr/include/sys/time.h >/dev/null 2>&1; then echo "$ac_t""int" 1>&6 cat >> confdefs.h <<\EOF #define SELECT_MASK_TYPE int EOF @@ -4622,17 +4982,17 @@ fi # FIXME: check if alarm exists echo $ac_n "checking if signals need to be re-armed""... $ac_c" 1>&6 -echo "configure:4628: checking if signals need to be re-armed" >&5 +echo "configure:4988: checking if signals need to be re-armed" >&5 if test "$cross_compiling" = yes; then echo "configure: warning: Expect can't be cross compiled" 1>&2 else cat > conftest.$ac_ext < #define RETSIGTYPE $retsigtype @@ -4667,12 +5027,12 @@ unlink("core"); exit(signal_rearms); } } EOF -{ (eval echo configure:4673: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5033: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define REARM_SIG 1 EOF @@ -4698,11 +5058,11 @@ # There are multiple versions of getpty, alas. # I don't remember who has the first one, but Convex just added one # so check for it. Unfortunately, there is no header so the only # reasonable way to make sure is to look it we are on a Convex. echo $ac_n "checking if on Convex""... $ac_c" 1>&6 -echo "configure:4704: checking if on Convex" >&5 +echo "configure:5064: checking if on Convex" >&5 convex=0 case "${host}" in c[12]-*-*) convex=1;; esac @@ -4714,14 +5074,14 @@ else echo "$ac_t""no" 1>&6 fi -EXP_LDFLAGS= +EXP_LDFLAGS="$LDFLAGS" echo $ac_n "checking if on NeXT""... $ac_c" 1>&6 -echo "configure:4723: checking if on NeXT" >&5 +echo "configure:5083: checking if on NeXT" >&5 if test -r /NextApps ; then echo "$ac_t""yes" 1>&6 # "-m" flag suppresses complaints about multiple strtod EXP_LDFLAGS="$EXP_LDFLAGS -m" else @@ -4728,21 +5088,21 @@ echo "$ac_t""no" 1>&6 fi echo $ac_n "checking if on HP""... $ac_c" 1>&6 -echo "configure:4734: checking if on HP" >&5 +echo "configure:5094: checking if on HP" >&5 if test "x`(uname) 2>/dev/null`" = xHP-UX; then echo "$ac_t""yes" 1>&6 hp=1 else echo "$ac_t""no" 1>&6 hp=0 fi echo $ac_n "checking sane default stty arguments""... $ac_c" 1>&6 -echo "configure:4744: checking sane default stty arguments" >&5 +echo "configure:5104: checking sane default stty arguments" >&5 DEFAULT_STTY_ARGS="sane" if test $mach -eq 1 ; then DEFAULT_STTY_ARGS="cooked" fi @@ -4756,11 +5116,11 @@ # Look for various features to determine what kind of pty # we have. For some weird reason, ac_compile_check would not # work, but ac_test_program does. # echo $ac_n "checking for HP style pty allocation""... $ac_c" 1>&6 -echo "configure:4762: checking for HP style pty allocation" >&5 +echo "configure:5122: checking for HP style pty allocation" >&5 # following test fails on DECstations and other things that don't grok -c # but that's ok, since they don't have PTYMs anyway if test -r /dev/ptym/ptyp0 2>/dev/null ; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF @@ -4770,13 +5130,13 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for HP style pty trapping""... $ac_c" 1>&6 -echo "configure:4776: checking for HP style pty trapping" >&5 +echo "configure:5136: checking for HP style pty trapping" >&5 cat > conftest.$ac_ext < EOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | egrep "struct.*request_info" >/dev/null 2>&1; then @@ -4794,11 +5154,11 @@ fi rm -f conftest* echo $ac_n "checking for AIX new-style pty allocation""... $ac_c" 1>&6 -echo "configure:4800: checking for AIX new-style pty allocation" >&5 +echo "configure:5160: checking for AIX new-style pty allocation" >&5 if test -r /dev/ptc -a -r /dev/pts ; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_PTC_PTS 1 EOF @@ -4806,11 +5166,11 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for SGI old-style pty allocation""... $ac_c" 1>&6 -echo "configure:4812: checking for SGI old-style pty allocation" >&5 +echo "configure:5172: checking for SGI old-style pty allocation" >&5 if test -r /dev/ptc -a ! -r /dev/pts ; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_PTC 1 EOF @@ -4823,11 +5183,11 @@ # The library routines to open the SVR4 ptys are broken on certain systems and # the SCO command to increase the number of ptys only configure c-list ones # anyway. So we chose these, which have a special numbering scheme. # echo $ac_n "checking for SCO style pty allocation""... $ac_c" 1>&6 -echo "configure:4829: checking for SCO style pty allocation" >&5 +echo "configure:5189: checking for SCO style pty allocation" >&5 sco_ptys="" case "${host}" in *-sco3.2v[45]*) sco_clist_ptys=1 svr4_ptys_broken=1;; esac @@ -4840,25 +5200,115 @@ else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for SVR4 style pty allocation""... $ac_c" 1>&6 -echo "configure:4846: checking for SVR4 style pty allocation" >&5 +echo "configure:5206: checking for SVR4 style pty allocation" >&5 if test -r /dev/ptmx -a "x$svr4_ptys_broken" = x ; then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_PTMX 1 EOF # aargg. Some systems need libpt.a to use /dev/ptmx + echo $ac_n "checking for libpts="-lpt" in -lpt""... $ac_c" 1>&6 +echo "configure:5215: checking for libpts="-lpt" in -lpt" >&5 +ac_lib_var=`echo pt'_'libpts="-lpt" | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + ac_save_LIBS="$LIBS" +LIBS="-lpt $LIBS" +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +LIBS="$ac_save_LIBS" + +fi +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then + echo "$ac_t""yes" 1>&6 + libpts="" +else + echo "$ac_t""no" 1>&6 +fi + + echo $ac_n "checking for ptsname""... $ac_c" 1>&6 +echo "configure:5255: checking for ptsname" >&5 +if eval "test \"`echo '$''{'ac_cv_func_ptsname'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < +/* Override any gcc2 internal prototype to avoid an error. */ +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char ptsname(); + +int main() { + +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_ptsname) || defined (__stub___ptsname) +choke me +#else +ptsname(); +#endif + +; return 0; } +EOF +if { (eval echo configure:5283: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then + rm -rf conftest* + eval "ac_cv_func_ptsname=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_func_ptsname=no" +fi +rm -f conftest* +fi + +if eval "test \"`echo '$ac_cv_func_'ptsname`\" = yes"; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +LIBS="${LIBS} $libpts" +fi + + # I've never seen Tcl or Tk include -lpt so don't bother with explicit test echo $ac_n "checking for ptsname""... $ac_c" 1>&6 -echo "configure:4855: checking for ptsname" >&5 +echo "configure:5305: checking for ptsname" >&5 if eval "test \"`echo '$''{'ac_cv_func_ptsname'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4877,87 +5327,37 @@ ptsname(); #endif ; return 0; } EOF -if { (eval echo configure:4883: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5333: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_ptsname=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_ptsname=no" fi rm -f conftest* - -fi -if eval "test \"`echo '$ac_cv_func_'ptsname`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -LIBS="${LIBS} -lpt" -fi - - # I've never seen Tcl or Tk include -lpt so don't bother with explicit test - echo $ac_n "checking for ptsname""... $ac_c" 1>&6 -echo "configure:4905: checking for ptsname" >&5 -if eval "test \"`echo '$''{'ac_cv_func_ptsname'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char ptsname(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_ptsname) || defined (__stub___ptsname) -choke me -#else -ptsname(); -#endif - -; return 0; } -EOF -if { (eval echo configure:4933: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_ptsname=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_ptsname=no" -fi -rm -f conftest* - -fi -if eval "test \"`echo '$ac_cv_func_'ptsname`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -EXP_AND_TCL_LIBS="${EXP_AND_TCL_LIBS} -lpt" -fi - - echo $ac_n "checking for ptsname""... $ac_c" 1>&6 -echo "configure:4954: checking for ptsname" >&5 -if eval "test \"`echo '$''{'ac_cv_func_ptsname'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <&6 + : +else + echo "$ac_t""no" 1>&6 +EXP_AND_TCL_LIBS="${EXP_AND_TCL_LIBS} $libpts" +fi + + echo $ac_n "checking for ptsname""... $ac_c" 1>&6 +echo "configure:5354: checking for ptsname" >&5 +if eval "test \"`echo '$''{'ac_cv_func_ptsname'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -4976,38 +5376,38 @@ ptsname(); #endif ; return 0; } EOF -if { (eval echo configure:4982: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5382: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_ptsname=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_ptsname=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'ptsname`\" = yes"; then echo "$ac_t""yes" 1>&6 : else echo "$ac_t""no" 1>&6 -EXP_AND_TK_LIBS="${EXP_AND_TK_LIBS} -lpt" +EXP_AND_TK_LIBS="${EXP_AND_TK_LIBS} $libpts" fi else echo "$ac_t""no" 1>&6 fi # In OSF/1 case, SVR4 are somewhat different. # Gregory Depp 17Aug93 echo $ac_n "checking for OSF/1 style pty allocation""... $ac_c" 1>&6 -echo "configure:5009: checking for OSF/1 style pty allocation" >&5 +echo "configure:5409: checking for OSF/1 style pty allocation" >&5 if test -r /dev/ptmx_bsd ; then cat >> confdefs.h <<\EOF #define HAVE_PTMX_BSD 1 EOF @@ -5017,16 +5417,16 @@ fi tcgetattr=0 tcsetattr=0 echo $ac_n "checking for tcgetattr""... $ac_c" 1>&6 -echo "configure:5023: checking for tcgetattr" >&5 +echo "configure:5423: checking for tcgetattr" >&5 if eval "test \"`echo '$''{'ac_cv_func_tcgetattr'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -5045,36 +5445,36 @@ tcgetattr(); #endif ; return 0; } EOF -if { (eval echo configure:5051: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5451: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_tcgetattr=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_tcgetattr=no" fi rm -f conftest* +fi -fi if eval "test \"`echo '$ac_cv_func_'tcgetattr`\" = yes"; then echo "$ac_t""yes" 1>&6 tcgetattr=1 else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for tcsetattr""... $ac_c" 1>&6 -echo "configure:5071: checking for tcsetattr" >&5 +echo "configure:5471: checking for tcsetattr" >&5 if eval "test \"`echo '$''{'ac_cv_func_tcsetattr'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -5093,22 +5493,22 @@ tcsetattr(); #endif ; return 0; } EOF -if { (eval echo configure:5099: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5499: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_tcsetattr=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_tcsetattr=no" fi rm -f conftest* - fi + if eval "test \"`echo '$ac_cv_func_'tcsetattr`\" = yes"; then echo "$ac_t""yes" 1>&6 tcsetattr=1 else echo "$ac_t""no" 1>&6 @@ -5125,28 +5525,28 @@ fi # first check for the pure bsd echo $ac_n "checking for struct sgttyb""... $ac_c" 1>&6 -echo "configure:5131: checking for struct sgttyb" >&5 +echo "configure:5531: checking for struct sgttyb" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < main() { struct sgttyb tmp; exit(0); } EOF -{ (eval echo configure:5147: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5547: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then echo "$ac_t""yes" 1>&6 cat >> confdefs.h <<\EOF #define HAVE_SGTTYB 1 EOF @@ -5170,27 +5570,27 @@ # next check for the older style ttys # note that if we detect termio.h (only), we still set PTY_TYPE=termios # since that just controls which of pty_XXXX.c file is use and # pty_termios.c is set up to handle pty_termio. echo $ac_n "checking for struct termio""... $ac_c" 1>&6 -echo "configure:5176: checking for struct termio" >&5 +echo "configure:5576: checking for struct termio" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < main() { struct termio tmp; exit(0); } EOF -{ (eval echo configure:5191: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5591: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then cat >> confdefs.h <<\EOF #define HAVE_TERMIO 1 EOF PTY_TYPE=termios @@ -5207,17 +5607,17 @@ fi # now check for the new style ttys (not yet posix) echo $ac_n "checking for struct termios""... $ac_c" 1>&6 -echo "configure:5213: checking for struct termios" >&5 +echo "configure:5613: checking for struct termios" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < @@ -5227,12 +5627,12 @@ { struct termios tmp; exit(0); } EOF -{ (eval echo configure:5233: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5633: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then cat >> confdefs.h <<\EOF #define HAVE_TERMIOS 1 EOF PTY_TYPE=termios @@ -5249,17 +5649,17 @@ fi fi echo $ac_n "checking if TCGETS or TCGETA in termios.h""... $ac_c" 1>&6 -echo "configure:5255: checking if TCGETS or TCGETA in termios.h" >&5 +echo "configure:5655: checking if TCGETS or TCGETA in termios.h" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < @@ -5271,12 +5671,12 @@ #else return 1; #endif } EOF -{ (eval echo configure:5277: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5677: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then cat >> confdefs.h <<\EOF #define HAVE_TCGETS_OR_TCGETA_IN_TERMIOS_H 1 EOF echo "$ac_t""yes" 1>&6 @@ -5291,17 +5691,17 @@ rm -fr conftest* fi echo $ac_n "checking if TIOCGWINSZ in termios.h""... $ac_c" 1>&6 -echo "configure:5297: checking if TIOCGWINSZ in termios.h" >&5 +echo "configure:5697: checking if TIOCGWINSZ in termios.h" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext < @@ -5313,12 +5713,12 @@ #else return 1; #endif } EOF -{ (eval echo configure:5319: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5719: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then cat >> confdefs.h <<\EOF #define HAVE_TIOCGWINSZ_IN_TERMIOS_H 1 EOF echo "$ac_t""yes" 1>&6 @@ -5334,18 +5734,18 @@ fi # finally check for Cray style ttys echo $ac_n "checking for Cray-style ptys""... $ac_c" 1>&6 -echo "configure:5340: checking for Cray-style ptys" >&5 +echo "configure:5740: checking for Cray-style ptys" >&5 SETUID=":" if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:5759: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then PTY_TYPE=unicos SETUID="chmod u+s" echo "$ac_t""yes" 1>&6 else @@ -5378,16 +5778,16 @@ # select=0 poll=0 unset ac_cv_func_select echo $ac_n "checking for select""... $ac_c" 1>&6 -echo "configure:5384: checking for select" >&5 +echo "configure:5784: checking for select" >&5 if eval "test \"`echo '$''{'ac_cv_func_select'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -5406,36 +5806,36 @@ select(); #endif ; return 0; } EOF -if { (eval echo configure:5412: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5812: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_select=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_select=no" fi rm -f conftest* - fi + if eval "test \"`echo '$ac_cv_func_'select`\" = yes"; then echo "$ac_t""yes" 1>&6 select=1 else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking for poll""... $ac_c" 1>&6 -echo "configure:5432: checking for poll" >&5 +echo "configure:5832: checking for poll" >&5 if eval "test \"`echo '$''{'ac_cv_func_poll'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -5454,31 +5854,31 @@ poll(); #endif ; return 0; } EOF -if { (eval echo configure:5460: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5860: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_poll=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_poll=no" fi rm -f conftest* - fi + if eval "test \"`echo '$ac_cv_func_'poll`\" = yes"; then echo "$ac_t""yes" 1>&6 poll=1 else echo "$ac_t""no" 1>&6 fi echo $ac_n "checking event handling""... $ac_c" 1>&6 -echo "configure:5480: checking event handling" >&5 +echo "configure:5880: checking event handling" >&5 if test $select -eq 1 ; then EVENT_TYPE=select EVENT_ABLE=event echo "$ac_t""via select" 1>&6 elif test $poll -eq 1 ; then @@ -5496,16 +5896,16 @@ fi for ac_func in _getpty do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:5502: checking for $ac_func" >&5 +echo "configure:5902: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -5524,22 +5924,22 @@ $ac_func(); #endif ; return 0; } EOF -if { (eval echo configure:5530: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5930: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* - fi + if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 -echo "configure:5557: checking for $ac_func" >&5 +echo "configure:5957: checking for $ac_func" >&5 if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < /* Override any gcc2 internal prototype to avoid an error. */ @@ -5579,22 +5979,22 @@ $ac_func(); #endif ; return 0; } EOF -if { (eval echo configure:5585: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5985: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* eval "ac_cv_func_$ac_func=no" fi rm -f conftest* - fi + if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then echo "$ac_t""yes" 1>&6 ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` cat >> confdefs.h <&6 fi done + +# following test sets SETPGRP_VOID if setpgrp takes 0 args, else takes 2 +echo $ac_n "checking whether setpgrp takes no argument""... $ac_c" 1>&6 +echo "configure:6012: checking whether setpgrp takes no argument" >&5 +if eval "test \"`echo '$''{'ac_cv_func_setpgrp_void'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test "$cross_compiling" = yes; then + { echo "configure: error: cannot check setpgrp if cross compiling" 1>&2; exit 1; } +else + cat > conftest.$ac_ext < +#endif + +/* + * If this system has a BSD-style setpgrp, which takes arguments, exit + * successfully. + */ +main() +{ + if (setpgrp(1,1) == -1) + exit(0); + else + exit(1); +} + +EOF +if { (eval echo configure:6040: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then + ac_cv_func_setpgrp_void=no +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -fr conftest* + ac_cv_func_setpgrp_void=yes +fi +rm -fr conftest* +fi + + +fi + +echo "$ac_t""$ac_cv_func_setpgrp_void" 1>&6 +if test $ac_cv_func_setpgrp_void = yes; then + cat >> confdefs.h <<\EOF +#define SETPGRP_VOID 1 +EOF + +fi + # # check for timezones # echo $ac_n "checking for SV-style timezone""... $ac_c" 1>&6 -echo "configure:5614: checking for SV-style timezone" >&5 +echo "configure:6068: checking for SV-style timezone" >&5 if test "$cross_compiling" = yes; then { echo "configure: error: Expect can't be cross compiled" 1>&2; exit 1; } else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } -if test -s conftest && (./conftest; exit) 2>/dev/null; then +if { (eval echo configure:6087: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null +then cat >> confdefs.h <<\EOF #define HAVE_SV_TIMEZONE 1 EOF echo "$ac_t""yes" 1>&6 @@ -5673,11 +6127,11 @@ # things up. # the alternative search directory is involked by --with-tkinclude # #no_tk=true echo $ac_n "checking for Tk private headers""... $ac_c" 1>&6 -echo "configure:5679: checking for Tk private headers" >&5 +echo "configure:6133: checking for Tk private headers" >&5 # Check whether --with-tkinclude or --without-tkinclude was given. if test "${with_tkinclude+set}" = set; then withval="$with_tkinclude" with_tkinclude=${withval} fi @@ -5709,13 +6163,16 @@ # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tkh}" = x ; then for i in \ ${srcdir}/../tk \ `ls -dr ${srcdir}/../tk[4-9].[0-9].[0-9] ${srcdir}/../tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[4-9].[0-9].[0-9] ${srcdir}/../tk[4-9].[0-9] 2>/dev/null` \ ${srcdir}/../../tk \ `ls -dr ${srcdir}/../../tk[4-9].[0-9].[0-9] ${srcdir}/../../tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../../tk[4-9].[0-9].[0-9] ${srcdir}/../../tk[4-9].[0-9] 2>/dev/null` \ ${srcdir}/../../../tk \ + `ls -dr ${srcdir}/../../../tk[4-9].[0-9].[0-9] ${srcdir}/../../../tk[4-9].[0-9] 2>/dev/null ` \ `ls -dr ${srcdir}/../../../tk[4-9].[0-9].[0-9] ${srcdir}/../../../tk[4-9].[0-9] 2>/dev/null ` ; do if test -f $i/generic/tk.h ; then ac_cv_c_tkh=`(cd $i/generic; pwd)` break fi @@ -5725,10 +6182,12 @@ # # since ls returns lowest version numbers first, reverse its output if test x"${ac_cv_c_tkh}" = x ; then for i in \ `ls -dr /usr/local/src/tk[4-9].[0-9].[0-9] /usr/local/src/tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr /usr/local/src/tk[4-9].[0-9].[0-9] /usr/local/src/tk[4-9].[0-9] 2>/dev/null` \ + `ls -dr /usr/local/lib/tk[4-9].[0-9].[0-9] /usr/local/lib/tk[4-9].[0-9] 2>/dev/null` \ `ls -dr /usr/local/lib/tk[4-9].[0-9].[0-9] /usr/local/lib/tk[4-9].[0-9] 2>/dev/null` \ /usr/local/src/tk \ /usr/local/lib/tk \ ${prefix}/include ; do if test -f $i/generic/tk.h ; then @@ -5739,22 +6198,22 @@ fi # see if one is installed if test x"${ac_cv_c_tkh}" = x ; then ac_safe=`echo "tk.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for tk.h""... $ac_c" 1>&6 -echo "configure:5745: checking for tk.h" >&5 +echo "configure:6204: checking for tk.h" >&5 if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5755: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` +{ (eval echo configure:6214: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` if test -z "$ac_err"; then rm -rf conftest* eval "ac_cv_header_$ac_safe=yes" else echo "$ac_err" >&5 @@ -5848,11 +6307,11 @@ fi # also remove dots on systems that don't support filenames > 14 # (are there systems which support shared libs and restrict filename lengths!?) echo $ac_n "checking for long file names""... $ac_c" 1>&6 -echo "configure:5854: checking for long file names" >&5 +echo "configure:6313: checking for long file names" >&5 if eval "test \"`echo '$''{'ac_cv_sys_long_file_names'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else ac_cv_sys_long_file_names=yes # Test for long file names in all the places we know might matter: @@ -5895,19 +6354,23 @@ if test $ac_cv_sys_long_file_names = no; then EXP_LIB_VERSION=$EXP_VERSION_NODOTS fi -EXP_BUILD_LIB_SPEC="-L`pwd` -lexpect${EXP_LIB_VERSION}" -EXP_LIB_SPEC="-L\${exec_prefix}/lib -lexpect${EXP_LIB_VERSION}" -EXP_UNSHARED_LIB_FILE=libexpect${EXP_LIB_VERSION}.a +EXP_BUILD_LIB_SPEC="-L`pwd` -lexpect${EXP_LIB_VERSION}${DBGX}" +EXP_LIB_SPEC="-L\${INSTALL_ROOT}\${exec_prefix}/lib -lexpect${EXP_LIB_VERSION}${DBGX}" +EXP_UNSHARED_LIB_FILE=libexpect${EXP_LIB_VERSION}${DBGX}.a + +# The TCL_SHARED_LIB_SUFFIX macro below relies on the DBGX macro, +# which is set way far above here. Don't set it to the value of +# TCL_DBGX, or you'll run into problems if you build Tcl with symbols +# and expect without (and vice versa?) echo $ac_n "checking for type of library to build""... $ac_c" 1>&6 -echo "configure:5906: checking for type of library to build" >&5 +echo "configure:6370: checking for type of library to build" >&5 if test "$enable_shared" = "yes" && test "x${TCL_SHLIB_SUFFIX}" != "x" ; then EXP_SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS -# EXP_SHARED_LIB_FILE=libexpect$EXP_LIB_VERSION$TCL_SHLIB_SUFFIX eval "EXP_SHARED_LIB_FILE=libexpect${TCL_SHARED_LIB_SUFFIX}" EXP_LIB_FILE=$EXP_SHARED_LIB_FILE EXP_LIB_FILES="$EXP_SHARED_LIB_FILE $EXP_UNSHARED_LIB_FILE" echo "$ac_t""both shared and unshared" 1>&6 else @@ -5916,22 +6379,17 @@ EXP_LIB_FILE=$EXP_UNSHARED_LIB_FILE EXP_LIB_FILES="$EXP_UNSHARED_LIB_FILE" echo "$ac_t""unshared" 1>&6 fi -# now broken out into EXP_AND_TCL_LIBS and EXP_AND_TK_LIBS. Had to do this -# in order to avoid repeating lib specs to which some systems object. -EXP_AND_TCL_LIBS="$EXP_AND_TCL_LIBS $TCL_LD_SEARCH_FLAGS" -EXP_AND_TK_LIBS="$EXP_AND_TK_LIBS $TCL_LD_SEARCH_FLAGS" - # Sigh - Tcl defines SHLIB_LD_LIBS to be either empty or ${LIBS} and # LIBS is intended to be expanded by Make. But since we're too close # to hitting config's max symbols, pack everything together here and # do test ourselves. Ugh. # if test "x$TCL_SHLIB_LD_LIBS" = "x" ; then - EXP_SHLIB_LD_LIBS="" + EXP_SHLIB_LD_LIBS="$LIBS" else # seems a little strange to build in Tcl's build-lib, but # that's what Tk does. EXP_SHLIB_LD_LIBS="$TCL_BUILD_LIB_SPEC $TCL_DL_LIBS $LIBS -lc" fi @@ -5952,28 +6410,47 @@ LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' # If Tcl and Expect are installed in different places, adjust the library # search path to reflect this. -if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then - LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}" +if test x"$no_tk" = x"true" ; then + if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then + LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib" + fi +else + if test "$TK_EXEC_PREFIX" != "$exec_prefix"; then + LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TK_EXEC_PREFIX}/lib" + # no need to include TCL's search path, because TK does it already + # (it is actually appended later, via TK_LD_SEARCH_FLAGS trick below) + fi fi if test "${TCL_LD_SEARCH_FLAGS}" = '-L${LIB_RUNTIME_DIR}'; then LIB_RUNTIME_DIR=`echo ${LIB_RUNTIME_DIR} |sed -e 's/:/ -L/g'` fi -# The statement below is very tricky! It actually *evaluates* the -# string in TCL_LD_SEARCH_FLAGS, which causes a substitution of the +# The eval below is tricky! It *evaluates* the string in +# ..._CC_SEARCH_FLAGS, which causes a substitution of the # variable LIB_RUNTIME_DIR. -eval "EXP_CC_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\"" -EXP_LD_SEARCH_FLAGS=`echo ${EXP_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"` +if test x"$no_tk" = x"true" ; then + eval "EXP_CC_SEARCH_FLAGS=\"$TCL_CC_SEARCH_FLAGS\"" + EXP_LD_SEARCH_FLAGS=${TCL_LD_SEARCH_FLAGS} +else + eval "EXP_CC_SEARCH_FLAGS=\"$TK_CC_SEARCH_FLAGS\"" + EXP_LD_SEARCH_FLAGS=${TK_LD_SEARCH_FLAGS} +fi + +# now broken out into EXP_AND_TCL_LIBS and EXP_AND_TK_LIBS. Had to do this +# in order to avoid repeating lib specs to which some systems object. +EXP_AND_TCL_LIBS="$EXP_AND_TCL_LIBS $EXP_CC_SEARCH_FLAGS" +EXP_AND_TK_LIBS="$EXP_AND_TK_LIBS $EXP_CC_SEARCH_FLAGS" # # Set up makefile substitutions # + @@ -6041,11 +6518,11 @@ case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.11" + echo "$CONFIG_STATUS generated by autoconf version 2.13" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac @@ -6052,22 +6529,25 @@ done ac_given_srcdir=$srcdir ac_given_INSTALL="$INSTALL" -trap 'rm -fr `echo "Makefile pkgIndex expect_cf.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +trap 'rm -fr `echo "Makefile \ + pkgIndex expect_cf.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 EOF cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF $ac_vpsub $extrasub +s%@SHELL@%$SHELL%g s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g +s%@FFLAGS@%$FFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g s%@exec_prefix@%$exec_prefix%g s%@prefix@%$prefix%g @@ -6082,10 +6562,11 @@ s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g +s%@found@%$found%g s%@host@%$host%g s%@host_alias@%$host_alias%g s%@host_cpu@%$host_cpu%g s%@host_vendor@%$host_vendor%g s%@host_os@%$host_os%g @@ -6097,27 +6578,30 @@ s%@build@%$build%g s%@build_alias@%$build_alias%g s%@build_cpu@%$build_cpu%g s%@build_vendor@%$build_vendor%g s%@build_os@%$build_os%g +s%@CC@%$CC%g s%@TCL_DEFS@%$TCL_DEFS%g s%@TCL_DELETEME@%$TCL_DELETEME%g s%@TCL_DBGX@%$TCL_DBGX%g +s%@TCL_EXEC_PREFIX@%$TCL_EXEC_PREFIX%g s%@TCL_SHLIB_LD@%$TCL_SHLIB_LD%g s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g s%@TCL_LD_FLAGS@%$TCL_LD_FLAGS%g s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g s%@TK_VERSION@%$TK_VERSION%g s%@TK_DEFS@%$TK_DEFS%g +s%@TK_DBGX@%$TK_DBGX%g s%@TK_XINCLUDES@%$TK_XINCLUDES%g s%@TK_XLIBSW@%$TK_XLIBSW%g s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g -s%@CC@%$CC%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g +s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@RANLIB@%$RANLIB%g s%@subdirs@%$subdirs%g s%@CPP@%$CPP%g s%@TCLHDIR@%$TCLHDIR%g @@ -6138,10 +6622,11 @@ s%@EXP_BUILD_LIB_SPEC@%$EXP_BUILD_LIB_SPEC%g s%@EXP_LIB_SPEC@%$EXP_LIB_SPEC%g s%@EXP_CFLAGS@%$EXP_CFLAGS%g s%@EXP_LDFLAGS@%$EXP_LDFLAGS%g s%@EXP_LD_SEARCH_FLAGS@%$EXP_LD_SEARCH_FLAGS%g +s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g s%@EXP_AND_TCL_LIBS@%$EXP_AND_TCL_LIBS%g s%@EXP_AND_TK_LIBS@%$EXP_AND_TK_LIBS%g s%@EXP_SHLIB_LD_LIBS@%$EXP_SHLIB_LD_LIBS%g s%@X_PROGS@%$X_PROGS%g s%@PTY_TYPE@%$PTY_TYPE%g @@ -6189,17 +6674,18 @@ fi EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then - # Support "outfile[:infile]", defaulting infile="outfile.in". + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. @@ -6237,16 +6723,18 @@ case "$ac_file" in *Makefile*) ac_comsub="1i\\ # $configure_input" ;; *) ac_comsub= ;; esac + + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g s%@INSTALL@%$INSTALL%g -" $ac_given_srcdir/$ac_file_in | eval "$ac_sed_cmds" > $ac_file +" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file fi; done rm -f conftest.s* # These sed commands are passed to sed as "A NAME B NAME C VALUE D", where # NAME is the cpp macro being defined and VALUE is the value it is being given. @@ -6265,29 +6753,30 @@ ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_eB='$%\1#\2define\3' ac_eC=' ' ac_eD='%g' -if test -z "$CONFIG_HEADERS"; then +if test "${CONFIG_HEADERS+set}" != set; then EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF fi for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then - # Support "outfile[:infile]", defaulting infile="outfile.in". + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac echo creating $ac_file rm -f conftest.frag conftest.in conftest.out - cp $ac_given_srcdir/$ac_file_in conftest.in + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + cat $ac_file_inputs > conftest.in EOF # Transform confdefs.h into a sed script conftest.vals that substitutes # the proper values into config.h.in to produce config.h. And first: @@ -6352,12 +6841,16 @@ rm -f $ac_file mv conftest.h $ac_file fi fi; done - +EOF +cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF +chmod +x ${srcdir}/install-sh ${srcdir}/mkinstalldirs exit 0 EOF chmod +x $CONFIG_STATUS rm -fr confdefs* $ac_clean_files test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 Index: configure.in ================================================================== --- configure.in +++ configure.in @@ -8,21 +8,45 @@ AC_INIT(expect.h) # note when updating version numbers here, also update pkgIndex.in (see # comments in Makefile) EXP_MAJOR_VERSION=5 -EXP_MINOR_VERSION=28 -EXP_MICRO_VERSION=1 +EXP_MINOR_VERSION=34 +EXP_MICRO_VERSION=0 EXP_VERSION=$EXP_MAJOR_VERSION.$EXP_MINOR_VERSION EXP_VERSION_NODOTS=$EXP_MAJOR_VERSION$EXP_MINOR_VERSION EXP_VERSION_FULL=$EXP_VERSION.$EXP_MICRO_VERSION # Tcl's handling of shared_lib_suffix requires this symbol exist VERSION=$EXP_MAJOR_VERSION.$EXP_MINOR_VERSION # Too many people send me configure output without identifying the version. # This forced identification should reduce my pain significantly. echo "configuring Expect $EXP_MAJOR_VERSION.$EXP_MINOR_VERSION.$EXP_MICRO_VERSION" + +# People (when downloading Expect from CVS archive) sometimes run into +# Make thinking configure is old and needs to be rebuilt. If they +# don't have a clue about autoconf, they get confused. This is +# particular irritating because the problem only crops up after +# configure has successfully completed. Help them out by checking it +# right now and giving some advice. Alas, we cannot summarily fix the +# problem because it might conceivably be someone doing real +# development. +# Test if configure is older than configure.in and explain if no autoconf +AC_CHECK_PROG(found,autoconf,yes,no,) +AC_MSG_CHECKING([configure up to date]) +for i in `ls -tr ${srcdir}/configure ${srcdir}/configure.in ${srcdir}/Makefile.in` ; do + newest=$i +done +if test "$srcdir/configure" = "$newest" ; then + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi +if test $found = "no" -a "$newest" != "$srcdir/configure" ; then + AC_MSG_WARN([$srcdir/configure appears to be old ($srcdir/configure.in and/or $srcdir/Makefile.in are newer) and the autoconf program to fix this situation was not found. If you've no idea what this means, enter the command \"touch $srcdir/configure\" and restart $srcdir/configure.]) + exit +fi dnl AC_CONFIG_AUX_DIR(`cd $srcdir;pwd`/..) AC_CANONICAL_SYSTEM AC_CONFIG_HEADER(expect_cf.h) @@ -40,18 +64,10 @@ # dnl unset MFLAGS MAKEFLAGS MFLAGS= MAKEFLAGS= -CY_AC_PATH_TCLCONFIG -CY_AC_LOAD_TCLCONFIG -CC=$TCL_CC -EXP_AND_TCL_LIBS=$TCL_LIBS -CY_AC_PATH_TKCONFIG -CY_AC_LOAD_TKCONFIG -EXP_AND_TK_LIBS=$TK_LIBS - # An explanation is in order for the strange things going on with the # various LIBS. There are three separate definitions for LIBS. The # reason is that some systems require shared libraries include # references to their dependent libraries, i.e., any additional # libraries that must be linked to. And some systems get upset if the @@ -74,10 +90,26 @@ dnl but I want to control it. Can't just throw it out at the dnl end alas, because the user might have defined CFLAGS. OLD_CFLAGS=$CFLAGS AC_PROG_CC CFLAGS=$OLD_CFLAGS + +#------------------------------------------------------------------------ +# Hook for when threading is supported in Expect. The --enable-threads +# flag currently has no effect. +#------------------------------------------------------------------------ + +SC_ENABLE_THREADS + +CY_AC_PATH_TCLCONFIG +CY_AC_LOAD_TCLCONFIG +CC=$TCL_CC +EXP_AND_TCL_LIBS=$TCL_LIBS +CY_AC_PATH_TKCONFIG +CY_AC_LOAD_TKCONFIG +EXP_AND_TK_LIBS=$TK_LIBS + CY_AC_C_WORKS # this'll use a BSD compatible install or our included install-sh AC_PROG_INSTALL @@ -101,11 +133,20 @@ AC_RETSIGTYPE dnl AC_TIME_WITH_SYS_TIME AC_HEADER_TIME AC_HEADER_SYS_WAIT -EXP_CFLAGS=-g +AC_ARG_ENABLE(symbols, + [ --enable-symbols allow use of symbols if available], + [enable_symbols=$enableval], [enable_symbols=no]) +if test "$enable_symbols" = "no"; then + EXP_CFLAGS="$TCL_EXTRA_CFLAGS" +else + EXP_CFLAGS="-g $TCL_EXTRA_CFLAGS" + # This is always "g" for unix. + DBGX=g +fi case "${host}" in # Use -g on all systems but Linux where it upsets the dynamic X libraries. i[[3456]]86-*-linux*) EXP_CFLAGS="" ;; esac @@ -490,10 +531,23 @@ LIBS=$EXP_LIBS ###################################################################### # End of library/func checking ###################################################################### + +# Hand patches to library/func checking. + +dnl From: Michael Kuhl +dnl To get expect to compile on a Sequent NUMA-Q running DYNIX/ptx v4.4.2. +AC_MSG_CHECKING([if running Sequent running SVR4]) +if test "$host_alias" = "i386-sequent-sysv4" ; then + EXP_AND_TCL_LIBS="-lnsl -lsocket -lm" + dnl if there's something similar required for Tk, no one's told me! + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi ###################################################################### # # Look for various header files # @@ -505,11 +559,13 @@ # Tcl avoids the whole issue by not using stdarg on UNIX at all! dnl AC_CHECK_HEADER(stdarg.h, AC_DEFINE(HAVE_STDARG_H)) AC_CHECK_HEADER(varargs.h, AC_DEFINE(HAVE_VARARGS_H)) AC_CHECK_HEADER(unistd.h, AC_DEFINE(HAVE_UNISTD_H)) -AC_CHECK_HEADER(sys/stropts.h, AC_DEFINE(HAVE_STROPTS_H)) +# If no stropts.h, then the svr4 implementation is broken. +# At least it is on my Debian "potato" system. - Rob Savoye +AC_CHECK_HEADER(sys/stropts.h, AC_DEFINE(HAVE_STROPTS_H), svr4_ptys_broken=1) AC_CHECK_HEADER(sys/sysconfig.h, AC_DEFINE(HAVE_SYSCONF_H)) AC_CHECK_HEADER(sys/fcntl.h, AC_DEFINE(HAVE_SYS_FCNTL_H)) AC_CHECK_HEADER(sys/select.h, AC_DEFINE(HAVE_SYS_SELECT_H)) AC_CHECK_HEADER(sys/time.h, AC_DEFINE(HAVE_SYS_TIME_H)) AC_CHECK_HEADER(sys/ptem.h, AC_DEFINE(HAVE_SYS_PTEM_H)) @@ -537,10 +593,11 @@ AC_CHECK_FUNC(memmove, AC_DEFINE(HAVE_MEMMOVE)) AC_CHECK_FUNC(sysconf, AC_DEFINE(HAVE_SYSCONF)) AC_CHECK_FUNC(strftime, AC_DEFINE(HAVE_STRFTIME)) AC_CHECK_FUNC(strchr, AC_DEFINE(HAVE_STRCHR)) AC_CHECK_FUNC(timezone, AC_DEFINE(HAVE_TIMEZONE)) +AC_CHECK_FUNC(siglongjmp, AC_DEFINE(HAVE_SIGLONGJMP)) # dnl check for memcpy by hand # because Unixware 2.0 handles it specially and refuses to compile # autoconf's automatic test that is a call with no arguments AC_MSG_CHECKING([for memcpy]) @@ -598,10 +655,32 @@ AC_MSG_RESULT(no) AC_DEFINE(WNOHANG_BACKUP_VALUE, 1) , AC_MSG_ERROR([Expect can't be cross compiled]) ) + +#-----Stolen from Tcl's configure file------------------------------- +# The check below checks whether defines the type +# "union wait" correctly. It's needed because of weirdness in +# HP-UX where "union wait" is defined in both the BSD and SYS-V +# environments. Checking the usability of WIFEXITED seems to do +# the trick. +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([union wait]) +AC_TRY_LINK([#include +#include ], [ +union wait x; +WIFEXITED(x); /* Generates compiler error if WIFEXITED + * uses an int. */ +], tcl_ok=yes, tcl_ok=no) +AC_MSG_RESULT($tcl_ok) +if test $tcl_ok = no; then + AC_DEFINE(NO_UNION_WAIT) +fi + + # # check how signals work # @@ -690,11 +769,11 @@ AC_DEFINE(CONVEX) else AC_MSG_RESULT(no) fi -EXP_LDFLAGS= +EXP_LDFLAGS="$LDFLAGS" AC_MSG_CHECKING([if on NeXT]) if test -r /NextApps ; then AC_MSG_RESULT(yes) # "-m" flag suppresses complaints about multiple strtod @@ -785,14 +864,15 @@ AC_MSG_CHECKING([for SVR4 style pty allocation]) if test -r /dev/ptmx -a "x$svr4_ptys_broken" = x ; then AC_MSG_RESULT(yes) AC_DEFINE(HAVE_PTMX) # aargg. Some systems need libpt.a to use /dev/ptmx - AC_CHECK_FUNC(ptsname, , LIBS="${LIBS} -lpt") + AC_CHECK_LIB(pt, libpts="-lpt", libpts="") + AC_CHECK_FUNC(ptsname, , LIBS="${LIBS} $libpts") # I've never seen Tcl or Tk include -lpt so don't bother with explicit test - AC_CHECK_FUNC(ptsname, , EXP_AND_TCL_LIBS="${EXP_AND_TCL_LIBS} -lpt") - AC_CHECK_FUNC(ptsname, , EXP_AND_TK_LIBS="${EXP_AND_TK_LIBS} -lpt") + AC_CHECK_FUNC(ptsname, , EXP_AND_TCL_LIBS="${EXP_AND_TCL_LIBS} $libpts") + AC_CHECK_FUNC(ptsname, , EXP_AND_TK_LIBS="${EXP_AND_TK_LIBS} $libpts") else AC_MSG_RESULT(no) fi # In OSF/1 case, SVR4 are somewhat different. @@ -970,10 +1050,13 @@ fi AC_HAVE_FUNCS(_getpty) AC_HAVE_FUNCS(getpty) +# following test sets SETPGRP_VOID if setpgrp takes 0 args, else takes 2 +AC_FUNC_SETPGRP + # # check for timezones # AC_MSG_CHECKING([for SV-style timezone]) AC_TRY_RUN([ @@ -1046,18 +1129,22 @@ AC_SYS_LONG_FILE_NAMES if test $ac_cv_sys_long_file_names = no; then EXP_LIB_VERSION=$EXP_VERSION_NODOTS fi -EXP_BUILD_LIB_SPEC="-L`pwd` -lexpect${EXP_LIB_VERSION}" -EXP_LIB_SPEC="-L\${exec_prefix}/lib -lexpect${EXP_LIB_VERSION}" -EXP_UNSHARED_LIB_FILE=libexpect${EXP_LIB_VERSION}.a +EXP_BUILD_LIB_SPEC="-L`pwd` -lexpect${EXP_LIB_VERSION}${DBGX}" +EXP_LIB_SPEC="-L\${INSTALL_ROOT}\${exec_prefix}/lib -lexpect${EXP_LIB_VERSION}${DBGX}" +EXP_UNSHARED_LIB_FILE=libexpect${EXP_LIB_VERSION}${DBGX}.a + +# The TCL_SHARED_LIB_SUFFIX macro below relies on the DBGX macro, +# which is set way far above here. Don't set it to the value of +# TCL_DBGX, or you'll run into problems if you build Tcl with symbols +# and expect without (and vice versa?) AC_MSG_CHECKING([for type of library to build]) if test "$enable_shared" = "yes" && test "x${TCL_SHLIB_SUFFIX}" != "x" ; then EXP_SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS -# EXP_SHARED_LIB_FILE=libexpect$EXP_LIB_VERSION$TCL_SHLIB_SUFFIX eval "EXP_SHARED_LIB_FILE=libexpect${TCL_SHARED_LIB_SUFFIX}" EXP_LIB_FILE=$EXP_SHARED_LIB_FILE EXP_LIB_FILES="$EXP_SHARED_LIB_FILE $EXP_UNSHARED_LIB_FILE" AC_MSG_RESULT(both shared and unshared) else @@ -1066,22 +1153,17 @@ EXP_LIB_FILE=$EXP_UNSHARED_LIB_FILE EXP_LIB_FILES="$EXP_UNSHARED_LIB_FILE" AC_MSG_RESULT(unshared) fi -# now broken out into EXP_AND_TCL_LIBS and EXP_AND_TK_LIBS. Had to do this -# in order to avoid repeating lib specs to which some systems object. -EXP_AND_TCL_LIBS="$EXP_AND_TCL_LIBS $TCL_LD_SEARCH_FLAGS" -EXP_AND_TK_LIBS="$EXP_AND_TK_LIBS $TCL_LD_SEARCH_FLAGS" - # Sigh - Tcl defines SHLIB_LD_LIBS to be either empty or ${LIBS} and # LIBS is intended to be expanded by Make. But since we're too close # to hitting config's max symbols, pack everything together here and # do test ourselves. Ugh. # if test "x$TCL_SHLIB_LD_LIBS" = "x" ; then - EXP_SHLIB_LD_LIBS="" + EXP_SHLIB_LD_LIBS="$LIBS" else # seems a little strange to build in Tcl's build-lib, but # that's what Tk does. EXP_SHLIB_LD_LIBS="$TCL_BUILD_LIB_SPEC $TCL_DL_LIBS $LIBS -lc" fi @@ -1102,24 +1184,42 @@ LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}' # If Tcl and Expect are installed in different places, adjust the library # search path to reflect this. -if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then - LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}" +if test x"$no_tk" = x"true" ; then + if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then + LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib" + fi +else + if test "$TK_EXEC_PREFIX" != "$exec_prefix"; then + LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TK_EXEC_PREFIX}/lib" + # no need to include TCL's search path, because TK does it already + # (it is actually appended later, via TK_LD_SEARCH_FLAGS trick below) + fi fi if test "${TCL_LD_SEARCH_FLAGS}" = '-L${LIB_RUNTIME_DIR}'; then LIB_RUNTIME_DIR=`echo ${LIB_RUNTIME_DIR} |sed -e 's/:/ -L/g'` fi -# The statement below is very tricky! It actually *evaluates* the -# string in TCL_LD_SEARCH_FLAGS, which causes a substitution of the +# The eval below is tricky! It *evaluates* the string in +# ..._CC_SEARCH_FLAGS, which causes a substitution of the # variable LIB_RUNTIME_DIR. -eval "EXP_CC_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\"" -EXP_LD_SEARCH_FLAGS=`echo ${EXP_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"` +if test x"$no_tk" = x"true" ; then + eval "EXP_CC_SEARCH_FLAGS=\"$TCL_CC_SEARCH_FLAGS\"" + EXP_LD_SEARCH_FLAGS=${TCL_LD_SEARCH_FLAGS} +else + eval "EXP_CC_SEARCH_FLAGS=\"$TK_CC_SEARCH_FLAGS\"" + EXP_LD_SEARCH_FLAGS=${TK_LD_SEARCH_FLAGS} +fi + +# now broken out into EXP_AND_TCL_LIBS and EXP_AND_TK_LIBS. Had to do this +# in order to avoid repeating lib specs to which some systems object. +EXP_AND_TCL_LIBS="$EXP_AND_TCL_LIBS $EXP_CC_SEARCH_FLAGS" +EXP_AND_TK_LIBS="$EXP_AND_TK_LIBS $EXP_CC_SEARCH_FLAGS" # # Set up makefile substitutions # AC_SUBST(EXP_MAJOR_VERSION) @@ -1137,10 +1237,11 @@ AC_SUBST(EXP_BUILD_LIB_SPEC) AC_SUBST(EXP_LIB_SPEC) AC_SUBST(EXP_CFLAGS) AC_SUBST(EXP_LDFLAGS) AC_SUBST(EXP_LD_SEARCH_FLAGS) +AC_SUBST(TCL_LD_SEARCH_FLAGS) AC_SUBST(EXP_AND_TCL_LIBS) AC_SUBST(EXP_AND_TK_LIBS) AC_SUBST(EXP_SHLIB_LD_LIBS) AC_SUBST(X_PROGS) AC_SUBST(PTY_TYPE) @@ -1147,6 +1248,8 @@ AC_SUBST(EVENT_TYPE) AC_SUBST(EVENT_ABLE) AC_SUBST(SETUID) AC_SUBST(UNSHARED_RANLIB) AC_SUBST(DEFAULT_STTY_ARGS) -AC_OUTPUT(Makefile pkgIndex) +AC_OUTPUT([Makefile \ + pkgIndex], + chmod +x ${srcdir}/install-sh ${srcdir}/mkinstalldirs) Index: example/Makefile ================================================================== --- example/Makefile +++ example/Makefile @@ -1,28 +1,16 @@ -TCLVERSION = 8.0 -EXPVERSION = 5.25 -TCLROOT = ../../tcl$(TCLVERSION) - -# Tcl include files. (If you haven't installed Tcl yet, read the README file). -# This must point to the directory that contains ALL of Tcl's include -# files, not just the public ones. -TCLHDIR = $(TCLROOT)/generic - -# TCL library. Very little actually comes out of it, but it is handy. -TCLLIB = $(TCLROOT)/unix/libtcl$(TCLVERSION).so -# if installed, you can use: -# TCLLIB = -ltcl +EXPVERSION = 5.31 CC = gcc CPLUSPLUS = g++ CPLUSPLUSLIBDIR = -L/depot/gnu/arch/lib CPLUSPLUSLIB = -lg++ -CFLAGS = -g -I.. -I$(TCLHDIR) +CFLAGS = -g -I.. LIBEXPECT = -L.. -lexpect$(EXPVERSION) -LIBS = $(LIBEXPECT) $(TCLLIB) -lm +LIBS = $(LIBEXPECT) -lm SCRIPTS = su2 noidle script.exp bonfield.exp all: chesslib chesslib2 chesslib++ Index: example/autoexpect ================================================================== --- example/autoexpect +++ example/autoexpect @@ -18,19 +18,19 @@ set conservative 0 set promptmode 0 set option_keys "" proc check_for_following {type} { - if ![llength [uplevel set argv]] { + if {![llength [uplevel set argv]]} { puts "autoexpect: [uplevel set flag] requires following $type" exit 1 } } while {[llength $argv]>0} { set flag [lindex $argv 0] - if 0==[regexp "^-" $flag] break + if {0==[regexp "^-" $flag]} break set argv [lrange $argv 1 end] switch -- $flag \ "-c" { set conservative 1 } "-C" { @@ -82,19 +82,19 @@ global lastkey userbuf procbuf echoing send -null if {$lastkey == ""} { - if $echoing { + if {$echoing} { sendcmd "$userbuf" } if {$procbuf != ""} { expcmd "$procbuf" } } else { sendcmd "$userbuf" - if $echoing { + if {$echoing} { expcmd "$procbuf" sendcmd "$lastkey" } } cmd "send -null" @@ -109,11 +109,11 @@ global lastkey procbuf userbuf echoing send_user -raw -- $s if {$lastkey == ""} { - if !$echoing { + if {!$echoing} { append procbuf $s } else { sendcmd "$userbuf" expcmd "$procbuf" set echoing 0 @@ -123,11 +123,11 @@ return } regexp (.)(.*) $s dummy c tail if {$c == $lastkey} { - if $echoing { + if {$echoing} { append userbuf $lastkey set lastkey "" } else { if {$procbuf != ""} { expcmd "$procbuf" @@ -135,18 +135,18 @@ } set echoing 1 } append procbuf $s - if [string length $tail] { + if {[string length $tail]} { sendcmd "$userbuf$lastkey" set userbuf "" set lastkey "" set echoing 0 } } else { - if !$echoing { + if {!$echoing} { expcmd "$procbuf" } sendcmd "$userbuf$lastkey" set procbuf $s set userbuf "" @@ -170,11 +170,11 @@ # generate an expect command proc expcmd {s} { global promptmode - if $promptmode { + if {$promptmode} { regexp ".*\[\r\n]+(.*)" $s dummy s } cmd "expect -exact \"[expand $s]\"" } @@ -197,19 +197,19 @@ } proc verbose_send_user {s} { global verbose - if $verbose { + if {$verbose} { send_user -- $s } } proc ctoggle {} { global conservative send_style - if $conservative { + if {$conservative} { cmd "# conservative mode off - adding no delays" verbose_send_user "conservative mode off\n" set conservative 0 set send_style "" } else { @@ -221,11 +221,11 @@ } proc ptoggle {} { global promptmode - if $promptmode { + if {$promptmode} { cmd "# prompt mode off - now looking for complete output" verbose_send_user "prompt mode off\n" set promptmode 0 } else { cmd "# prompt mode on - now looking only for prompts" @@ -239,21 +239,21 @@ expect_user -re . send -- $expect_out(buffer) } -if [catch {set fd [open $filename w]} msg] { +if {[catch {set fd [open $filename w]} msg]} { puts $msg exit } exec chmod +x $filename verbose_send_user "autoexpect started, file is $filename\n" # calculate a reasonable #! line set expectpath /usr/local/bin ;# prepare default foreach dir [split $env(PATH) :] { ;# now look for real location - if [file executable $dir/expect] { + if {[file executable $dir/expect] && ![file isdirectory $dir/expect]} { set expectpath $dir break } } @@ -301,18 +301,18 @@ # -Don } cmd "set timeout -1" -if $conservative { +if {$conservative} { set send_style " -s" cmd "set send_slow {1 .1}" } else { set send_style "" } -if [llength $argv]>0 { +if {[llength $argv]>0} { eval spawn -noecho $argv cmd "spawn $argv" } else { spawn -noecho $env(SHELL) cmd "spawn \$env(SHELL)" @@ -326,22 +326,17 @@ set echoing 0 remove_nulls 0 eval interact $option_keys { - -re . { - input $interact_out(0,string) - } null { - input_null - } \ - -o \ - -re .+ { - output $interact_out(0,string) - } eof { - cmd "expect eof" - return - } null { - } + -re . { + input $interact_out(0,string) + } -o -re .+ { + output $interact_out(0,string) + } eof { + cmd "expect eof" + return + } } close $fd verbose_send_user "autoexpect done, file is $filename\n" Index: example/beer.exp ================================================================== --- example/beer.exp +++ example/beer.exp @@ -37,11 +37,11 @@ } proc out {i s} { foreach c [split $s ""] { # don't touch punctuation; just looks too strange if you do - if [regexp "\[,. \n\]" $c] { + if {[regexp "\[,. \n\]" $c]} { append d $c continue } # keep first couple of verses straight @@ -56,14 +56,14 @@ # do something strange switch [rand 3] { 0 { # substitute another letter - if [regexp \[aeiou\] $c] { + if {[regexp \[aeiou\] $c]} { # if vowel, substitute another append d [string index aeiou [rand 5]] - } elseif [regexp \[0-9\] $c] { + } elseif {[regexp \[0-9\] $c]} { # if number, substitute another append d [string index 123456789 [rand 9]] } else { # if consonant, substitute another append d [string index bcdfghjklmnpqrstvwxyz [rand 21]] Index: example/carpal ================================================================== --- example/carpal +++ example/carpal @@ -6,21 +6,21 @@ # Author: Don Libes, NIST # Date: Feb 26, '95 spawn $env(SHELL) -set start [timestamp] ;# when we started our current typing period -set stop [timestamp] ;# when we stopped typing +set start [clock seconds] ;# when we started our current typing period +set stop [clock seconds] ;# when we stopped typing set typing 1200 ;# twenty minutes, max typing time allowed set notyping 600 ;# ten minutes, min notyping time required interact -nobuffer -re . { - set now [timestamp] - - if {$now-$stop > $notyping} { - set start [timestamp] - } elseif {$now-$start > $typing} { - send_user "\007" - } - set stop [timestamp] + set now [clock seconds] + + if {$now-$stop > $notyping} { + set start [clock seconds] + } elseif {$now-$start > $typing} { + send_user "\007" + } + set stop [clock seconds] } Index: example/chess.exp ================================================================== --- example/chess.exp +++ example/chess.exp @@ -19,14 +19,14 @@ # 2. n/kn1-kb3 (reprint it as above, but differently - god knows why) # 2. ... p/k4-k5 (our new countermove - written differently, of course) set timeout -1; # wait forever expect_before { - -i $any_spawn_id eof { - send_user "player resigned!\n" - exit - } + -i $any_spawn_id eof { + send_user "player resigned!\n" + exit + } } # start things rolling spawn chess set id1 $spawn_id @@ -38,15 +38,15 @@ spawn chess set id2 $spawn_id expect "Chess\r\n" send $expect_out(1,string) -for {} 1 {} { - expect { - -i $id2 -re "\\.\\. (.*)\n" { - send -i $id1 $expect_out(1,string) - } - -i $id1 -re "\\.\\. .*\\. (.*)\n" { - send -i $id2 $expect_out(1,string) - } - } +while {1} { + expect { + -i $id2 -re "\\.\\. (.*)\n" { + send -i $id1 $expect_out(1,string) + } + -i $id1 -re "\\.\\. .*\\. (.*)\n" { + send -i $id2 $expect_out(1,string) + } + } } Index: example/chesslib++.c ================================================================== --- example/chesslib++.c +++ example/chesslib++.c @@ -60,11 +60,14 @@ int fd1, fd2; exp_loguser = 1; exp_timeout = 3600; - fd1 = exp_spawnl("chess","chess",(char *)0); + if (-1 == (fd1 = exp_spawnl("chess","chess",(char *)0))) { + perror("chess"); + exit(-1); + } if (-1 == exp_expectl(fd1,exp_glob,"Chess\r\n",0,exp_end)) exit; if (-1 == write(fd1,"first\r",6)) exit; Index: example/chesslib.c ================================================================== --- example/chesslib.c +++ example/chesslib.c @@ -56,11 +56,14 @@ int fd1, fd2; exp_loguser = 1; exp_timeout = 3600; - fd1 = exp_spawnl("chess","chess",(char *)0); + if (-1 == (fd1 = exp_spawnl("chess","chess",(char *)0))) { + perror("chess"); + exit(-1); + } if (-1 == exp_expectl(fd1,exp_glob,"Chess\r\n",0,exp_end)) exit; if (-1 == write(fd1,"first\r",6)) exit; Index: example/chesslib2.c ================================================================== --- example/chesslib2.c +++ example/chesslib2.c @@ -59,12 +59,12 @@ /* exp_is_debugging = 1;*/ exp_loguser = 1; exp_timeout = 3600; if (0 == (fp1 = exp_popen("chess"))) { - printf("exp_popen failed\n"); - exit(-1); + perror("chess"); + exit(-1); } if (0 > exp_fexpectl(fp1,exp_glob,"Chess\r\n",0,exp_end)) exit(-1); fprintf(fp1,"first\r"); Index: example/cryptdir ================================================================== --- example/cryptdir +++ example/cryptdir @@ -7,11 +7,11 @@ # decryptdir [dir] # # Encrypt or decrypts the current directory or named directory if given. if {[llength $argv] > 0} { - cd $argv + cd $argv } # encrypt or decrypt? set decrypt [regexp "decrypt" $argv0] @@ -20,44 +20,42 @@ send "Password:" expect -re "(.*)\n" send "\n" set passwd $expect_out(1,string) -# wouldn't want to encrypt files with mistyped password! -if !$decrypt { - send "Again:" - expect -re "(.*)\n" - send "\n" - if ![string match $passwd $expect_out(1,string)] { - send_user "mistyped password?\n" - stty echo - exit - } +# Wouldn't want to encrypt/decrypt files with mistyped password! +send "Again:" +expect -re "(.*)\n" +send "\n" +if {![string match $passwd $expect_out(1,string)]} { + send_user "mistyped password?\n" + stty echo + exit } stty echo log_user 0 foreach f [glob *] { - # strip shell metachars from filename to avoid problems - if [regsub -all {[]['`~<>:-]} $f "" newf] { - exec mv $f $newf - set f $newf - } - - set strcmp [string compare .crypt [file extension $f]] - if $decrypt { - # skip files that don't end with ".crypt" - if 0!=$strcmp continue - spawn sh -c "exec crypt < $f > [file root $f]" - } else { - # skip files that already end with ".crypt" - if 0==$strcmp continue - spawn sh -c "exec crypt < $f > $f.crypt" - } - expect "key:" - send "$passwd\r" - expect - wait - exec rm -f $f - send_tty "." + # strip shell metachars from filename to avoid problems + if {[regsub -all {[]['`~<>:-]} $f "" newf]} { + exec mv $f $newf + set f $newf + } + + set strcmp [string compare .crypt [file extension $f]] + if {$decrypt} { + # skip files that don't end with ".crypt" + if {0!=$strcmp} continue + spawn sh -c "exec crypt < $f > [file root $f]" + } else { + # skip files that already end with ".crypt" + if {0==$strcmp} continue + spawn sh -c "exec crypt < $f > $f.crypt" + } + expect "key:" + send "$passwd\r" + expect + wait + exec rm -f $f + send_tty "." } send_tty "\n" Index: example/decryptdir ================================================================== --- example/decryptdir +++ example/decryptdir @@ -7,11 +7,11 @@ # decryptdir [dir] # # Encrypt or decrypts the current directory or named directory if given. if {[llength $argv] > 0} { - cd $argv + cd $argv } # encrypt or decrypt? set decrypt [regexp "decrypt" $argv0] @@ -20,44 +20,42 @@ send "Password:" expect -re "(.*)\n" send "\n" set passwd $expect_out(1,string) -# wouldn't want to encrypt files with mistyped password! -if !$decrypt { - send "Again:" - expect -re "(.*)\n" - send "\n" - if ![string match $passwd $expect_out(1,string)] { - send_user "mistyped password?" - stty echo - exit - } +# Wouldn't want to encrypt/decrypt files with mistyped password! +send "Again:" +expect -re "(.*)\n" +send "\n" +if {![string match $passwd $expect_out(1,string)]} { + send_user "mistyped password?\n" + stty echo + exit } stty echo log_user 0 foreach f [glob *] { - # strip shell metachars from filename to avoid problems - if [regsub -all {[]['`~<>:-]} $f "" newf] { - exec mv $f $newf - set f $newf - } - - set strcmp [string compare .crypt [file extension $f]] - if $decrypt { - # skip files that don't end with ".crypt" - if 0!=$strcmp continue - spawn sh -c "exec crypt < $f > [file root $f]" - } else { - # skip files that already end with ".crypt" - if 0==$strcmp continue - spawn sh -c "exec crypt < $f > $f.crypt" - } - expect "key:" - send "$passwd\r" - expect - wait - exec rm -f $f - send_tty "." + # strip shell metachars from filename to avoid problems + if {[regsub -all {[]['`~<>:-]} $f "" newf]} { + exec mv $f $newf + set f $newf + } + + set strcmp [string compare .crypt [file extension $f]] + if {$decrypt} { + # skip files that don't end with ".crypt" + if {0!=$strcmp} continue + spawn sh -c "exec crypt < $f > [file root $f]" + } else { + # skip files that already end with ".crypt" + if {0==$strcmp} continue + spawn sh -c "exec crypt < $f > $f.crypt" + } + expect "key:" + send "$passwd\r" + expect + wait + exec rm -f $f + send_tty "." } send_tty "\n" Index: example/dislocate ================================================================== --- example/dislocate +++ example/dislocate @@ -4,14 +4,14 @@ exp_version -exit 5.1 # The following code attempts to intuit whether cat buffers by default. # The -u flag is required on HPUX (8 and 9) and IBM AIX (3.2) systems. -if [file exists $exp_exec_library/cat-buffers] { - set catflags "-u" +if {[file exists $exp_exec_library/cat-buffers]} { + set catflags "-u" } else { - set catflags "" + set catflags "" } # If this fails, you can also force it by commenting in one of the following. # Or, you can use the -catu flag to the script. #set catflags "" #set catflags "-u" @@ -23,320 +23,326 @@ set prefix "disc" set timeout -1 set debug_flag 0 while {$argc} { - set flag [lindex $argv 0] - switch -- $flag \ - "-catu" { - set catflags "-u" - set argv [lrange $argv 1 end] - incr argc -1 - } "-escape" { - set escape [lindex $argv 1] - set escape_printable $escape - set argv [lrange $argv 2 end] - incr argc -2 - } "-debug" { - log_file [lindex $argv 1] - set debug_flag 1 - set argv [lrange $argv 2 end] - incr argc -2 - } default { - break - } + set flag [lindex $argv 0] + switch -- $flag \ + "-catu" { + set catflags "-u" + set argv [lrange $argv 1 end] + incr argc -1 + } "-escape" { + set escape [lindex $argv 1] + set escape_printable $escape + set argv [lrange $argv 2 end] + incr argc -2 + } "-debug" { + log_file [lindex $argv 1] + set debug_flag 1 + set argv [lrange $argv 2 end] + incr argc -2 + } default { + break + } } # These are correct from parent's point of view. # In child, we will reset these so that they appear backwards # thus allowing following two routines to be used by both parent and child set infifosuffix ".i" set outfifosuffix ".o" proc infifoname {pid} { - global prefix infifosuffix - - return "/tmp/$prefix$pid$infifosuffix" + return "/tmp/$::prefix$pid$::infifosuffix" } proc outfifoname {pid} { - global prefix outfifosuffix - - return "/tmp/$prefix$pid$outfifosuffix" + return "/tmp/$::prefix$pid$::outfifosuffix" } proc pid_remove {pid} { - global date proc + say "removing $pid $::proc($pid)" - say "removing $pid $proc($pid)" - - unset date($pid) - unset proc($pid) + unset ::date($pid) + unset ::proc($pid) } -# lines in data file looks like this: +# lines in data file look like this: # pid#date-started#argv # allow element lookups on empty arrays set date(dummy) dummy; unset date(dummy) set proc(dummy) dummy; unset proc(dummy) + +proc say {msg} { + if {!$::debug_flag} return + + if {[catch {puts "parent: $msg"}]} { + send_log "child: $msg\n" + } +} # load pidfile into memory proc pidfile_read {} { - global date proc pidfile - - if [catch {open $pidfile} fp] return - - # - # read info out of file - # - - say "reading pidfile" - set line 0 - while {[gets $fp buf]!=-1} { - # while pid and date can't have # in it, proc can - if [regexp "(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc] { - set date($pid) $xdate - set proc($pid) $xproc - } else { - puts "warning: inconsistency in $pidfile line $line" - } - incr line - } - close $fp - say "read $line entries" - - # - # see if pids and fifos are still around - # - - foreach pid [array names date] { - if {$pid && [catch {exec /bin/kill -0 $pid}]} { - say "$pid no longer exists, removing" - pid_remove $pid - continue - } - - # pid still there, see if fifos are - if {![file exists [infifoname $pid]] || ![file exists [outfifoname $pid]]} { - say "$pid fifos no longer exists, removing" - pid_remove $pid - continue - } - } + global date proc pidfile + + say "opening $pidfile" + if {[catch {open $pidfile} fp]} return + + # + # read info from file + # + + say "reading pidfile" + set line 0 + while {[gets $fp buf]!=-1} { + # while pid and date can't have # in it, proc can + if {[regexp "(\[^#]*)#(\[^#]*)#(.*)" $buf junk pid xdate xproc]} { + set date($pid) $xdate + set proc($pid) $xproc + } else { + puts "warning: inconsistency in $pidfile line $line" + } + incr line + } + close $fp + say "read $line entries" + + # + # see if pids and fifos are still around + # + + foreach pid [array names date] { + if {$pid && [catch {exec /bin/kill -0 $pid}]} { + say "$pid no longer exists, removing" + pid_remove $pid + continue + } + + # pid still there, see if fifos are + if {![file exists [infifoname $pid]] || ![file exists [outfifoname $pid]]} { + say "$pid fifos no longer exists, removing" + pid_remove $pid + continue + } + } } proc pidfile_write {} { - global pidfile date proc - - say "writing pidfile" - - set fp [open $pidfile w] - foreach pid [array names date] { - puts $fp "$pid#$date($pid)#$proc($pid)" - say "wrote $pid#$date($pid)#$proc($pid)" - } - close $fp + global pidfile date proc + + say "writing pidfile" + + set fp [open $pidfile w] + foreach pid [array names date] { + puts $fp "$pid#$date($pid)#$proc($pid)" + say "wrote $pid#$date($pid)#$proc($pid)" + } + close $fp } proc fifo_pair_remove {pid} { - global date proc prefix + global date proc prefix - pidfile_read - pid_remove $pid - pidfile_write + pidfile_read + pid_remove $pid + pidfile_write - catch {exec rm -f [infifoname $pid] [outfifoname $pid]} + file delete -force [infifoname $pid] [outfifoname $pid] } proc fifo_pair_create {pid argdate argv} { - global prefix date proc - - pidfile_read - set date($pid) $argdate - set proc($pid) $argv - pidfile_write - - mkfifo [infifoname $pid] - mkfifo [outfifoname $pid] + global prefix date proc + + pidfile_read + set date($pid) $argdate + set proc($pid) $argv + pidfile_write + + mkfifo [infifoname $pid] + mkfifo [outfifoname $pid] } proc mkfifo {f} { - if [file exists $f] { - say "uh, fifo already exists?" - return - } - - if 0==[catch {exec mkfifo $f}] return ;# POSIX - if 0==[catch {exec mknod $f p}] return - # some systems put mknod in wierd places - if 0==[catch {exec /usr/etc/mknod $f p}] return ;# Sun - if 0==[catch {exec /etc/mknod $f p}] return ;# AIX, Cray - puts "Couldn't figure out how to make a fifo - where is mknod?" - exit + if {[file exists $f]} { + say "uh, fifo already exists?" + return + } + + if {0==[catch {exec mkfifo $f}]} return ;# POSIX + if {0==[catch {exec mknod $f p}]} return + # some systems put mknod in wierd places + if {0==[catch {exec /usr/etc/mknod $f p}]} return ;# Sun + if {0==[catch {exec /etc/mknod $f p}]} return ;# AIX, Cray + puts "Couldn't figure out how to make a fifo - where is mknod?" + exit } proc child {argdate argv} { - global catflags infifosuffix outfifosuffix - - disconnect - - # these are backwards from the child's point of view so that - # we can make everything else look "right" - set infifosuffix ".o" - set outfifosuffix ".i" - set pid 0 - - eval spawn $argv - set proc_spawn_id $spawn_id - - while {1} { - say "opening [infifoname $pid] for read" - spawn -open [open "|cat $catflags < [infifoname $pid]" "r"] - set in $spawn_id - - say "opening [outfifoname $pid] for write" - spawn -open [open [outfifoname $pid] w] - set out $spawn_id - - fifo_pair_remove $pid - - say "interacting" - interact { - -u $proc_spawn_id eof exit - -output $out - -input $in - } - - # parent has closed connection - say "parent closed connection" - catch {close -i $in} - catch {wait -i $in} - catch {close -i $out} - catch {wait -i $out} - - # switch to using real pid - set pid [pid] - # put entry back - fifo_pair_create $pid $argdate $argv - } -} - -proc say {msg} { - global debug_flag - - if !$debug_flag return - - if [catch {puts "parent: $msg"}] { - send_log "child: $msg\n" - } + global infifosuffix outfifosuffix + + disconnect + # these are backwards from the child's point of view so that + # we can make everything else look "right" + set infifosuffix ".o" + set outfifosuffix ".i" + set pid 0 + + eval spawn $argv + set proc_spawn_id $spawn_id + + while {1} { + say "opening [infifoname $pid] for read" + + set catfid [open "|cat $::catflags < [infifoname $pid]" "r"] + set ::catpid $catfid + spawn -open $catfid + set in $spawn_id + + say "opening [outfifoname $pid] for write" + spawn -open [open [outfifoname $pid] w] + set out $spawn_id + + fifo_pair_remove $pid + + say "interacting" + interact { + -u $proc_spawn_id eof exit + -output $out + -input $in + } + + # parent has closed connection + say "parent closed connection" + catch {close -i $in} + catch {wait -i $in} + catch {close -i $out} + catch {wait -i $out} + + # switch to using real pid + set pid [pid] + # put entry back + fifo_pair_create $pid $argdate $argv + } } proc escape {} { - # export process handles so that user can get at them - global in out - - puts "\nto disconnect, enter: exit (or ^D)" - puts "to suspend, press appropriate job control sequence" - puts "to return to process, enter: return" - interpreter - puts "returning ..." + # export process handles so that user can get at them + global in out + + puts "\nto disconnect, enter: exit (or ^D)" + puts "to suspend, press appropriate job control sequence" + puts "to return to process, enter: return" + interpreter -eof exit + puts "returning ..." } # interactively query user to choose process, return pid proc choose {} { - global index date - - while 1 { - send_user "enter # or pid: " - expect_user -re "(.*)\n" {set buf $expect_out(1,string)} - if [info exists index($buf)] { - set pid $index($buf) - } elseif [info exists date($buf)] { - set pid $buf - } else { - puts "no such # or pid" - continue - } - return $pid - } + while {1} { + send_user "enter # or pid: " + expect_user -re "(.*)\n" {set buf $expect_out(1,string)} + if {[info exists ::index($buf)]} { + set pid $::index($buf) + } elseif {[info exists ::date($buf)]} { + set pid $buf + } else { + puts "no such # or pid" + continue + } + return $pid + } } if {$argc} { - # initial creation occurs before fork because if we do it after - # then either the child or the parent may have to spin retrying - # the fifo open. Unfortunately, we cannot know the pid ahead of - # time so use "0". This will be set to the real pid when the - # parent does its initial disconnect. There is no collision - # problem because the fifos are deleted immediately anyway. - - set datearg [exec date] - fifo_pair_create 0 $datearg $argv - - set pid [fork] - say "after fork, pid = $pid" - if $pid==0 { - child $datearg $argv - } - # parent thinks of child as pid==0 for reason given earlier - set pid 0 + # initial creation occurs before fork because if we do it after + # then either the child or the parent may have to spin retrying + # the fifo open. Unfortunately, we cannot know the pid ahead of + # time so use "0". This will be set to the real pid when the + # parent does its initial disconnect. There is no collision + # problem because the fifos are deleted immediately anyway. + + set datearg [clock format [clock seconds]] + + fifo_pair_create 0 $datearg $argv + + # to debug by faking child, comment out fork and set pid to a + # non-zero int, then you can read/write to pipes manually + + set pid [fork] + say "after fork, pid = $pid" + if {$pid==0} { + child $datearg $argv + } + + # parent thinks of child as pid==0 for reason given earlier + set pid 0 } say "examining pid" -if ![info exists pid] { - global fifos date proc - - say "pid does not exist" - - pidfile_read - - set count 0 - foreach pid [array names date] { - incr count - } - - if $count==0 { - puts "no connectable processes" - exit - } elseif $count==1 { - puts "one connectable process: $proc($pid)" - puts "pid $pid, started $date($pid)" - send_user "connect? \[y] " - expect_user -re "(.*)\n" {set buf $expect_out(1,string)} - if {$buf!="y" && $buf!=""} exit - } else { - puts "connectable processes:" - set count 1 - puts " # pid date started process" - foreach pid [array names date] { - puts [format "%2d %6d %.19s %s" \ - $count $pid $date($pid) $proc($pid)] - set index($count) $pid - incr count - } - set pid [choose] - } +if {![info exists pid]} { + global fifos date proc + + say "pid does not exist" + + pidfile_read + + set count 0 + foreach pid [array names date] { + incr count + } + + if {$count==0} { + puts "no connectable processes" + exit + } elseif {$count==1} { + puts "one connectable process: $proc($pid)" + puts "pid $pid, started $date($pid)" + send_user "connect? \[y] " + expect_user -re "(.*)\n" {set buf $expect_out(1,string)} + if {$buf!="y" && $buf!=""} exit + } else { + puts "connectable processes:" + set count 1 + puts " # pid date started process" + foreach pid [array names date] { + puts [format "%2d %6d %.19s %s" \ + $count $pid $date($pid) $proc($pid)] + set index($count) $pid + incr count + } + set pid [choose] + } } say "opening [outfifoname $pid] for write" spawn -noecho -open [open [outfifoname $pid] w] set out $spawn_id say "opening [infifoname $pid] for read" -spawn -noecho -open [open "|cat $catflags < [infifoname $pid]" "r"] +set catfid [open "|cat $catflags < [infifoname $pid]" "r"] +set catpid [pid $catfid] +spawn -noecho -open $catfid set in $spawn_id puts "Escape sequence is $escape_printable" proc prompt1 {} { - global argv0 + return "$::argv0[history nextid]> " +} + +rename exit exitReal - return "$argv0[history nextid]> " +proc exit {} { + exec /bin/kill $::catpid + exitReal } interact { - -reset $escape escape - -output $out - -input $in + -reset $escape escape + -output $out + -input $in } + Index: example/dvorak ================================================================== --- example/dvorak +++ example/dvorak @@ -24,6 +24,6 @@ log_user 1 send_user "~d for dvorak input\n" send_user "~q for qwerty input (default)\n" send_user "~e for expect interpreter\n" send_user "Enter ~ sequences using qwerty keys\n" -interact ~d rot ~q {} ~e +interact ~d rot ~q {} ~e {interpreter -eof exit} Index: example/ftp-inband ================================================================== --- example/ftp-inband +++ example/ftp-inband @@ -20,19 +20,19 @@ set verbose_flag 0 proc send_verbose {msg} { global verbose_flag - if $verbose_flag { + if {$verbose_flag} { send_user $msg } } proc get {infile outfile} { global prompt verbose_flag - if (!$verbose_flag) { + if {!$verbose_flag} { log_user 0 } send_verbose "disabling echo: " send "stty -echo\r" @@ -78,11 +78,11 @@ send_verbose "." exp_continue } } - if ($verbose_flag) { + if {$verbose_flag} { send_user "\n" ;# after last "." log_user 1 } expect -re $prompt ;# wait for prompt from cat @@ -96,11 +96,11 @@ send_verbose "uncompressing\n" exec uncompress -f $outfile_compressed send_verbose "renaming\n" - if [catch "exec cp $outfile_plain $outfile" msg] { + if {[catch "exec cp $outfile_plain $outfile" msg]} { send_user "could not move file in place, reason: $msg\n" send_user "left as $outfile_plain\n" exec rm -f $outfile_encoded } else { exec rm -f $outfile_plain $outfile_encoded @@ -113,11 +113,11 @@ } proc put {infile outfile} { global prompt verbose_flag - if (!$verbose_flag) { + if {!$verbose_flag} { log_user 0 } send_verbose "disabling echo: " send "stty -echo\r" @@ -151,17 +151,17 @@ send "cat > $outfile_encoded\r" log_user 0 set fp [open $infile_encoded r] - while 1 { + while {1} { if {-1 == [gets $fp buf]} break send_verbose "." - send "$buf\r" + send -- "$buf\r" } - if ($verbose_flag) { + if {$verbose_flag} { send_user "\n" ;# after last "." log_user 1 } send "\004" ;# eof @@ -248,11 +248,11 @@ } proc verbose_status {} { global verbose_flag - if $verbose_flag { + if {$verbose_flag} { return "on" } else { return "off" } } Index: example/ftp-rfc ================================================================== --- example/ftp-rfc +++ example/ftp-rfc @@ -5,11 +5,11 @@ # retrieves an rfc (or the index) from uunet exp_version -exit 5.0 -if $argc!=1 { +if {$argc!=1} { send_user "usage: ftp-rfc \[#] \[-index]\n" exit } set file "rfc$argv.Z" Index: example/gethostbyaddr ================================================================== --- example/gethostbyaddr +++ example/gethostbyaddr @@ -42,11 +42,11 @@ send_user " -d produce debugging output false\n" send_user "options must be separate.\n" exit } -if [file readable ~/.gethostbyaddr] {source ~/.gethostbyaddr} +if {[file readable ~/.gethostbyaddr]} {source ~/.gethostbyaddr} while {[llength $argv]>0} { set flag [lindex $argv 0] switch -- $flag \ "-v" { @@ -70,17 +70,17 @@ } } set IPaddress $argv -if [llength $argv]!=1 usage -if 4!=[scan $IPaddress "%d.%d.%d.%d" a b c d] usage +if {[llength $argv]!=1} usage +if {4!=[scan $IPaddress "%d.%d.%d.%d" a b c d]} usage proc vprint {s} { global verbose - if !$verbose return + if {!$verbose} return send_user $s\n } # dn==1 if domain name, 0 if text (from nic) proc printhost {name how dn} { @@ -89,11 +89,11 @@ if {$dn && $reverse} { set verified [verify $name $IPaddress] } else {set verified 0} if {$verified || !$reverse || !$dn} { - if $tag { + if {$tag} { send_user "$name ($how)\n" } else { send_user "$name\n" } @@ -118,11 +118,11 @@ vprint $expect_out(1,string) } timeout { vprint "timed out" } -re "Address:.*Address: (\[^\r]*)\r" { set addr2 $expect_out(1,string) - if [string match $IPaddress $addr2] { + if {[string match $IPaddress $addr2]} { vprint "verified" set rc 1 } else { vprint "not verified - $name is $addr2" } @@ -140,17 +140,17 @@ vprint $msg } proc guessHost {guess} { global guessHost - if [info exists guessHost] return + if {[info exists guessHost]} return set guessHost $guess } proc guessDomain {guess} { global guessDomain - if [info exists guessDomain] return + if {[info exists guessDomain]} return set guessDomain $guess } proc guessFQDN {} { global guessHost guessDomain @@ -199,11 +199,11 @@ set host $expect_out(1,string) set domain $expect_out(2,string) printhost $host.$domain smtp 1 # if not valid FQDN, it's likely either host or domain - if [string length $domain] { + if {[string length $domain]} { guessDomain $host.$domain } else { guessHost $host } } @@ -281,11 +281,11 @@ printhost $guessHost.$domain "smtp - $a.$b.$c.$i is $host.$domain" 1 # if not valid FQDN, it's likely either host or domain # don't bother recording host since it can't be for # original addr. - if [string length $domain] { + if {[string length $domain]} { guessDomain $host.$domain } } } catch close @@ -306,11 +306,11 @@ printhost $guessHost.$domain "smtp - $a.$b.$c.$i is $host.$domain" 1 # if not valid FQDN, it's likely either host or domain # don't bother recording host since it can't be for # original addr. - if [string length $domain] { + if {[string length $domain]} { guessDomain $host.$domain } } } catch close Index: example/kibitz ================================================================== --- example/kibitz +++ example/kibitz @@ -25,14 +25,14 @@ #set proxy "kibitz" ;# uncomment and set if you want kibitz to use ;# some other account on remote systems # The following code attempts to intuit whether cat buffers by default. # The -u flag is required on HPUX (8 and 9) and IBM AIX (3.2) systems. -if [file exists $exp_exec_library/cat-buffers] { - set catflags "-u" +if {[file exists $exp_exec_library/cat-buffers]} { + set catflags "-u" } else { - set catflags "" + set catflags "" } # If this fails, you can also force it by commenting in one of the following. # Or, you can use the -catu flag to the script. #set catflags "" #set catflags "-u" @@ -81,11 +81,11 @@ log_user 0 set timeout -1 set user [lindex $argv 0] -if [string match -r $user] { +if {[string match -r $user]} { send_user "KRUN" ;# this tells user_number 1 that we're running ;# and to prepare for possible error messages set user_number 3 # need to check that it exists first! set user [lindex $argv 1] @@ -114,156 +114,156 @@ # if !do_if0, skip the whole thing - this is here just to make caller simpler proc is_prefix {do_if0 x xjunk} { if 0!=$do_if0 {return 0} set split [split $xjunk .] for {set i [expr [llength $split]-1]} {$i>=0} {incr i -1} { - if [string match $x [join [lrange $split 0 $i] .]] {return 1} + if {[string match $x [join [lrange $split 0 $i] .]]} {return 1} } return 0 } # get domainname. Unfortunately, on some systems, domainname(1) # returns NIS domainname which is not the internet domainname. proc domainname {} { - # open pops stack upon failure - set rc [catch {open /etc/resolv.conf r} file] - if {$rc==0} { - while {-1!=[gets $file buf]} { - if 1==[scan $buf "domain %s" name] { - close $file - return $name - } - } - close $file - } - - # fall back to using domainname - if {0==[catch {exec domainname} name]} {return $name} - - error "could not figure out domainname" + # open pops stack upon failure + set rc [catch {open /etc/resolv.conf r} file] + if {$rc==0} { + while {-1!=[gets $file buf]} { + if 1==[scan $buf "domain %s" name] { + close $file + return $name + } + } + close $file + } + + # fall back to using domainname + if {0==[catch {exec domainname} name]} {return $name} + + error "could not figure out domainname" } if $user_number==1 { - if $noproc==0 { - if [llength $argv]>1 { - set pid [eval spawn [lrange $argv 1 end]] - } else { - # if running as CGI, shell may not be set! - set shell /bin/sh - catch {set shell $env(SHELL)} - set pid [spawn $shell] - } - set shell $spawn_id - } - - # is user2 remote? - regexp (\[^@\]*)@*(.*) $user ignore tmp host - set user $tmp - if ![string match $host ""] { - set h_rc [catch {exec hostname} hostname] - set d_rc [catch domainname domainname] - - if {![is_prefix $h_rc $host $hostname] - && ![is_prefix $d_rc $host $hostname.$domainname]} { - set user2_islocal 0 - } - } - - if !$user2_islocal { - if $verbose {send_user "connecting to $host\n"} - - if ![info exists proxy] { - proc whoami {} { - global env - if [info exists env(USER)] {return $env(USER)} - if [info exists env(LOGNAME)] {return $env(LOGNAME)} - if ![catch {exec whoami} user] {return $user} - if ![catch {exec logname} user] {return $user} - # error "can't figure out who you are!" - } - set proxy [whoami] - } - spawn rlogin $host -l $proxy -8 - set userin $spawn_id - set userout $spawn_id - - catch {set prompt $env(EXPECT_PROMPT)} - - set timeout 120 - expect { - assword: { - stty -echo - send_user "password (for $proxy) on $host: " - set old_timeout $timeout; set timeout -1 - expect_user -re "(.*)\n" - send_user "\n" - set timeout $old_timeout - send "$expect_out(1,string)\r" - # bother resetting echo? - exp_continue - } incorrect* { - send_user "invalid password or account\n" - exit - } "TERM = *) " { - send "\r" - exp_continue - } timeout { - send_user "connection to $host timed out\n" - exit - } eof { - send_user "connection to host failed: $expect_out(buffer)" - exit - } -re $prompt - } - if $verbose {send_user "starting kibitz on $host\n"} - # the kill protects user1 from receiving user3's - # prompt if user2 exits via expect's exit. - send "$kibitz $kibitz_flags -r $user;kill -9 $$\r" - - expect { - -re "kibitz $kibitz_flags -r $user.*KRUN" {} - -re "kibitz $kibitz_flags -r $user.*(kibitz\[^\r\]*)\r" { - send_user "unable to start kibitz on $host: \"$expect_out(1,string)\"\n" - send_user "try rlogin by hand followed by \"kibitz $user\"\n" - exit - } - timeout { - send_user "unable to start kibitz on $host: " - set expect_out(buffer) "timed out" - set timeout 0; expect -re .+ - send_user $expect_out(buffer) - exit - } - } - expect { - -re ".*\n" { - # pass back diagnostics - # should really strip out extra cr - send_user $expect_out(buffer) - exp_continue - } - KABORT exit - default exit - KDATA - } - } -} - -if $user_number==2 { - set pid [string trimleft $user -] + if $noproc==0 { + if {[llength $argv]>1} { + set pid [eval spawn [lrange $argv 1 end]] + } else { + # if running as CGI, shell may not be set! + set shell /bin/sh + catch {set shell $env(SHELL)} + set pid [spawn $shell] + } + set shell $spawn_id + } + + # is user2 remote? + regexp (\[^@\]*)@*(.*) $user ignore tmp host + set user $tmp + if ![string match $host ""] { + set h_rc [catch {exec hostname} hostname] + set d_rc [catch domainname domainname] + + if {![is_prefix $h_rc $host $hostname] + && ![is_prefix $d_rc $host $hostname.$domainname]} { + set user2_islocal 0 + } + } + + if !$user2_islocal { + if $verbose {send_user "connecting to $host\n"} + + if ![info exists proxy] { + proc whoami {} { + global env + if {[info exists env(USER)]} {return $env(USER)} + if {[info exists env(LOGNAME)]} {return $env(LOGNAME)} + if {![catch {exec whoami} user]} {return $user} + if {![catch {exec logname} user]} {return $user} + # error "can't figure out who you are!" + } + set proxy [whoami] + } + spawn rlogin $host -l $proxy -8 + set userin $spawn_id + set userout $spawn_id + + catch {set prompt $env(EXPECT_PROMPT)} + + set timeout 120 + expect { + assword: { + stty -echo + send_user "password (for $proxy) on $host: " + set old_timeout $timeout; set timeout -1 + expect_user -re "(.*)\n" + send_user "\n" + set timeout $old_timeout + send "$expect_out(1,string)\r" + # bother resetting echo? + exp_continue + } incorrect* { + send_user "invalid password or account\n" + exit + } "TERM = *) " { + send "\r" + exp_continue + } timeout { + send_user "connection to $host timed out\n" + exit + } eof { + send_user "connection to host failed: $expect_out(buffer)" + exit + } -re $prompt + } + if {$verbose} {send_user "starting kibitz on $host\n"} + # the kill protects user1 from receiving user3's + # prompt if user2 exits via expect's exit. + send "$kibitz $kibitz_flags -r $user;kill -9 $$\r" + + expect { + -re "kibitz $kibitz_flags -r $user.*KRUN" {} + -re "kibitz $kibitz_flags -r $user.*(kibitz\[^\r\]*)\r" { + send_user "unable to start kibitz on $host: \"$expect_out(1,string)\"\n" + send_user "try rlogin by hand followed by \"kibitz $user\"\n" + exit + } + timeout { + send_user "unable to start kibitz on $host: " + set expect_out(buffer) "timed out" + set timeout 0; expect -re .+ + send_user $expect_out(buffer) + exit + } + } + expect { + -re ".*\n" { + # pass back diagnostics + # should really strip out extra cr + send_user $expect_out(buffer) + exp_continue + } + KABORT exit + default exit + KDATA + } + } +} + +if {$user_number==2} { + set pid [string trimleft $user -] } set local_io [expr ($user_number==3)||$user2_islocal] -if $local_io||($user_number==2) { - if 0==[info exists pid] {set pid [pid]} +if {$local_io||($user_number==2)} { + if {0==[info exists pid]} {set pid [pid]} - set userinfile /tmp/exp0.$pid - set useroutfile /tmp/exp1.$pid + set userinfile /tmp/exp0.$pid + set useroutfile /tmp/exp1.$pid } proc prompt1 {} { - return "kibitz[info level].[history nextid]> " + return "kibitz[info level].[history nextid]> " } set esc_match {} if {$allow_escape} { set esc_match { @@ -276,58 +276,56 @@ } } } proc prompt1 {} { - return "kibitz[info level].[history nextid]> " + return "kibitz[info level].[history nextid]> " } set timeout -1 # kibitzer executes following code -if $user_number==2 { - # for readability, swap variables - set tmp $userinfile - set userinfile $useroutfile - set useroutfile $tmp - - if ![file readable $userinfile] { - send_user "Eh? No one is asking you to kibitz.\n" - exit -1 - } - spawn -open [open "|cat $catflags < $userinfile" "r"] - set userin $spawn_id - - spawn -open [open $useroutfile w] - set userout $spawn_id - # open will hang until other user's cat starts - - stty -echo raw - if $allow_escape {send_user "Escape sequence is $escape_printable\r\n"} - - # While user is reading message, try to delete other fifo - catch {exec rm -f $userinfile} - - eval interact $esc_match \ - -output $userout \ - -input $userin - - exit +if {$user_number==2} { + # for readability, swap variables + set tmp $userinfile + set userinfile $useroutfile + set useroutfile $tmp + + if ![file readable $userinfile] { + send_user "Eh? No one is asking you to kibitz.\n" + exit -1 + } + spawn -open [open "|cat $catflags < $userinfile" "r"] + set userin $spawn_id + + spawn -open [open $useroutfile w] + set userout $spawn_id + # open will hang until other user's cat starts + + stty -echo raw + if {$allow_escape} {send_user "Escape sequence is $escape_printable\r\n"} + + # While user is reading message, try to delete other fifo + catch {exec rm -f $userinfile} + + eval interact $esc_match \ + -output $userout \ + -input $userin + + exit } # only user_numbers 1 and 3 execute remaining code proc abort {} { - global user_number - - # KABORT tells user_number 1 that user_number 3 has run into problems - # and is exiting, and diagnostics have been returned already - if $user_number==3 {send_user KABORT} - exit + # KABORT tells user_number 1 that user_number 3 has run into problems + # and is exiting, and diagnostics have been returned already + if {$::user_number==3} {send_user KABORT} + exit } -if $local_io { +if {$local_io} { proc mkfifo {f} { if 0==[catch {exec mkfifo $f}] return ;# POSIX if 0==[catch {exec mknod $f p}] return # some systems put mknod in wierd places if 0==[catch {exec /usr/etc/mknod $f p}] return ;# Sun @@ -347,19 +345,19 @@ mkfifo $userinfile mkfifo $useroutfile # make sure other user can access despite umask exec chmod 666 $userinfile $useroutfile - if $verbose {send_user "asking $user to type: kibitz -$pid\n"} + if {$verbose} {send_user "asking $user to type: kibitz -$pid\n"} # can't use exec since write insists on being run from a tty! set rc [catch { system echo "Can we talk? Run: \"kibitz -$pid\"" | \ /bin/write $user $tty } ] - if $rc {rmfifos;abort} + if {$rc} {rmfifos;abort} spawn -open [open $useroutfile w] set userout $spawn_id # open will hang until other user's cat starts @@ -368,39 +366,43 @@ catch {exec rm $userinfile} } stty -echo raw -if $user_number==3 { - send_user "KDATA" ;# this tells user_number 1 to send data - - interact { - -output $userout - -input $userin eof { - wait -i $userin - return -tcl - } -output $user_spawn_id - } -} else { - if $allow_escape {send_user "Escape sequence is $escape_printable\r\n"} - - if $noproc { - interact { - -output $userout - -input $userin eof {wait -i $userin; return} - -output $user_spawn_id - } - } else { - eval interact $esc_match { - -output $shell \ - -input $userin eof { - wait -i $userin - close -i $shell - return - } -output $shell \ - -input $shell -output "$user_spawn_id $userout" - } - wait -i $shell - } -} - -if $local_io rmfifos +if {$user_number==3} { + send_user "KDATA" ;# this tells user_number 1 to send data + + interact { + -output $userout + -input $userin eof { + wait -i $userin + return -tcl + } -output $user_spawn_id + } +} else { + if {$allow_escape} {send_user "Escape sequence is $escape_printable\r\n"} + + if {$noproc} { + interact { + -output $userout + -input $userin eof {wait -i $userin; return} + -output $user_spawn_id + } + } else { + eval interact $esc_match { + -output $shell \ + -input $userin eof { + wait -i $userin + close -i $shell + return + } -output $shell \ + -input $shell eof { + close -i $userout + wait -i $userout + return + } -output "$user_spawn_id $userout" + } + wait -i $shell + } +} + +if {$local_io} rmfifos Index: example/lpunlock ================================================================== --- example/lpunlock +++ example/lpunlock @@ -16,21 +16,21 @@ send_user "usage: lpunlock \[\]\n" send_user "example: lpunlock lw-isg durer\n" exit } -if $argc==0 usage +if {$argc==0} usage set printer [lindex $argv 0] set client [exec hostname] if {$argc == 1} { # if no arg2, look in local printcap for info spawn ed /etc/printcap expect "\n" ;# discard character count send "/$printer/\r" - for {} 1 {} { + for {} {1} {} { expect -re ".*:rm=(\[^:]*):.*\r\n" { set server $expect_out(1,string) break } "\r\n*\\\r\n" { ;# look at next line of entry send "\r" Index: example/mkpasswd ================================================================== --- example/mkpasswd +++ example/mkpasswd @@ -5,16 +5,19 @@ # defaults set length 9 set minnum 2 set minlower 2 set minupper 2 +set minspecial 1 set verbose 0 set distribute 0 -if [file executable /bin/yppasswd] { +if {[file executable /bin/nispasswd]} { + set defaultprog /bin/nispasswd +} elseif {[file executable /bin/yppasswd]} { set defaultprog /bin/yppasswd -} elseif [file executable /bin/passwd] { +} elseif {[file executable /bin/passwd]} { set defaultprog /bin/passwd } else { set defaultprog passwd } set prog $defaultprog @@ -32,10 +35,13 @@ set minlower [lindex $argv 1] set argv [lrange $argv 2 end] } "-C" { set minupper [lindex $argv 1] set argv [lrange $argv 2 end] + } "-s" { + set minspecial [lindex $argv 1] + set argv [lrange $argv 2 end] } "-v" { set verbose 1 set argv [lrange $argv 1 end] } "-p" { set prog [lindex $argv 1] @@ -55,43 +61,40 @@ puts " where arguments are:" puts " -l # (length of password, default = $length)" puts " -d # (min # of digits, default = $minnum)" puts " -c # (min # of lowercase chars, default = $minlower)" puts " -C # (min # of uppercase chars, default = $minupper)" + puts " -s # (min # of special chars, default = $minspecial)" puts " -v (verbose, show passwd interaction)" puts " -p prog (program to set password, default = $defaultprog)" exit 1 } -if {$minnum + $minlower + $minupper > $length} { +if {$minnum + $minlower + $minupper + $minspecial > $length} { puts "impossible to generate $length-character password\ with $minnum numbers, $minlower lowercase letters,\ - and $minupper uppercase letters" + $minupper uppercase letters and\ + $minspecial special characters." exit 1 } # if there is any underspecification, use additional lowercase letters -set minlower [expr $length - ($minnum + $minupper)] +set minlower [expr {$length - ($minnum + $minupper + $minspecial)}] set lpass "" ;# password chars typed by left hand set rpass "" ;# password chars typed by right hand -# insert char into password at a random position +# insert char into password at a random position, thereby spreading +# the different kinds of characters throughout the password proc insert {pvar char} { - upvar $pvar p + upvar $pvar p - set p [linsert $p [rand [expr 1+[llength $p]]] $char] + set p [linsert $p [rand [expr {(1+[llength $p])}]] $char] } -set _ran [pid] - proc rand {m} { - global _ran - - set period 259200 - set _ran [expr ($_ran*7141 + 54773) % $period] - expr int($m*($_ran/double($period))) + expr {int($m*rand())} } # choose left or right starting hand set initially_left [set isleft [rand 2]] @@ -115,21 +118,27 @@ if {$distribute} { set lkeys {q w e r t a s d f g z x c v b} set rkeys {y u i o p h j k l n m} set lnums {1 2 3 4 5 6} set rnums {7 8 9 0} + set lspec {! @ # \$ %} + set rspec {^ & * ( ) - = _ + [ ] "{" "}" \\ | ; : ' \" < > , . ? /} } else { set lkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} set rkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} set lnums {0 1 2 3 4 5 6 7 8 9} set rnums {0 1 2 3 4 5 6 7 8 9} + set lspec {! @ # \$ % ~ ^ & * ( ) - = _ + [ ] "{" "}" \\ | ; : ' \" < > , . ? /} + set rspec {! @ # \$ % ~ ^ & * ( ) - = _ + [ ] "{" "}" \\ | ; : ' \" < > , . ? /} } set lkeys_length [llength $lkeys] set rkeys_length [llength $rkeys] set lnums_length [llength $lnums] set rnums_length [llength $rnums] +set lspec_length [llength $lspec] +set rspec_length [llength $rspec] psplit $minnum left right for {set i 0} {$i<$left} {incr i} { insert lpass [lindex $lnums [rand $lnums_length]] } @@ -150,30 +159,26 @@ insert lpass [string toupper [lindex $lkeys [rand $lkeys_length]]] } for {set i 0} {$i<$right} {incr i} { insert rpass [string toupper [lindex $rkeys [rand $rkeys_length]]] } + +psplit $minspecial left right +for {set i 0} {$i<$left} {incr i} { + insert lpass [lindex $lspec [rand $lspec_length]] +} +for {set i 0} {$i<$right} {incr i} { + insert rpass [lindex $rspec [rand $rspec_length]] +} # merge results together -if {$initially_left} { - regexp "(\[^ ]*) *(.*)" "$lpass" x password lpass - while {[llength $lpass]} { - regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass - regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass - } - if {[llength $rpass]} { - append password $rpass - } -} else { - regexp "(\[^ ]*) *(.*)" "$rpass" x password rpass - while {[llength $rpass]} { - regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass - regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass - } - if {[llength $lpass]} { - append password $lpass - } +foreach l $lpass r $rpass { + if {$initially_left} { + append password $l $r + } else { + append password $r $l + } } if {[info exists user]} { if {!$verbose} { log_user 0 Index: example/mkpasswd.man ================================================================== --- example/mkpasswd.man +++ example/mkpasswd.man @@ -54,10 +54,15 @@ The .B \-C flag defines the minimum number of uppercase alphabetic characters that must be in the password. The default is 2. +The +.B \-s +flag defines the minimum number of special characters that must be in the password. +The default is 1. + The .B \-p flag names a program to set the password. By default, /etc/yppasswd is used if present, otherwise /bin/passwd is used. Index: example/passmass ================================================================== --- example/passmass +++ example/passmass @@ -3,195 +3,208 @@ # Synopsis: passmass host1 host2 host3 .... # Don Libes - March 11, 1991 # Description: Change passwords on the named machines. # -# You are prompted for old/new passwords. (If you are changing root -# passwords and have equivalencing, the old password is not used and may be -# omitted.) -# -# Additional arguments may be used for fine tuning. They affect all hosts -# which follow until another argument overrides. -# -# -user User whose password will be changed. By default, the current -# user is used. -# -rlogin Use rlogin to access host. (default) -# -slogin Use slogin to access host. -# -telnet Use telnet to access host. -# -program Next argument is taken as program to run to set password. -# Default is "passwd". Other common choices are "yppasswd" and -# "set passwd" (e.g., VMS hosts). -# -prompt Next argument is taken as a prompt suffix pattern. This allows -# the script to know when the shell is prompting. The default is -# "# " for root and "% " for non-root accounts. -# -timeout Next argument is number of seconds to wait for responses. -# Default is 30 but some systems can be much slower logging in. - -# The best way to run this is to put the command in a one-line shell script -# or alias. (Presumably, the set of hosts and parameters will rarely change.) -# Then run it whenever you want to change your passwords on all the hosts. +# See passmass.man for further info. exp_version -exit 5.0 -if $argc==0 { - send_user "usage: $argv0 host1 host2 host3 . . .\n" - exit +if {$argc==0} { + send_user "usage: $argv0 host1 host2 host3 . . .\n" + exit } expect_before -i $user_spawn_id \003 exit proc badhost {host emsg} { - global badhosts - - send_user "\r\n\007password not changed on $host - $emsg\n\n" - if 0==[llength $badhosts] { - set badhosts $host - } else { - set badhosts [concat $badhosts $host] - } + global badhosts + + send_user "\r\n\007password not changed on $host - $emsg\n\n" + if {0==[llength $badhosts]} { + set badhosts $host + } else { + set badhosts [concat $badhosts $host] + } } # set defaults set login "rlogin" set program "passwd" set user [exec whoami] +set su 0 -set timeout 1000000 +set timeout -1 stty -echo -send_user "old password: " -expect_user -re "(.*)\n" -send_user "\n" -set password(old) $expect_out(1,string) -send_user "new password: " -expect_user -re "(.*)\n" -send_user "\n" -set password(new) $expect_out(1,string) -send_user "retype new password: " -expect_user -re "(.*)\n" -set password(newcheck) $expect_out(1,string) -send_user "\n" + +if {!$su} { + send_user "old password: " + expect_user -re "(.*)\n" + send_user "\n" + set password(old) $expect_out(1,string) + set password(login) $expect_out(1,string) + send_user "new password: " + expect_user -re "(.*)\n" + send_user "\n" + set password(new) $expect_out(1,string) + send_user "retype new password: " + expect_user -re "(.*)\n" + set password(newcheck) $expect_out(1,string) + send_user "\n" +} else { + send_user "login password: " + expect_user -re "(.*)\n" + send_user "\n" + set password(login) $expect_out(1,string) + send_user "root password: " + expect_user -re "(.*)\n" + send_user "\n" + set password(old) $expect_out(1,string) + send_user "new password: " + expect_user -re "(.*)\n" + send_user "\n" + set password(new) $expect_out(1,string) + send_user "retype new password: " + expect_user -re "(.*)\n" + set password(newcheck) $expect_out(1,string) + send_user "\n" +} + stty echo trap exit SIGINT if ![string match $password(new) $password(newcheck)] { - send_user "mismatch - password unchanged\n" - exit + send_user "mismatch - password unchanged\n" + exit } #send_user "want to see new password you just typed? (y|n) " #expect_user "*\n" # -#if [string match "y" [lindex $expect_match 0 c]] { +#if {[string match "y" [lindex $expect_match 0 c]]} { # send_user "password is <$password(new)>\nproceed? (y|n) " # expect_user "*\n" # if ![string match "y" [lindex $expect_match 0 c]] exit #} set timeout 30 set badhosts {} for {set i 0} {$i<$argc} {incr i} { - - set arg [lindex $argv $i] - switch -- $arg \ - "-user" { - incr i - set user [lindex $argv $i] - continue - } "-prompt" { - incr i - set prompt [lindex $argv $i] - continue - } "-rlogin" { - set login "rlogin" - continue - } "-slogin" { - set login "slogin" - continue - } "-telnet" { - set login "telnet" - continue - } "-program" { - incr i - set program [lindex $argv $i] - continue - } "-timeout" { - incr i - set timeout [lindex $argv $i] - continue - } - - set host $arg - if [string match $login "rlogin"] { - set pid [spawn rlogin $host -l $user] - } elseif [string match $login "slogin"] { - set pid [spawn slogin $host -l $user] - } elseif [string match $login "ssh"] { - set pid [spawn ssh $host -l $user] - } else { - set pid [spawn telnet $host] - expect -re "(login|Username):.*" { - send "$user\r" - } - } - - if ![info exists prompt] { - if [string match $user "root"] { - set prompt "# " - } else { - set prompt "(%|\\\$) " - } - } - - set logged_in 0 - for {} 1 {} { - expect "Password*" { - send "$password(old)\r" - } eof { - badhost $host "spawn failed" - break - } timeout { - badhost $host "could not log in (or unrecognized prompt)" - exec kill $pid - expect eof - break - } -re "incorrect|invalid" { - badhost $host "bad password or login" - exec kill $pid - expect eof - break - } -re $prompt { - set logged_in 1 - break - } - } - - if (!$logged_in) { - wait - continue - } - - send "$program\r" - expect "Old password*" { - send "$password(old)\r" - expect "Sorry*" { - badhost $host "old password is bad?" - continue - } "password:" - } -re "(n|N)ew password:" - send "$password(new)\r" - expect -re "not changed|unchanged" { - badhost $host "new password is bad?" - continue - } -re "(password|Verification|Verify|again):.*" - send "$password(new)\r" - expect -re "(not changed|incorrect|choose new).*" { - badhost $host "password is bad?" - continue - } -re "$prompt" - send_user "\n" - - close - wait -} - -if [llength $badhosts] {send_user "\nfailed to set password on $badhosts\n"} + set arg [lindex $argv $i] + switch -- $arg "-user" { + incr i + set user [lindex $argv $i] + continue + } "-prompt" { + incr i + set prompt [lindex $argv $i] + continue + } "-rlogin" { + set login "rlogin" + continue + } "-slogin" { + set login "slogin" + continue + } "-telnet" { + set login "telnet" + continue + } "-program" { + incr i + set program [lindex $argv $i] + continue + } "-timeout" { + incr i + set timeout [lindex $argv $i] + continue + } "-su" { + incr i + set su [lindex $argv $i] + continue + } + + set host $arg + if {[string match $login "rlogin"]} { + set pid [spawn rlogin $host -l $user] + } elseif {[string match $login "slogin"]} { + set pid [spawn slogin $host -l $user] + } elseif {[string match $login "ssh"]} { + set pid [spawn ssh $host -l $user] + } else { + set pid [spawn telnet $host] + expect -re "(login|Username):.*" { + send "$user\r" + } + } + + if ![info exists prompt] { + if {[string match $user "root"]} { + set prompt "# " + } else { + set prompt "(%|\\\$|#) " + } + } + + set logged_in 0 + while {1} { + expect "Password*" { + send "$password(login)\r" + } eof { + badhost $host "spawn failed" + break + } timeout { + badhost $host "could not log in (or unrecognized prompt)" + exec kill $pid + expect eof + break + } -re "incorrect|invalid" { + badhost $host "bad password or login" + exec kill $pid + expect eof + break + } -re $prompt { + set logged_in 1 + break + } + } + + if (!$logged_in) { + wait + continue + } + + if ($su) { + send "su -\r" + expect "Password:" + send "$password(old)\r" + expect "# " + send "$program root\r" + } else { + send "$program\r" + } + + expect "Old password*" { + send "$password(old)\r" + expect "Sorry*" { + badhost $host "old password is bad?" + continue + } "password:" + } -re "(n|N)ew password:" + send "$password(new)\r" + expect -re "not changed|unchanged" { + badhost $host "new password is bad?" + continue + } -re "(password|Verification|Verify|again):.*" + send "$password(new)\r" + expect -re "(not changed|incorrect|choose new).*" { + badhost $host "password is bad?" + continue + } -re "$prompt" + send_user "\n" + + close + wait +} + +if {[llength $badhosts]} { + send_user "\nfailed to set password on $badhosts\n" +} Index: example/passmass.man ================================================================== --- example/passmass.man +++ example/passmass.man @@ -43,39 +43,47 @@ Use telnet to access host. .TP 4 -program -Next argument is taken as program to run to set password. Default is +Next argument is a program to run to set the password. Default is "passwd". Other common choices are "yppasswd" and "set passwd" (e.g., VMS hosts). A program name such as "password fred" can be used to create entries for new accounts (when run as root). .TP 4 -prompt -Next argument is taken as a prompt suffix pattern. This allows +Next argument is a prompt suffix pattern. This allows the script to know when the shell is prompting. The default is "# " for root and "% " for non-root accounts. .TP 4 -timeout -Next argument is number of seconds to wait for responses. +Next argument is the number of seconds to wait for responses. Default is 30 but some systems can be much slower logging in. +.TP 4 +-su + +Next argument is 1 or 0. If 1, you are additionally prompted for a +root password which is used to su after logging in. root's password +is changed rather than the user's. This is useful for hosts which +do not allow root to log in. + .SH HOW TO USE The best way to run Passmass is to put the command in a one-line shell script or alias. Whenever you get a new account on a new machine, add the appropriate arguments to the command. Then run it whenever you want to change your passwords on all the hosts. .SH CAVEATS -It should be obvious that using the same password on multiple hosts -carries risks. In particular, if the password can be stolen, then all -of your accounts are at risk. Thus, you should not use Passmass in -situations where your password is visible, such as across a network -where hackers are known to eavesdrop. +Using the same password on multiple hosts carries risks. In +particular, if the password can be stolen, then all of your accounts +are at risk. Thus, you should not use Passmass in situations where +your password is visible, such as across a network which hackers are +known to eavesdrop. On the other hand, if you have enough accounts with different passwords, you may end up writing them down somewhere - and .I that can be a security problem. Funny story: my college roommate had an Index: example/passwd.cgi ================================================================== --- example/passwd.cgi +++ example/passwd.cgi @@ -97,10 +97,10 @@ set error $expect_out(1,string) } close wait -if [info exists error] { +if {[info exists error]} { errormsg "$error" } else { successmsg "Password changed successfully." } Index: example/reprompt ================================================================== --- example/reprompt +++ example/reprompt @@ -7,14 +7,14 @@ foreach {timeout prompt} $argv {} send_error $prompt expect { - timeout { - send_error "\nwake up!!\a" - send_error \n$prompt - exp_continue - } - -re .+ { - send_user $expect_out(buffer) - } + timeout { + send_error "\nwake up!!\a" + send_error \n$prompt + exp_continue + } + -re .+ { + send_user $expect_out(buffer) + } } Index: example/rftp ================================================================== --- example/rftp +++ example/rftp @@ -47,293 +47,289 @@ match_max -d 100000 ;# max size of a directory listing # return name of file from one line of directory listing proc getname {line} { - # if it's a symbolic link, return local name - set i [lsearch $line "->"] - if {-1==$i} { - # not a sym link, return last token of line as name - return [lindex $line [expr [llength $line]-1]] - } else { - # sym link, return "a" of "a -> b" - return [lindex $line [expr $i-1]] - } + # if it's a symbolic link, return local name + set i [lsearch $line "->"] + if {-1==$i} { + # not a sym link, return last token of line as name + return [lindex $line [expr [llength $line]-1]] + } else { + # sym link, return "a" of "a -> b" + return [lindex $line [expr $i-1]] + } } proc putfile {name} { - global current_type default_type - global binary ascii tenex - global file_timeout - - switch -- $name $binary {set new_type binary} \ - $ascii {set new_type ascii} \ - $tenex {set new_type tenex} \ - default {set new_type $default_type} - - if {$current_type != $new_type} { - settype $new_type - } - - set timeout $file_timeout - send "put $name\r" - expect timeout { - send_user "ftp timed out in response to \"put $name\"\n" - exit - } "ftp>*" + global current_type default_type + global binary ascii tenex + global file_timeout + + switch -- $name $binary {set new_type binary} \ + $ascii {set new_type ascii} \ + $tenex {set new_type tenex} \ + default {set new_type $default_type} + + if {$current_type != $new_type} { + settype $new_type + } + + set timeout $file_timeout + send "put $name\r" + expect timeout { + send_user "ftp timed out in response to \"put $name\"\n" + exit + } "ftp>*" } proc getfile {name} { - global current_type default_type - global binary ascii tenex - global file_timeout - - switch -- $name $binary {set new_type binary} \ - $ascii {set new_type ascii} \ - $tenex {set new_type tenex} \ - default {set new_type $default_type} - - if {$current_type != $new_type} { - settype $new_type - } - - set timeout $file_timeout - send "get $name\r" - expect timeout { - send_user "ftp timed out in response to \"get $name\"\n" - exit - } "ftp>*" + global current_type default_type + global binary ascii tenex + global file_timeout + + switch -- $name $binary {set new_type binary} \ + $ascii {set new_type ascii} \ + $tenex {set new_type tenex} \ + default {set new_type $default_type} + + if {$current_type != $new_type} { + settype $new_type + } + + set timeout $file_timeout + send "get $name\r" + expect timeout { + send_user "ftp timed out in response to \"get $name\"\n" + exit + } "ftp>*" } # returns 1 if successful, 0 otherwise proc putdirectory {name} { - send "mkdir $name\r" - expect "550*denied*ftp>*" { - send_user "failed to make remote directory $name\n" - return 0 - } timeout { - send_user "timed out on make remote directory $name\n" - return 0 - } -re "(257|550.*exists).*ftp>.*" - # 550 is returned if directory already exists - - send "cd $name\r" - expect "550*ftp>*" { - send_user "failed to cd to remote directory $name\n" - return 0 - } timeout { - send_user "timed out on cd to remote directory $name\n" - return 0 - } -re "2(5|0)0.*ftp>.*" - # some ftp's return 200, some return 250 - - send "lcd $name\r" - # hard to know what to look for, since my ftp doesn't return status - # codes. It is evidentally very locale-dependent. - # So, assume success. - expect "ftp>*" - putcurdirectory - send "lcd ..\r" - expect "ftp>*" - send "cd ..\r" - expect timeout { - send_user "failed to cd to remote directory ..\n" - return 0 - } -re "2(5|0)0.*ftp>.*" - - return 1 + send "mkdir $name\r" + expect "550*denied*ftp>*" { + send_user "failed to make remote directory $name\n" + return 0 + } timeout { + send_user "timed out on make remote directory $name\n" + return 0 + } -re "(257|550.*exists).*ftp>.*" + # 550 is returned if directory already exists + + send "cd $name\r" + expect "550*ftp>*" { + send_user "failed to cd to remote directory $name\n" + return 0 + } timeout { + send_user "timed out on cd to remote directory $name\n" + return 0 + } -re "2(5|0)0.*ftp>.*" + # some ftp's return 200, some return 250 + + send "lcd $name\r" + # hard to know what to look for, since my ftp doesn't return status + # codes. It is evidentally very locale-dependent. + # So, assume success. + expect "ftp>*" + putcurdirectory + send "lcd ..\r" + expect "ftp>*" + send "cd ..\r" + expect timeout { + send_user "failed to cd to remote directory ..\n" + return 0 + } -re "2(5|0)0.*ftp>.*" + + return 1 } # returns 1 if successful, 0 otherwise proc getdirectory {name transfer} { - send "cd $name\r" - # this can fail normally if it's a symbolic link, and we are just - # experimenting - expect "550*ftp>*" { - send_user "failed to cd to remote directory $name\n" - return 0 - } timeout { - send_user "timed out on cd to remote directory $name\n" - return 0 - } -re "2(5|0)0.*ftp>.*" - # some ftp's return 200, some return 250 - - if $transfer { - send "!mkdir $name\r" - expect "denied*" return timeout return "ftp>" - send "lcd $name\r" - # hard to know what to look for, since my ftp doesn't return - # status codes. It is evidentally very locale-dependent. - # So, assume success. - expect "ftp>*" - } - getcurdirectory $transfer - if $transfer { - send "lcd ..\r" - expect "ftp>*" - } - send "cd ..\r" - expect timeout { - send_user "failed to cd to remote directory ..\n" - return 0 - } -re "2(5|0)0.*ftp>.*" + send "cd $name\r" + # this can fail normally if it's a symbolic link, and we are just + # experimenting + expect "550*ftp>*" { + send_user "failed to cd to remote directory $name\n" + return 0 + } timeout { + send_user "timed out on cd to remote directory $name\n" + return 0 + } -re "2(5|0)0.*ftp>.*" + # some ftp's return 200, some return 250 + + if {$transfer} { + send "!mkdir $name\r" + expect "denied*" return timeout return "ftp>" + send "lcd $name\r" + # hard to know what to look for, since my ftp doesn't return + # status codes. It is evidentally very locale-dependent. + # So, assume success. + expect "ftp>*" + } + getcurdirectory $transfer + if {$transfer} { + send "lcd ..\r" + expect "ftp>*" + } + send "cd ..\r" + expect timeout { + send_user "failed to cd to remote directory ..\n" + return 0 + } -re "2(5|0)0.*ftp>.*" return 1 } proc putentry {name type} { - switch -- $type \ - d { - # directory - if {$name=="." || $name==".."} return - putdirectory $name - } - { - # file - putfile $name - } l { - # symlink, could be either file or directory - # first assume it's a directory - if [putdirectory $name] return - putfile $name - } default { - send_user "can't figure out what $name is, skipping\n" - } + switch -- $type d { + # directory + if {$name=="." || $name==".."} return + putdirectory $name + } - { + # file + putfile $name + } l { + # symlink, could be either file or directory + # first assume it's a directory + if {[putdirectory $name]} return + putfile $name + } default { + send_user "can't figure out what $name is, skipping\n" + } } proc getentry {name type transfer} { - switch -- $type \ - d { - # directory - getdirectory $name $transfer - } - { - # file - if !$transfer return - getfile $name - } l { - # symlink, could be either file or directory - # first assume it's a directory - if [getdirectory $name $transfer] return - if !$transfer return - getfile $name - } default { - send_user "can't figure out what $name is, skipping\n" - } + switch -- $type d { + # directory + if {$name=="." || $name==".."} return + getdirectory $name $transfer + } - { + # file + if {!$transfer} return + getfile $name + } l { + # symlink, could be either file or directory + # first assume it's a directory + if {[getdirectory $name $transfer]} return + if {!$transfer} return + getfile $name + } default { + send_user "can't figure out what $name is, skipping\n" + } } proc putcurdirectory {} { - send "!/bin/ls -alg\r" - expect timeout { - send_user "failed to get directory listing\n" - return - } "ftp>*" - - set buf $expect_out(buffer) - - for {} 1 {} { - # if end of listing, succeeded! - if 0==[regexp "(\[^\n]*)\n(.*)" $buf dummy line buf] return - - set token [lindex $line 0] - switch -- $token \ - !/bin/ls { - # original command - } total { - # directory header - } . { - # unreadable - } default { - # either file or directory - set name [getname $line] - set type [string index $line 0] - putentry $name $type - } - } -} - + send "!/bin/ls -alg\r" + expect timeout { + send_user "failed to get directory listing\n" + return + } "ftp>*" + + set buf $expect_out(buffer) + + while {1} { + # if end of listing, succeeded! + if 0==[regexp "(\[^\n]*)\n(.*)" $buf dummy line buf] return + + set token [lindex $line 0] + switch -- $token !/bin/ls { + # original command + } total { + # directory header + } . { + # unreadable + } default { + # either file or directory + set name [getname $line] + set type [string index $line 0] + putentry $name $type + } + } +} # look at result of "dir". If transfer==1, get all files and directories proc getcurdirectory {transfer} { - send "dir\r" - expect timeout { - send_user "failed to get directory listing\n" - return - } "ftp>*" - - set buf $expect_out(buffer) - - for {} 1 {} { - regexp "(\[^\n]*)\n(.*)" $buf dummy line buf - - set token [lindex $line 0] - switch -- $token \ - dir { - # original command - } 200 { - # command successful - } 150 { - # opening data connection - } total { - # directory header - } 226 { - # transfer complete, succeeded! - return - } ftp>* { - # next prompt, failed! - return - } . { - # unreadable - } default { - # either file or directory - set name [getname $line] - set type [string index $line 0] - getentry $name $type $transfer - } - } + send "dir\r" + expect timeout { + send_user "failed to get directory listing\n" + return + } "ftp>*" + + set buf $expect_out(buffer) + + while {1} { + regexp "(\[^\n]*)\n(.*)" $buf dummy line buf + + set token [lindex $line 0] + switch -- $token dir { + # original command + } 200 { + # command successful + } 150 { + # opening data connection + } total { + # directory header + } 226 { + # transfer complete, succeeded! + return + } ftp>* { + # next prompt, failed! + return + } . { + # unreadable + } default { + # either file or directory + set name [getname $line] + set type [string index $line 0] + getentry $name $type $transfer + } + } } proc settype {t} { - global current_type + global current_type - send "type $t\r" - set current_type $t - expect "200*ftp>*" + send "type $t\r" + set current_type $t + expect "200*ftp>*" } proc final_msg {} { - # write over the previous prompt with our message - send_user "\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n" - # and then reprompt - send_user "ftp> " + # write over the previous prompt with our message + send_user "\rQuit ftp or cd to another directory and press ~g, ~p, or ~l\n" + # and then reprompt + send_user "ftp> " } -if [file readable ~/.rftprc] {source ~/.rftprc} +if {[file readable ~/.rftprc]} {source ~/.rftprc} set first_time 1 -if $argc>1 { - send_user "usage: rftp [host] - exit +if {$argc>1} { + send_user "usage: rftp [host]" + exit } send_user "Once logged in, cd to the directory to be transferred and press:\n" send_user "~p to put the current directory from the local to the remote host\n" send_user "~g to get the current directory from the remote host to the local host\n" send_user "~l to list the current directory from the remote host\n" -if $argc==0 {spawn ftp} else {spawn ftp $argv} +if {$argc==0} {spawn ftp} else {spawn ftp $argv} interact -echo ~g { - if $first_time { - set first_time 0 - settype $default_type - } - getcurdirectory 1 - final_msg + if {$first_time} { + set first_time 0 + settype $default_type + } + getcurdirectory 1 + final_msg } -echo ~p { - if $first_time { - set first_time 0 - settype $default_type - } - putcurdirectory - final_msg + if {$first_time} { + set first_time 0 + settype $default_type + } + putcurdirectory + final_msg } -echo ~l { - getcurdirectory 0 - final_msg + getcurdirectory 0 + final_msg } Index: example/robohunt ================================================================== --- example/robohunt +++ example/robohunt @@ -9,72 +9,72 @@ expect_version -exit 5.0 set timeout 1 proc random {} { - global ia ic im jran - - set jran [expr ($jran*$ia + $ic) % $im] - return $jran + global ia ic im jran + + set jran [expr ($jran*$ia + $ic) % $im] + return $jran } set ia 7141 set ic 54773 set im 259200 set jran [pid] # given a direction and number, moves that many spaces in that direction proc mv {dir num} { - # first try firing a bullet (what the hell...open some walls to move!) - send "f" - for {set i 0} {$i<$num} {incr i} { - send $dir - } + # first try firing a bullet (what the hell...open some walls to move!) + send "f" + for {set i 0} {$i<$num} {incr i} { + send $dir + } } # move a random distance/direction # 31 is arbitrarily used as a max distance to move in any one direction # this is a compromise between long horizontal and vertical moves # but since excess movement is good for stabbing, this is reasonable proc move {} { - set num [random] - set mask [expr $num&3] - set num [expr $num&31] - if $mask==0 {send "H"; mv "h" $num; return} - if $mask==1 {send "L"; mv "l" $num; return} - if $mask==2 {send "K"; mv "k" $num; return} - send "J"; mv "j" $num; return + set num [random] + set mask [expr $num&3] + set num [expr $num&31] + if $mask==0 {send "H"; mv "h" $num; return} + if $mask==1 {send "L"; mv "l" $num; return} + if $mask==2 {send "K"; mv "k" $num; return} + send "J"; mv "j" $num; return } -if 2==$argc { set output 0 } {set output 1} -if 1>$argc { send_user "usage: robohunt name \[-nodisplay\]\n"; exit} +if {2==$argc} { set output 0 } {set output 1} +if {1>$argc} { send_user "usage: robohunt name \[-nodisplay\]\n"; exit} spawn hunt -b -c -n [lindex $argv 0] expect "team" send "\r" set several_moves 5 expect "Monitor:" -sleep 1 +after 1000 expect ;# flush output log_user 0 # output is turned off so that we can first strip out ^Gs before they # are sent to the tty. It seems to drive xterms crazy - because our # rather stupid algorithm off not checking after every move can cause # the game to send a lot of them. -for {} 1 {} { - # make several moves at a time, before checking to see if we are dead - # this is a compromise between just ignoring our status after each move - # and looking at our status after each move - for {set j $several_moves} {$j} {incr j -1} { - move - } - - expect { - -re ^\007+ {exp_continue} - -re "\\? " {send y} - -re .+ - } - if $output {send_user -raw $expect_out(buffer)} +for {} {1} {} { + # make several moves at a time, before checking to see if we are dead + # this is a compromise between just ignoring our status after each move + # and looking at our status after each move + for {set j $several_moves} {$j} {incr j -1} { + move + } + + expect { + -re ^\007+ {exp_continue} + -re "\\? " {send y} + -re .+ + } + if $output {send_user -raw $expect_out(buffer)} } Index: example/rogue.exp ================================================================== --- example/rogue.exp +++ example/rogue.exp @@ -3,15 +3,15 @@ # Idea is that any game with a Strength of 18 is unusually good. # Written by Don Libes - March, 1990 set timeout -1 while {1} { - spawn rogue - expect "Str: 18" break \ - "Str: 16" - send "Q" - expect "quit?" - send "y" - close - wait + spawn rogue + expect "Str: 18" break \ + "Str: 16" + send "Q" + expect "quit?" + send "y" + close + wait } interact Index: example/telnet-in-bg ================================================================== --- example/telnet-in-bg +++ example/telnet-in-bg @@ -5,11 +5,11 @@ # Author: Don Libes, NIST, 1/5/95 spawn -ignore HUP telnet $argv ;# start telnet interact \032 return ;# interact until ^Z -if [fork] exit ;# disconnect from terminal +if {[fork]} exit ;# disconnect from terminal disconnect set log [open logfile w] ;# open logfile expect -re .+ { ;# and record everything to it puts -nonewline $log $expect_out(buffer) Index: example/term_expect ================================================================== --- example/term_expect +++ example/term_expect @@ -110,11 +110,11 @@ unset env(DISPLAY) set env(LINES) $rows set env(COLUMNS) $cols set env(TERM) "tt" -if $termcap { +if {$termcap} { set env(TERMCAP) {tt: :cm=\E[%d;%dH: :up=\E[A: :nd=\E[C: :cl=\E[H\E[J: @@ -132,11 +132,11 @@ :k8=\EOW: :k9=\EOX: } } -if $terminfo { +if {$terminfo} { set env(TERMINFO) /tmp set ttsrc "/tmp/tt.src" set file [open $ttsrc w] puts $file {tt|textterm|Don Libes' tk text widget terminal emulator, @@ -282,11 +282,11 @@ set s [string range $s $chars_to_write end] # update cur_col incr cur_col $chars_to_write # update cur_row - if $newline { + if {$newline} { term_down } ################## # write full lines Index: example/tknewsbiff ================================================================== --- example/tknewsbiff +++ example/tknewsbiff @@ -33,11 +33,11 @@ # PUBLIC proc mapwindow {} { global _window_open - if $_window_open { + if {$_window_open} { wm deiconify . } else { wm iconify . } } @@ -47,11 +47,11 @@ puts "$argv0: $msg" exit 1 } -if [info exists env(DOTDIR)] { +if {[info exists env(DOTDIR)]} { set home $env(DOTDIR) } else { set home [glob ~] } @@ -74,12 +74,12 @@ pack .list -side left -fill both -expand 1 while {[llength $argv]>0} { set arg [lindex $argv 0] - if [file readable $arg] { - if 0==[string compare active [file tail $arg]] { + if {[file readable $arg]} { + if {0==[string compare active [file tail $arg]]} { set active_file $arg set argv [lrange $argv 1 end] } else { # must be a config file set _config_file $arg @@ -104,18 +104,18 @@ proc user {} {} set watch_list {} set ignore_list {} - if [file exists $_config_file] { + if {[file exists $_config_file]} { # uplevel allows user to set global variables - if [catch {uplevel source $_config_file} msg] { + if {[catch {uplevel source $_config_file} msg]} { _abort "error reading $_config_file\n$msg" } } - if [llength $watch_list]==0 { + if {[llength $watch_list]==0} { watch * } } # PUBLIC @@ -135,15 +135,15 @@ # get time and server _read_config_file # if user didn't set newsrc, try ~/.newsrc-server convention. # if that fails, fall back to just plain ~/.newsrc -if ![info exists newsrc] { +if {![info exists newsrc]} { set newsrc $home/.newsrc-$server - if ![file readable $newsrc] { + if {![file readable $newsrc]} { set newsrc $home/.newsrc - if ![file readable $newsrc] { + if {![file readable $newsrc]} { _abort "cannot tell what newgroups you read found neither $home/.newsrc-$server nor $home/.newsrc" } } } @@ -150,16 +150,16 @@ # PRIVATE proc _read_newsrc {} { global db newsrc - if [catch {set file [open $newsrc]} msg] { + if {[catch {set file [open $newsrc]} msg]} { _abort $msg } while {-1 != [gets $file buf]} { - if [regexp "!" $buf] continue - if [regexp "(\[^:]*):.*\[-, ](\[0-9]+)" $buf dummy ng seen] { + if {[regexp "!" $buf]} continue + if {[regexp "(\[^:]*):.*\[-, ](\[0-9]+)" $buf dummy ng seen]} { set db($ng,seen) $seen } # only way 2nd regexp can fail is on lines # that have a : but no number } @@ -167,11 +167,11 @@ } proc _unknown_host {} { global server _default_server - if 0==[string compare $_default_server $server] { + if {0==[string compare $_default_server $server]} { puts "tknewsbiff: default server <$server> is not known" } else { puts "tknewsbiff: server <$server> is not known" } @@ -192,11 +192,11 @@ global db server active_list active_file upvar #0 server_timeout timeout set active_list {} - if [info exists active_file] { + if {[info exists active_file]} { spawn -open [open $active_file] } else { spawn telnet $server nntp expect { "20*\n" { @@ -245,22 +245,22 @@ # PRIVATE proc _isgood {ng threshold} { global db seen_list ignore_list # skip if we don't subscribe to it - if ![info exists db($ng,seen)] {return 0} + if {![info exists db($ng,seen)]} {return 0} # skip if the threshold isn't exceeded if {$db($ng,hi) - $db($ng,seen) < $threshold} {return 0} # skip if it matches an ignore command foreach igpat $ignore_list { - if [string match $igpat $ng] {return 0} + if {[string match $igpat $ng]} {return 0} } # skip if we've seen it before - if [lsearch -exact $seen_list $ng]!=-1 {return 0} + if {[lsearch -exact $seen_list $ng]!=-1} {return 0} # passed all tests, so remember that we've seen it lappend seen_list $ng return 1 } @@ -268,11 +268,11 @@ # return 1 if not seen on previous turn # PRIVATE proc _isnew {ng} { global previous_seen_list - if [lsearch -exact $previous_seen_list $ng]==-1 { + if {[lsearch -exact $previous_seen_list $ng]==-1} { return 1 } else { return 0 } } @@ -312,18 +312,18 @@ _abort "watch: expecting -threshold -display or -new but found: [lindex $watch 0]" } } foreach ng $active_list { - if [string match $ngpat $ng] { - if [_isgood $ng $threshold] { - if [llength $display] { + if {[string match $ngpat $ng]} { + if {[_isgood $ng $threshold]} { + if {[llength $display]} { set newsgroup $ng uplevel $display } - if [_isnew $ng] { - if [llength $new] { + if {[_isnew $ng]} { + if {[llength $new]} { set newsgroup $ng uplevel $new } } } @@ -370,11 +370,11 @@ wm geometry . ${width}x$current_height wm maxsize . 999 [llength $display_list] _display_ngs $width - if [string compare [wm state .] withdrawn]==0 { + if {[string compare [wm state .] withdrawn]==0} { mapwindow } } # actually write all newsgroups to the window @@ -454,11 +454,11 @@ # PUBLIC proc update-now {} { global _update_flag _cat_spawn_id - if $_update_flag return ;# already set, do nothing + if {$_update_flag} return ;# already set, do nothing set _update_flag 1 exp_send -i $_cat_spawn_id "\r" } @@ -500,16 +500,16 @@ set seen_list {} catch {unset db} } -for {} 1 {_sleep $delay} { +for {} {1} {_sleep $delay} { _init_ngs _read_newsrc - if [_read_active] continue + if {[_read_active]} continue _read_config_file _update_ngs user _update_window } Index: example/tkpasswd ================================================================== --- example/tkpasswd +++ example/tkpasswd @@ -6,70 +6,70 @@ # There is no man page. However, there is some on-line help when you run # the program. Technical details and insights are described in the # O'Reilly book "Exploring Expect". proc prog_exists {prog} { - global env - - foreach dir [split $env(PATH) :] { - if [file executable $dir/$prog] { - return 1 - } - } - return 0 + global env + + foreach dir [split $env(PATH) :] { + if {[file executable $dir/$prog]} { + return 1 + } + } + return 0 } frame .type -relief raised -bd 1 radiobutton .passwd -text passwd -variable passwd_cmd \ - -value {passwd {cat /etc/passwd}} \ - -anchor w -command get_users -relief flat + -value {passwd {cat /etc/passwd}} \ + -anchor w -command get_users -relief flat pack .passwd -in .type -fill x -if [prog_exists yppasswd] { +if {[prog_exists yppasswd]} { radiobutton .yppasswd -text yppasswd -variable passwd_cmd \ - -value {yppasswd {ypcat passwd}} \ - -anchor w -command get_users -relief flat + -value {yppasswd {ypcat passwd}} \ + -anchor w -command get_users -relief flat pack .yppasswd -in .type -fill x } -if [prog_exists nispasswd] { +if {[prog_exists nispasswd]} { radiobutton .nispasswd -text nispasswd -variable passwd_cmd \ - -value {nispasswd {niscat passwd}} \ - -anchor w -command get_users -relief flat + -value {nispasswd {niscat passwd}} \ + -anchor w -command get_users -relief flat pack .nispasswd -in .type -fill x } pack .type -fill x frame .sort -relief raised -bd 1 radiobutton .unsorted -text unsorted -variable sort_cmd -value " " \ - -anchor w -relief flat -command get_users + -anchor w -relief flat -command get_users radiobutton .name -text name -variable sort_cmd -value "| sort" \ - -anchor w -relief flat -command get_users + -anchor w -relief flat -command get_users radiobutton .uid -text uid -variable sort_cmd -value "| sort -t: -n +2" \ - -anchor w -relief flat -command get_users + -anchor w -relief flat -command get_users pack .unsorted .name .uid -in .sort -fill x pack .sort -fill x frame .users -relief raised -bd 1 # has to be wide enough for 8+1+5=14 text .names -yscrollcommand ".scroll set" -width 14 -height 1 \ - -font "*-bold-o-normal-*-120-*-m-*" -setgrid 1 + -font "*-bold-o-normal-*-120-*-m-*" -setgrid 1 .names tag configure nopassword -relief raised .names tag configure selection -relief raised set iscolor 0 if {[winfo depth .] > 1} { - set iscolor 1 + set iscolor 1 } if {$iscolor} { - .names tag configure nopassword -background red - .names tag configure selection -background green + .names tag configure nopassword -background red + .names tag configure selection -background green } else { - .names tag configure nopassword -background black -foreground white - .names tag configure selection -background white -foreground black + .names tag configure nopassword -background black -foreground white + .names tag configure selection -background white -foreground black } scrollbar .scroll -command ".names yview" -relief raised pack .scroll -in .users -side left -fill y pack .names -in .users -side left -fill y pack .users -expand 1 -fill y @@ -89,22 +89,22 @@ pack .password_set .generate_button -in .password_frame -side left -expand 1 -fill x -padx 2 -pady 2 pack .password_frame -fill x set dict_loaded 0 checkbutton .dict -text "test dictionary" -variable dict_check \ - -command {if !$dict_loaded load_dict} \ - -anchor w + -command {if {!$dict_loaded} load_dict} \ + -anchor w pack .dict -fill x -padx 2 -pady 2 button .quit -text quit -command exit button .help_button -text help -command help pack .quit .help_button -side left -expand 1 -fill x -padx 2 -pady 2 proc help {} { - if [catch {toplevel .help}] return - message .help.text -text \ + if {[catch {toplevel .help}]} return + message .help.text -text \ "tkpasswd - written by Don Libes, NIST, 10/1/93. Click on passwd (local users) or yppasswd (NIS users).\ Select user using mouse (or keys - see below).\ Enter password or press ^G to generate a random password.\ @@ -121,127 +121,125 @@ ^U clears password field.\ ^N and ^P select next/previous user.\ M-n and M-p select next/previous user with no password.\ (Users with no passwords are highlighted.)" - button .help.ok -text "ok" -command {destroy .help} - pack .help.text - pack .help.ok -fill x -padx 2 -pady 2 + button .help.ok -text "ok" -command {destroy .help} + pack .help.text + pack .help.ok -fill x -padx 2 -pady 2 } # get list of local users proc get_users {} { - global sort_cmd passwd_cmd - global nopasswords ;# line numbers of entries with no passwords - global last_line ;# last line of text box - global selection_line - - .names delete 1.0 end - - set file [open "|[lindex $passwd_cmd 1] $sort_cmd"] - set last_line 1 - set nopasswords {} - while {[gets $file buf] != -1} { - set buf [split $buf :] - if [llength $buf]>2 { - # normal password entry - .names insert end "[format "%-8.8s %5d" [lindex $buf 0] [lindex $buf 2]]\n" - if 0==[string compare [lindex $buf 1] ""] { - .names tag add nopassword \ - {end - 2 line linestart} \ - {end - 2 line lineend} - lappend nopasswords $last_line - } - } else { - # +name style entry - .names insert end "$buf\n" - } - incr last_line - } - incr last_line -1 - close $file - set selection_line 0 + global sort_cmd passwd_cmd + global nopasswords ;# line numbers of entries with no passwords + global last_line ;# last line of text box + global selection_line + + .names delete 1.0 end + + set file [open "|[lindex $passwd_cmd 1] $sort_cmd"] + set last_line 1 + set nopasswords {} + while {[gets $file buf] != -1} { + set buf [split $buf :] + if {[llength $buf]>2} { + # normal password entry + .names insert end "[format "%-8.8s %5d" [lindex $buf 0] [lindex $buf 2]]\n" + if {0==[string compare [lindex $buf 1] ""]} { + .names tag add nopassword \ + {end - 2 line linestart} \ + {end - 2 line lineend} + lappend nopasswords $last_line + } + } else { + # +name style entry + .names insert end "$buf\n" + } + incr last_line + } + incr last_line -1 + close $file + set selection_line 0 } proc feedback {msg} { - global password + global password - set password $msg - .password select from 0 - .password select to end - update + set password $msg + .password select from 0 + .password select to end + update } proc load_dict {} { - global dict dict_loaded - - feedback "loading dictionary..." - - if 0==[catch {open /usr/dict/words} file] { - rename set s - foreach w [split [read $file] "\n"] {s dict($w) ""} - close $file - rename s set - set dict_loaded 1 - feedback "dictionary loaded" - } else { - feedback "dictionary missing" - .dict deselect - } + global dict dict_loaded + + feedback "loading dictionary..." + + if {0==[catch {open /usr/dict/words} file]} { + foreach w [split [read $file] "\n"] {set dict($w) ""} + close $file + set dict_loaded 1 + feedback "dictionary loaded" + } else { + feedback "dictionary missing" + .dict deselect + } } # put whatever security checks you like in here proc weak_password {password} { - global dict dict_check - - if $dict_check { - feedback "checking password" - - if [info exists dict($password)] { - feedback "sorry - in dictionary" - return 1 - } - } - return 0 + global dict dict_check + + if {$dict_check} { + feedback "checking password" + + if {[info exists dict($password)]} { + feedback "sorry - in dictionary" + return 1 + } + } + return 0 } proc password_set {} { - global password passwd_cmd selection_line - - set new_password $password - - if {$selection_line==0} { - feedback "select a user first" - return - } - set user [lindex [.names get selection.first selection.last] 0] - - if [weak_password $password] return - - feedback "setting password . . ." - - set cmd [lindex $passwd_cmd 0] - spawn -noecho $cmd $user - log_user 0 - set last_msg "error in $cmd" - while 1 { - expect { - -nocase "old password:" { - exp_send "[get_old_password]\r" - } "assword*:" { - exp_send "$new_password\r" - } -re "(.*)\r\n" { - set last_msg $expect_out(1,string) - } eof break - } - } - set status [wait] - if [lindex $status 3]==0 { - feedback "set successfully" - } else { - feedback $last_msg - } + global password passwd_cmd selection_line + + set new_password $password + + if {$selection_line==0} { + feedback "select a user first" + return + } + set user [lindex [.names get selection.first selection.last] 0] + + if {[weak_password $password]} return + + feedback "setting password . . ." + + set cmd [lindex $passwd_cmd 0] + spawn -noecho $cmd $user + log_user 0 + set last_msg "error in $cmd" + while {1} { + expect { + -nocase "old password:" { + exp_send "[get_old_password]\r" + } "assword*:" { + exp_send "$new_password\r" + } -re "(.*)\r\n" { + set last_msg $expect_out(1,string) + } eof break + } + } + set status [wait] + if {[lindex $status 3]==0} { + feedback "set successfully" + } else { + feedback $last_msg + } } # defaults for generating passwords set length 9 set minnum 2 @@ -248,157 +246,152 @@ set minlower 5 set minupper 2 set distribute 0 proc parameter_filename {} { - set file .tkpasswd.rc - if [info exists env(DOTDIR)] { - set file "$env(DOTDIR)/$file" - } - return ~/$file + set file .tkpasswd.rc + if {[info exists env(DOTDIR)]} { + set file "$env(DOTDIR)/$file" + } + return ~/$file } catch {source [parameter_filename]} # save parameters in a file proc save_parameters {} { - global minnum minlower minupper length - - if [catch {open [parameter_filename] w} f] { - # should never happen, so don't bother with window code - puts "tkpasswd: could not write [parameter_filename]" - return - } - puts $f "# This is the .tkpasswd.rc file. Do not edit it by hand as" - puts $f "# it is automatically maintained by tkpasswd. Any manual" - puts $f "# modifications will be lost." - puts $f "" - puts $f "set length $length" - puts $f "set minnum $minnum" - puts $f "set minupper $minupper" - puts $f "set minlower $minlower" - close $f + global minnum minlower minupper length + + if {[catch {open [parameter_filename] w} f]} { + # should never happen, so don't bother with window code + puts "tkpasswd: could not write [parameter_filename]" + return + } + puts $f "# This is the .tkpasswd.rc file. Do not edit it by hand as" + puts $f "# it is automatically maintained by tkpasswd. Any manual" + puts $f "# modifications will be lost." + puts $f "" + puts $f "set length $length" + puts $f "set minnum $minnum" + puts $f "set minupper $minupper" + puts $f "set minlower $minlower" + close $f } # insert char into password at a random position proc insert {pvar char} { - upvar $pvar p + upvar $pvar p - set p [linsert $p [rand [expr 1+[llength $p]]] $char] + set p [linsert $p [rand [expr 1+[llength $p]]] $char] } # given a size, distribute between left and right hands # taking into account where we left off proc psplit {max lvar rvar} { - upvar $lvar left $rvar right - global isleft - - if {$isleft} { - set right [expr $max/2] - set left [expr $max-$right] - set isleft [expr !($max%2)] - } else { - set left [expr $max/2] - set right [expr $max-$left] - set isleft [expr $max%2] - } + upvar $lvar left $rvar right + global isleft + + if {$isleft} { + set right [expr $max/2] + set left [expr $max-$right] + set isleft [expr !($max%2)] + } else { + set left [expr $max/2] + set right [expr $max-$left] + set isleft [expr $max%2] + } } proc password_generate {} { - global password length minnum minlower minupper - global lpass rpass initially_left isleft - global distribute - - if {$distribute} { - set lkeys {q w e r t a s d f g z x c v b} - set rkeys {y u i o p h j k l n m} - set lnums {1 2 3 4 5 6} - set rnums {7 8 9 0} - } else { - set lkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} - set rkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} - set lnums {0 1 2 3 4 5 6 7 8 9} - set rnums {0 1 2 3 4 5 6 7 8 9} - } - set lkeys_length [llength $lkeys] - set rkeys_length [llength $rkeys] - set lnums_length [llength $lnums] - set rnums_length [llength $rnums] - - # if there is any underspecification, use additional lowercase letters - set minlower [expr $length - ($minnum + $minupper)] - - - set lpass "" ;# password chars typed by left hand - set rpass "" ;# password chars typed by right hand - set password "" ;# merged password - - # choose left or right starting hand - set initially_left [set isleft [rand 2]] - - psplit $minnum left right - for {set i 0} {$i<$left} {incr i} { - insert lpass [lindex $lnums [rand $lnums_length]] - } - for {set i 0} {$i<$right} {incr i} { - insert rpass [lindex $rnums [rand $rnums_length]] - } - - psplit $minlower left right - for {set i 0} {$i<$left} {incr i} { - insert lpass [lindex $lkeys [rand $lkeys_length]] - } - for {set i 0} {$i<$right} {incr i} { - insert rpass [lindex $rkeys [rand $rkeys_length]] - } - - psplit $minupper left right - for {set i 0} {$i<$left} {incr i} { - insert lpass [string toupper [lindex $lkeys [rand $lkeys_length]]] - } - for {set i 0} {$i<$right} {incr i} { - insert rpass [string toupper [lindex $rkeys [rand $rkeys_length]]] - } - - # merge results together - if {$initially_left} { - regexp "(\[^ ]*) *(.*)" "$lpass" x password lpass - while {[llength $lpass]} { - regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass - regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass - } - if {[llength $rpass]} { - append password $rpass - } - } else { - regexp "(\[^ ]*) *(.*)" "$rpass" x password rpass - while {[llength $rpass]} { - regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass - regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass - } - if {[llength $lpass]} { - append password $lpass - } - } -} - -set _ran [pid] -proc rand {m} { - global _ran - - set period 259200 - set _ran [expr ($_ran*7141 + 54773) % $period] - expr int($m*($_ran/double($period))) + global password length minnum minlower minupper + global lpass rpass initially_left isleft + global distribute + + if {$distribute} { + set lkeys {q w e r t a s d f g z x c v b} + set rkeys {y u i o p h j k l n m} + set lnums {1 2 3 4 5 6} + set rnums {7 8 9 0} + } else { + set lkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} + set rkeys {a b c d e f g h i j k l m n o p q r s t u v w x y z} + set lnums {0 1 2 3 4 5 6 7 8 9} + set rnums {0 1 2 3 4 5 6 7 8 9} + } + set lkeys_length [llength $lkeys] + set rkeys_length [llength $rkeys] + set lnums_length [llength $lnums] + set rnums_length [llength $rnums] + + # if there is any underspecification, use additional lowercase letters + set minlower [expr $length - ($minnum + $minupper)] + + + set lpass "" ;# password chars typed by left hand + set rpass "" ;# password chars typed by right hand + set password "" ;# merged password + + # choose left or right starting hand + set initially_left [set isleft [rand 2]] + + psplit $minnum left right + for {set i 0} {$i<$left} {incr i} { + insert lpass [lindex $lnums [rand $lnums_length]] + } + for {set i 0} {$i<$right} {incr i} { + insert rpass [lindex $rnums [rand $rnums_length]] + } + + psplit $minlower left right + for {set i 0} {$i<$left} {incr i} { + insert lpass [lindex $lkeys [rand $lkeys_length]] + } + for {set i 0} {$i<$right} {incr i} { + insert rpass [lindex $rkeys [rand $rkeys_length]] + } + + psplit $minupper left right + for {set i 0} {$i<$left} {incr i} { + insert lpass [string toupper [lindex $lkeys [rand $lkeys_length]]] + } + for {set i 0} {$i<$right} {incr i} { + insert rpass [string toupper [lindex $rkeys [rand $rkeys_length]]] + } + + # merge results together + if {$initially_left} { + regexp "(\[^ ]*) *(.*)" "$lpass" x password lpass + while {[llength $lpass]} { + regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass + regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass + } + if {[llength $rpass]} { + append password $rpass + } + } else { + regexp "(\[^ ]*) *(.*)" "$rpass" x password rpass + while {[llength $rpass]} { + regexp "(\[^ ]*) *(.*)" "$password$lpass" x password lpass + regexp "(\[^ ]*) *(.*)" "$password$rpass" x password rpass + } + if {[llength $lpass]} { + append password $lpass + } + } +} + +proc rand {m} { + expr {int($m*rand())} } proc gen_bad_args {msg} { - if ![llength [info commands .parameters.errmsg]] { - message .parameters.errmsg -aspect 300 - pack .parameters.errmsg - } - .parameters.errmsg configure -text "$msg\ -Please adjust the password generation arguments." + if {![llength [info commands .parameters.errmsg]]} { + message .parameters.errmsg -aspect 300 + pack .parameters.errmsg + } + .parameters.errmsg configure -text "$msg\ + Please adjust the password generation arguments." } # tell tab what window to move between set parm_tabList {} @@ -422,194 +415,184 @@ focus [lindex $list $i] } # adjust args used in password generation proc adjust_parameters {} { - global parm_tabList - set parm_tabList {} - - toplevel [set w .parameters] - -# wm title $w "" -# wm iconname $w "" - - message $w.text -aspect 300 -text \ + global parm_tabList + set parm_tabList {} + + toplevel [set w .parameters] + + message $w.text -aspect 300 -text \ "These parameters control generation of random passwords. It is not necessary to move the mouse into this window to operate it.\ Press to move to the next entry.\ Press or click the button when you are done." - foreach desc { - {length {total length}} - {minnum {minimum number of digits}} - {minupper {minimum number of uppercase letters}} - {minlower {minimum number of lowercase letters}}} { - set name [lindex $desc 0] - set text [lindex $desc 1] - frame $w.$name -bd 1 - entry $w.$name.entry -relief sunken -width 2 -textvar $name - bind $w.$name.entry "Tab \$parm_tabList" - bind $w.$name.entry "destroy_parm_window" - label $w.$name.text -text $text - pack $w.$name.entry -side left - pack $w.$name.text -side left - lappend parm_tabList $w.$name.entry - } - frame $w.2 -bd 1 - checkbutton $w.2.cb -text "alternate characters across hands" \ - -relief flat -variable distribute - pack $w.2.cb -side left - - button $w.ok -text "ok" -command "destroy_parm_window" - pack $w.text -expand 1 -fill x - pack $w.length $w.minnum $w.minupper $w.minlower $w.2 -expand 1 -fill x - pack $w.ok -side left -fill x -expand 1 -padx 2 -pady 2 - -#strace 10 - set oldfocus [focus] -# $w.length.entry icursor end - tkwait visibility $w.length.entry - focus $w.length.entry -# grab $w - tkwait window $w -# grab release $w - focus $oldfocus - -#strace 0 - - save_parameters + foreach desc { + {length {total length}} + {minnum {minimum number of digits}} + {minupper {minimum number of uppercase letters}} + {minlower {minimum number of lowercase letters}}} { + set name [lindex $desc 0] + set text [lindex $desc 1] + frame $w.$name -bd 1 + entry $w.$name.entry -relief sunken -width 2 -textvar $name + bind $w.$name.entry "Tab \$parm_tabList" + bind $w.$name.entry "destroy_parm_window" + label $w.$name.text -text $text + pack $w.$name.entry -side left + pack $w.$name.text -side left + lappend parm_tabList $w.$name.entry + } + frame $w.2 -bd 1 + checkbutton $w.2.cb -text "alternate characters across hands" \ + -relief flat -variable distribute + pack $w.2.cb -side left + + button $w.ok -text "ok" -command "destroy_parm_window" + pack $w.text -expand 1 -fill x + pack $w.length $w.minnum $w.minupper $w.minlower $w.2 -expand 1 -fill x + pack $w.ok -side left -fill x -expand 1 -padx 2 -pady 2 + + set oldfocus [focus] + tkwait visibility $w.length.entry + focus $w.length.entry + tkwait window $w + focus $oldfocus + save_parameters } proc isnumber {n} { - regexp "^\[0-9\]+$" $n + regexp "^\[0-9\]+$" $n } # destroy parm window IF all values are legal proc destroy_parm_window {} { - global minnum minlower minupper length - - set mustbe "must be a number greater than or equal to zero." - - # check all variables - if {![isnumber $length]} { - gen_bad_args "The total length $mustbe" - return - } - if {![isnumber $minlower]} { - gen_bad_args "The minimum number of lowercase characters $mustbe" - return - } - if {![isnumber $minupper]} { - gen_bad_args "The minimum number of uppercase characters $mustbe" - return - } - if {![isnumber $minnum]} { - gen_bad_args "The minimum number of digits $mustbe" - return - } - - # check constraints - if {$minnum + $minlower + $minupper > $length} { - gen_bad_args \ -"It is impossible to generate a $length-character password with\ -$minnum number[pluralize $minnum],\ -$minlower lowercase letter[pluralize $minlower], and\ -$minupper uppercase letter[pluralize $minupper]." - return - } - - destroy .parameters + global minnum minlower minupper length + + set mustbe "must be a number greater than or equal to zero." + + # check all variables + if {![isnumber $length]} { + gen_bad_args "The total length $mustbe" + return + } + if {![isnumber $minlower]} { + gen_bad_args "The minimum number of lowercase characters $mustbe" + return + } + if {![isnumber $minupper]} { + gen_bad_args "The minimum number of uppercase characters $mustbe" + return + } + if {![isnumber $minnum]} { + gen_bad_args "The minimum number of digits $mustbe" + return + } + + # check constraints + if {$minnum + $minlower + $minupper > $length} { + gen_bad_args \ + "It is impossible to generate a $length-character password with\ + $minnum number[pluralize $minnum],\ + $minlower lowercase letter[pluralize $minlower], and\ + $minupper uppercase letter[pluralize $minupper]." + return + } + + destroy .parameters } # return appropriate ending for a count of "n" nouns proc pluralize {n} { - expr $n!=1?"s":"" + expr $n!=1?"s":"" } proc get_old_password {} { - global old - - toplevel .old - label .old.label -text "Old password:" - catch {unset old} - entry .old.entry -textvar old -relief sunken -width 1 - - pack .old.label - pack .old.entry -fill x -padx 2 -pady 2 - - bind .old.entry {destroy .old} - set oldfocus [focus] - focus .old.entry - tkwait visibility .old - grab .old - tkwait window .old - focus $oldfocus - return $old + global old + + toplevel .old + label .old.label -text "Old password:" + catch {unset old} + entry .old.entry -textvar old -relief sunken -width 1 + + pack .old.label + pack .old.entry -fill x -padx 2 -pady 2 + + bind .old.entry {destroy .old} + set oldfocus [focus] + focus .old.entry + tkwait visibility .old + grab .old + tkwait window .old + focus $oldfocus + return $old } .unsorted select .passwd invoke proc make_selection {} { - global selection_line last_line - - .names tag remove selection 0.0 end - - # don't let selection go off top of screen - if {$selection_line < 1} { - set selection_line $last_line - } elseif {$selection_line > $last_line} { - set selection_line 1 - } - .names yview -pickplace [expr $selection_line-1] - .names tag add selection $selection_line.0 [expr 1+$selection_line].0 + global selection_line last_line + + .names tag remove selection 0.0 end + + # don't let selection go off top of screen + if {$selection_line < 1} { + set selection_line $last_line + } elseif {$selection_line > $last_line} { + set selection_line 1 + } + .names yview -pickplace [expr $selection_line-1] + .names tag add selection $selection_line.0 [expr 1+$selection_line].0 } proc select_next_nopassword {direction} { - global selection_line last_line - global nopasswords - - if 0==[llength $nopasswords] { - feedback "no null passwords" - return - } - - if $direction==1 { - # is there a better way to get last element of list? - if $selection_line>=[lindex $nopasswords [expr [llength $nopasswords]-1]] { - set selection_line 0 - } - foreach i $nopasswords { - if $selection_line<$i break - } - } else { - if $selection_line<=[lindex $nopasswords 0] { - set selection_line $last_line - } - set j [expr [llength $nopasswords]-1] - for {} {$j>=0} {incr j -1} { - set i [lindex $nopasswords $j] - if $selection_line>$i break - } - } - set selection_line $i - make_selection + global selection_line last_line + global nopasswords + + if {0==[llength $nopasswords]} { + feedback "no null passwords" + return + } + + if {$direction==1} { + # is there a better way to get last element of list? + if {$selection_line>=[lindex $nopasswords [expr [llength $nopasswords]-1]]} { + set selection_line 0 + } + foreach i $nopasswords { + if {$selection_line<$i} break + } + } else { + if {$selection_line<=[lindex $nopasswords 0]} { + set selection_line $last_line + } + set j [expr [llength $nopasswords]-1] + for {} {$j>=0} {incr j -1} { + set i [lindex $nopasswords $j] + if {$selection_line>$i} break + } + } + set selection_line $i + make_selection } proc select {w coords} { - global selection_line - - $w mark set insert "@$coords linestart" - $w mark set anchor insert - set first [$w index "anchor linestart"] - set last [$w index "insert lineend + 1c"] - scan $first %d selection_line - - $w tag remove selection 0.0 end - $w tag add selection $first $last + global selection_line + + $w mark set insert "@$coords linestart" + $w mark set anchor insert + set first [$w index "anchor linestart"] + set last [$w index "insert lineend + 1c"] + scan $first %d selection_line + + $w tag remove selection 0.0 end + $w tag add selection $first $last } bind Text <1> {select %W %x,%y} bind Text {select %W %x,%y} bind Text {select %W %x,%y} Index: example/tkterm ================================================================== --- example/tkterm +++ example/tkterm @@ -115,11 +115,11 @@ unset env(DISPLAY) set env(LINES) $rows set env(COLUMNS) $cols set env(TERM) "tt" -if $termcap { +if {$termcap} { set env(TERMCAP) {tt: :cm=\E[%d;%dH: :up=\E[A: :nd=\E[C: :cl=\E[H\E[J: @@ -136,11 +136,11 @@ :k8=\EOW: :k9=\EOX: } } -if $terminfo { +if {$terminfo} { set env(TERMINFO) /tmp set ttsrc "/tmp/tt.src" set file [open $ttsrc w] puts $file {tt|textterm|Don Libes' tk text widget terminal emulator, @@ -163,11 +163,11 @@ kf9=\EOX, } close $file set oldpath $env(PATH) - set env(PATH) "/usr/5bin:/usr/lib/terminfo" + set env(PATH) "$env(PATH):/usr/5bin:/usr/lib/terminfo" if 1==[catch {exec tic $ttsrc} msg] { puts "WARNING: tic failed - if you don't have terminfo support on" puts "your system, change \"set terminfo 1\" to \"set terminfo 0\"." puts "Here is the original error from running tic:" puts $msg @@ -269,11 +269,11 @@ set s [string range $s $chars_to_write end] # update cur_col incr cur_col $chars_to_write # update cur_row - if $newline { + if {$newline} { term_down } ################## # write full lines Index: example/unbuffer.man ================================================================== --- example/unbuffer.man +++ example/unbuffer.man @@ -25,10 +25,17 @@ .nf unbuffer od -c /tmp/fifo | more +.fi +When you have a pipeline, unbuffer must be applied to each element +except the last (since that doesn't have its output redirected). +Example: +.nf + + unbuffer p1 | unbuffer p2 | unbuffer p3 | p4 .fi .SH BUGS The man page is longer than the program. Index: example/virterm ================================================================== --- example/virterm +++ example/virterm @@ -77,11 +77,11 @@ set blankline "" set env(LINES) $rows set env(COLUMNS) $cols set env(TERM) "tt" -if $termcap { +if {$termcap} { set env(TERMCAP) {tt: :cm=\E[%d;%dH: :up=\E[A: :cl=\E[H\E[J: :do=^J: @@ -89,11 +89,11 @@ :se=\E[m: :nd=\E[C: } } -if $terminfo { +if {$terminfo} { set env(TERMINFO) /tmp set ttsrc "/tmp/tt.src" set file [open $ttsrc w] puts $file {tt|textterm|Don Libes' tk text widget terminal emulator, @@ -108,11 +108,11 @@ } close $file set oldpath $env(PATH) set env(PATH) "/usr/5bin:/usr/lib/terminfo" - if 1==[catch {exec tic $ttsrc} msg] { + if {1==[catch {exec tic $ttsrc} msg]} { puts "WARNING: tic failed - if you don't have terminfo support on" puts "your system, change \"set terminfo 1\" to \"set terminfo 0\"." puts "Here is the original error from running tic:" puts $msg } @@ -233,11 +233,11 @@ set s [string range $s $chars_to_write end] # update cur_col incr cur_col $chars_to_write # update cur_row - if $newline { + if {$newline} { term_down } ################## # write full lines @@ -323,11 +323,11 @@ proc term_expect {args} { global cur_row cur_col # used by expect_background actions set desired_timeout [ uplevel { - if [info exists timeout] { + if {[info exists timeout]} { set timeout } else { uplevel #0 { if {[info exists timeout]} { set timeout @@ -434,11 +434,11 @@ proc dosearch {search} { global term exp_send_error "Searching for '$search'..." - if [string match ?=* "$search"] {set typ ""} else {set typ "k="} + if {[string match ?=* "$search"]} {set typ ""} else {set typ "k="} sendcommand "$typ$search\r" waitfornext set countstr [$term get 2.17 2.35] if {![regsub { Entries Found *} $countstr "" number]} { set number 1 Index: example/weather ================================================================== --- example/weather +++ example/weather @@ -8,11 +8,11 @@ # argument is the National Weather Service designation for an area # I.e., WBC = Washington DC (oh yeah, that's obvious) exp_version -exit 5.0 -if $argc>0 {set code $argv} else {set code "WBC"} +if {$argc>0} {set code $argv} else {set code "WBC"} proc timedout {} { send_user "Weather server timed out. Try again later when weather server is not so busy.\n" exit 1 } @@ -22,17 +22,17 @@ set x [string first " ******" $s] return [join [lrange [split $s ""] 0 $x] ""] } set timeout 60 -log_user 0 +#log_user 0 set env(TERM) vt100 ;# actual value doesn't matter, just has to be set -spawn telnet downwind.sprl.umich.edu 3000 +spawn telnet cirrus.sprl.umich.edu 3000 match_max 100000 -for {} 1 {} { +while {1} { expect timeout { send_user "failed to contact weather server\n" exit } "Press Return to continue*" { # this prompt used sometimes, eg, upon opening connection @@ -59,11 +59,11 @@ send "1\r" expect timeout timedout "city code:" send "$code\r" expect $code ;# discard this -for {} 1 {} { +while {1} { expect timeout { timedout } "Press Return to continue*:*" { send_user "\n[delete_special $expect_out(buffer)]\n" send "\r" Index: example/xkibitz ================================================================== --- example/xkibitz +++ example/xkibitz @@ -5,204 +5,209 @@ # Compare with kibitz. # Author: Don Libes, NIST # Version: 1.2 proc help {} { - puts "Commands Meaning" - puts "-------- -------" - puts "return return to program" - puts "= list" - puts "+ add" - puts "- drop" - puts "where is an X display name such as nist.gov or nist.gov:0.0" - puts "and is a tag from the = command." - puts "+ and - require whitespace before argument." - puts {return command must be spelled out ("r", "e", "t", ...).} + puts "Commands Meaning" + puts "-------- -------" + puts "return return to program" + puts "= list" + puts "+ add" + puts "- drop" + puts "where is an X display name such as nist.gov or nist.gov:0.0" + puts "and is a tag from the = command." + puts "+ and - require whitespace before argument." + puts {return command must be spelled out ("r", "e", "t", ...).} } proc prompt1 {} { - return "xkibitz> " + return "xkibitz> " } proc h {} help proc ? {} help # disable history processing - there seems to be some incestuous relationship # between history and unknown in Tcl 8.0 proc history {args} {} proc unknown {args} { - puts "$args: invalid command" - help + puts "$args: invalid command" + help } set tag2pid(0) [pid] set pid2tty([pid]) "/dev/tty" -if [info exists env(DISPLAY)] { - set pid2display([pid]) $env(DISPLAY) +if {[info exists env(DISPLAY)]} { + set pid2display([pid]) $env(DISPLAY) } else { - set pid2display([pid]) "" + set pid2display([pid]) "" } # small int allowing user to more easily identify display # maxtag always points at highest in use set maxtag 0 proc + {display} { - global ids pid2display pid2tag tag2pid maxtag pid2sid - global pid2tty env - - if ![string match *:* $display] { - append display :0.0 - } - - if {![info exists env(XKIBITZ_XTERM_ARGS)]} { - set env(XKIBITZ_XTERM_ARGS) "" - } - - set dummy1 [open /dev/null] - set dummy2 [open /dev/null] - spawn -pty -noecho - close $dummy1 - close $dummy2 - - stty raw -echo < $spawn_out(slave,name) - # Linux needs additional stty, sounds like a bug in its stty to me. - # raw should imply this stuff, no? - stty -icrnl -icanon < $spawn_out(slave,name) - - regexp ".*(.)(.)" $spawn_out(slave,name) dummy c1 c2 - if {[string compare $c1 "/"] == 0} { - # On Pyramid and AIX, ttynames such as /dev/pts/1 - # requre suffix to be padded with a 0 - set c1 0 - } - - set pid [eval exec xterm \ - -display $display \ - -geometry [stty columns]x[stty rows] \ - -S$c1$c2$spawn_out(slave,fd) \ - $env(XKIBITZ_XTERM_ARGS) &] - close -slave - - # xterm first sends back window id, discard - log_user 0 - expect { - eof {wait;return} - \n - } - log_user 1 - - lappend ids $spawn_id - set pid2display($pid) $display - incr maxtag - set tag2pid($maxtag) $pid - set pid2tag($pid) $maxtag - set pid2sid($pid) $spawn_id - set pid2tty($pid) $spawn_out(slave,name) - return + global ids pid2display pid2tag tag2pid maxtag pid2sid + global pid2tty env + + if {![string match *:* $display]} { + append display :0.0 + } + + if {![info exists env(XKIBITZ_XTERM_ARGS)]} { + set env(XKIBITZ_XTERM_ARGS) "" + } + + set dummy1 [open /dev/null] + set dummy2 [open /dev/null] + spawn -pty -noecho + close $dummy1 + close $dummy2 + + stty raw -echo < $spawn_out(slave,name) + # Linux needs additional stty, sounds like a bug in its stty to me. + # raw should imply this stuff, no? + stty -icrnl -icanon < $spawn_out(slave,name) + + regexp ".*(.)(.)" $spawn_out(slave,name) dummy c1 c2 + if {[string compare $c1 "/"] == 0} { + # On Pyramid and AIX, ttynames such as /dev/pts/1 + # requre suffix to be padded with a 0 + set c1 0 + } + + set pid [eval exec xterm \ + -display $display \ + -geometry [stty columns]x[stty rows] \ + -S$c1$c2$spawn_out(slave,fd) \ + $env(XKIBITZ_XTERM_ARGS) &] + close -slave + + # xterm first sends back window id, discard + log_user 0 + expect { + eof {wait;return} + \n + } + log_user 1 + + lappend ids $spawn_id + set pid2display($pid) $display + incr maxtag + set tag2pid($maxtag) $pid + set pid2tag($pid) $maxtag + set pid2sid($pid) $spawn_id + set pid2tty($pid) $spawn_out(slave,name) + return } proc = {} { - global pid2display tag2pid pid2tty - - puts "Tag Size Display" - foreach tag [lsort -integer [array names tag2pid]] { - set pid $tag2pid($tag) - set tty $pid2tty($pid) - - puts [format "%3d [stty columns < $tty]x[stty rows < $tty] $pid2display($pid)" $tag] - } + global pid2display tag2pid pid2tty + + puts "Tag Size Display" + foreach tag [lsort -integer [array names tag2pid]] { + set pid $tag2pid($tag) + set tty $pid2tty($pid) + + puts [format "%3d [stty columns < $tty]x[stty rows < $tty] $pid2display($pid)" $tag] + } } proc - {tag} { - global tag2pid pid2tag pid2display maxtag ids pid2sid - global pid2tty - - if ![info exists tag2pid($tag)] { - puts "no such tag" - return - } - if {$tag == 0} { - puts "cannot drop self" - return - } - - set pid $tag2pid($tag) - - # close and remove spawn_id from list - set spawn_id $pid2sid($pid) - set index [lsearch $ids $spawn_id] - set ids [lreplace $ids $index $index] - - exec kill -9 $pid - close - wait - - unset tag2pid($tag) - unset pid2tag($pid) - unset pid2display($pid) - unset pid2sid($pid) - unset pid2tty($pid) - - # lower maxtag if possible - while {![info exists tag2pid($maxtag)]} { - incr maxtag -1 - } -} - -exit -onexit { - unset pid2display([pid]) ;# avoid killing self - - foreach pid [array names pid2display] { - catch {exec kill -9 $pid} - } + global tag2pid pid2tag pid2display maxtag ids pid2sid + global pid2tty + + if {![info exists tag2pid($tag)]} { + puts "no such tag" + return + } + if {$tag == 0} { + puts "cannot drop self" + return + } + + set pid $tag2pid($tag) + + # close and remove spawn_id from list + set spawn_id $pid2sid($pid) + set index [lsearch $ids $spawn_id] + set ids [lreplace $ids $index $index] + + exec kill -9 $pid + close + wait + + unset tag2pid($tag) + unset pid2tag($pid) + unset pid2display($pid) + unset pid2sid($pid) + unset pid2tty($pid) + + # lower maxtag if possible + while {![info exists tag2pid($maxtag)]} { + incr maxtag -1 + } +} + +rename exit exitReal + +proc exit {} { + global pid2display + + unset pid2display([pid]) ;# avoid killing self + + foreach pid [array names pid2display] { + catch {exec kill -9 $pid} + } + exitReal } trap exit HUP trap { - set r [stty rows] - set c [stty columns] - stty rows $r columns $c < $app_tty - foreach pid [array names pid2tty] { - if {$pid == [pid]} continue - stty rows $r columns $c < $pid2tty($pid) - } + set r [stty rows] + set c [stty columns] + stty rows $r columns $c < $app_tty + foreach pid [array names pid2tty] { + if {$pid == [pid]} continue + stty rows $r columns $c < $pid2tty($pid) + } } WINCH set escape \035 ;# control-right-bracket set escape_printable "^\]" -while [llength $argv]>0 { - set flag [lindex $argv 0] - switch -- $flag \ - "-escape" { - set escape [lindex $argv 1] - set escape_printable $escape - set argv [lrange $argv 2 end] - } "-display" { - + [lindex $argv 1] - set argv [lrange $argv 2 end] - } default { - break - } -} - -if [llength $argv]>0 { - eval spawn -noecho $argv -} else { - spawn -noecho $env(SHELL) +while {[llength $argv]>0} { + set flag [lindex $argv 0] + switch -- $flag \ + "-escape" { + set escape [lindex $argv 1] + set escape_printable $escape + set argv [lrange $argv 2 end] + } "-display" { + + [lindex $argv 1] + set argv [lrange $argv 2 end] + } default { + break + } +} + +if {[llength $argv]>0} { + eval spawn -noecho $argv +} else { + spawn -noecho $env(SHELL) } set prog $spawn_id set app_tty $spawn_out(slave,name) puts "Escape sequence is $escape_printable" interact { - -input $user_spawn_id -reset $escape { - puts "\nfor help enter: ? or h or help" - interpreter - } -output $prog - -input ids -output $prog - -input $prog -output $user_spawn_id -output ids + -input $user_spawn_id -reset $escape { + puts "\nfor help enter: ? or h or help" + interpreter -eof exit + } -output $prog + -input ids -output $prog + -input $prog eof exit -output $user_spawn_id -output ids } Index: example/xpstat ================================================================== --- example/xpstat +++ example/xpstat @@ -132,11 +132,11 @@ # if user presses "update" try to update screen immediately proc prod {x y} { global cat_spawn_id updateflag - if $updateflag { + if {$updateflag} { show-help $x $y "I heard you, gimme a break. I'm waiting for the xpilot server to respond..." } set updateflag 1 exp_send -i $cat_spawn_id "\r" @@ -144,12 +144,11 @@ proc display {host} { global world db alias max env set w .$host - #if 0==[llength [info com $w]] - if ![winfo exists $w] { + if {![winfo exists $w]} { # window does not exist, create it toplevel $w -class xpstat wm minsize $w 1 1 @@ -201,19 +200,19 @@ pack $w.help $w.update $w.play -side left pack $w.alias -side left -expand 1 -fill x set max($host,was) 0 } - if $max($host)==0 { + if {$max($host)==0} { # put up "no players" message? - if $max($host,was)>0 { + if {$max($host,was)>0} { pack $w.msg -after $w.world -fill x -side top pack forget $w.world } } else { # remove "no players" message? - if $max($host,was)==0 { + if {$max($host,was)==0} { pack $w.players -after $w.world -side top pack forget $w.msg } } @@ -235,17 +234,17 @@ set updateflag 0 ;# 1 if user pressed "update" button # look for desired alias in the .Xdefaults file set status [catch {exec egrep "xpilot.name:" [glob ~/.Xdefaults]} output] -if $status==0 { +if {$status==0} { regexp "xpilot.name:\[ \t]*(\[^\r]*)" $output dummy env(USER) } spawn cat -u; set cat_spawn_id $spawn_id -while 1 { +while {1} { global xpilot hosts set hosts {} eval spawn $xpilot $argv @@ -254,11 +253,11 @@ # clean up hosts that no longer are running xpilots foreach host $oldhosts { # if host not in hosts - if -1==[lsearch $hosts $host] { + if {-1==[lsearch $hosts $host]} { destroy .$host } } set oldhosts $hosts Index: example/xrlogin ================================================================== --- example/xrlogin +++ example/xrlogin @@ -13,10 +13,10 @@ catch {set prompt $env(EXPECT_PROMPT)} set timeout -1 eval spawn rlogin $argv expect eof exit -re $prompt -if [string match "unix:0.0" $env(DISPLAY)] { +if {[string match "unix:0.0" $env(DISPLAY)]} { set env(DISPLAY) "[exec hostname].[exec domainname]:0.0\r" } send "setenv DISPLAY $env(DISPLAY)\r" interact ADDED expTcl.c Index: expTcl.c ================================================================== --- /dev/null +++ expTcl.c ADDED expTcl.h Index: expTcl.h ================================================================== --- /dev/null +++ expTcl.h ADDED exp_chan.c Index: exp_chan.c ================================================================== --- /dev/null +++ exp_chan.c @@ -0,0 +1,557 @@ +/* + * tclUnixChan.c + * + * Channel driver for Expect channels. + * Based on UNIX File channel from TclUnixChan.c + * + */ + +#include +#include +#include +#include +#include /* for isspace */ +#include /* for time(3) */ + +#include "expect_cf.h" + +#ifdef HAVE_SYS_WAIT_H +#include +#endif + +#ifdef HAVE_UNISTD_H +# include +#endif + +#include "tclInt.h" /* Internal definitions for Tcl. */ + +#include "tcl.h" + +#include "string.h" + +#include "exp_rename.h" +#include "exp_prog.h" +#include "exp_command.h" +#include "exp_log.h" + +static int ExpCloseProc _ANSI_ARGS_((ClientData instanceData, + Tcl_Interp *interp)); +static int ExpInputProc _ANSI_ARGS_((ClientData instanceData, + char *buf, int toRead, int *errorCode)); +static int ExpOutputProc _ANSI_ARGS_(( + ClientData instanceData, char *buf, int toWrite, + int *errorCode)); +static void ExpWatchProc _ANSI_ARGS_((ClientData instanceData, + int mask)); +static int ExpGetHandleProc _ANSI_ARGS_((ClientData instanceData, + int direction, ClientData *handlePtr)); + +/* + * This structure describes the channel type structure for Expect-based IO: + */ + +Tcl_ChannelType expChannelType = { + "exp", /* Type name. */ + /* Expect channels are always blocking */ + NULL, /* Set blocking/nonblocking mode.*/ + ExpCloseProc, /* Close proc. */ + ExpInputProc, /* Input proc. */ + ExpOutputProc, /* Output proc. */ + NULL, /* Seek proc. */ + NULL, /* Set option proc. */ + NULL, /* Get option proc. */ + ExpWatchProc, /* Initialize notifier. */ + ExpGetHandleProc, /* Get OS handles out of channel. */ + NULL, /* Close2 proc */ +}; + +typedef struct ThreadSpecificData { + /* + * List of all exp channels currently open. This is per thread and is + * used to match up fd's to channels, which rarely occurs. + */ + + ExpState *firstExpPtr; + int channelCount; /* this is process-wide as it is used to + give user some hint as to why a spawn has failed + by looking at process-wide resource usage */ +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + + +/* + *---------------------------------------------------------------------- + * + * ExpInputProc -- + * + * This procedure is invoked from the generic IO level to read + * input from an exp-based channel. + * + * Results: + * The number of bytes read is returned or -1 on error. An output + * argument contains a POSIX error code if an error occurs, or zero. + * + * Side effects: + * Reads input from the input device of the channel. + * + *---------------------------------------------------------------------- + */ + +static int +ExpInputProc(instanceData, buf, toRead, errorCodePtr) + ClientData instanceData; /* Exp state. */ + char *buf; /* Where to store data read. */ + int toRead; /* How much space is available + * in the buffer? */ + int *errorCodePtr; /* Where to store error code. */ +{ + ExpState *esPtr = (ExpState *) instanceData; + int bytesRead; /* How many bytes were actually + * read from the input device? */ + + *errorCodePtr = 0; + + /* + * Assume there is always enough input available. This will block + * appropriately, and read will unblock as soon as a short read is + * possible, if the channel is in blocking mode. If the channel is + * nonblocking, the read will never block. + */ + + bytesRead = read(esPtr->fdin, buf, (size_t) toRead); + /*printf("ExpInputProc: read(%d,,) = %d\r\n",esPtr->fdin,bytesRead);*/ + if (bytesRead > -1) { + /* strip parity if requested */ + if (esPtr->parity == 0) { + char *end = buf+bytesRead; + for (;buf < end;buf++) { + *buf &= 0x7f; + } + } + return bytesRead; + } + *errorCodePtr = errno; + return -1; +} + +/* + *---------------------------------------------------------------------- + * + * ExpOutputProc-- + * + * This procedure is invoked from the generic IO level to write + * output to an exp channel. + * + * Results: + * The number of bytes written is returned or -1 on error. An + * output argument contains a POSIX error code if an error occurred, + * or zero. + * + * Side effects: + * Writes output on the output device of the channel. + * + *---------------------------------------------------------------------- + */ + +static int +ExpOutputProc(instanceData, buf, toWrite, errorCodePtr) + ClientData instanceData; /* Exp state. */ + char *buf; /* The data buffer. */ + int toWrite; /* How many bytes to write? */ + int *errorCodePtr; /* Where to store error code. */ +{ + ExpState *esPtr = (ExpState *) instanceData; + int written = 0; + + *errorCodePtr = 0; + + if (toWrite < 0) Tcl_Panic("ExpOutputProc: called with negative char count"); + + while (toWrite > 0) { + written = write(esPtr->fdout, buf, (size_t) toWrite); + if (written == 0) { + /* This shouldn't happen but I'm told that it does + * nonetheless (at least on SunOS 4.1.3). Since this is + * not a documented return value, the most reasonable + * thing is to complain here and retry in the hopes that + * it is some transient condition. */ + sleep(1); + expDiagLogU("write() failed to write anything - will sleep(1) and retry...\n"); + } else if (written < 0) { + *errorCodePtr = errno; + return -1; + } + buf += written; + toWrite -= written; + } + return written; +} + +/* + *---------------------------------------------------------------------- + * + * ExpCloseProc -- + * + * This procedure is called from the generic IO level to perform + * channel-type-specific cleanup when an exp-based channel is closed. + * + * Results: + * 0 if successful, errno if failed. + * + * Side effects: + * Closes the device of the channel. + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +ExpCloseProc(instanceData, interp) + ClientData instanceData; /* Exp state. */ + Tcl_Interp *interp; /* For error reporting - unused. */ +{ + ExpState *esPtr = (ExpState *) instanceData; + ExpState **nextPtrPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + esPtr->registered = FALSE; + +#if 0 + /* + Really should check that we created one first. Since we're sharing fds + with Tcl, perhaps a filehandler was created with a plain tcl file - we + wouldn't want to delete that. Although if user really close Expect's + user_spawn_id, it probably doesn't matter anyway. + */ + + Tcl_DeleteFileHandler(esPtr->fdin); +#endif /*0*/ + + Tcl_DecrRefCount(esPtr->buffer); + + /* Actually file descriptor should have been closed earlier. */ + /* So do nothing here */ + + /* + * Conceivably, the process may not yet have been waited for. If this + * becomes a requirement, we'll have to revisit this code. But for now, if + * it's just Tcl exiting, the processes will exit on their own soon + * anyway. + */ + + for (nextPtrPtr = &(tsdPtr->firstExpPtr); (*nextPtrPtr) != NULL; + nextPtrPtr = &((*nextPtrPtr)->nextPtr)) { + if ((*nextPtrPtr) == esPtr) { + (*nextPtrPtr) = esPtr->nextPtr; + break; + } + } + tsdPtr->channelCount--; + + if (esPtr->bg_status == blocked || + esPtr->bg_status == disarm_req_while_blocked) { + esPtr->freeWhenBgHandlerUnblocked = 1; + /* + * If we're in the middle of a bg event handler, then the event + * handler will have to take care of freeing esPtr. + */ + } else { + expStateFree(esPtr); + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * ExpWatchProc -- + * + * Initialize the notifier to watch the fd from this channel. + * + * Results: + * None. + * + * Side effects: + * Sets up the notifier so that a future event on the channel will + * be seen by Tcl. + * + *---------------------------------------------------------------------- + */ + +static void +ExpWatchProc(instanceData, mask) + ClientData instanceData; /* The exp state. */ + int mask; /* Events of interest; an OR-ed + * combination of TCL_READABLE, + * TCL_WRITABLE and TCL_EXCEPTION. */ +{ + ExpState *esPtr = (ExpState *) instanceData; + + /* + * Make sure we only register for events that are valid on this exp. + * Note that we are passing Tcl_NotifyChannel directly to + * Tcl_CreateExpHandler with the channel pointer as the client data. + */ + + mask &= esPtr->validMask; + if (mask) { + /*printf(" CreateFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/ + Tcl_CreateFileHandler(esPtr->fdin, mask, + (Tcl_FileProc *) Tcl_NotifyChannel, + (ClientData) esPtr->channel); + } else { + /*printf(" DeleteFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/ + Tcl_DeleteFileHandler(esPtr->fdin); + } +} + +/* + *---------------------------------------------------------------------- + * + * ExpGetHandleProc -- + * + * Called from Tcl_GetChannelHandle to retrieve OS handles from + * an exp-based channel. + * + * Results: + * Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if + * there is no handle for the specified direction. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpGetHandleProc(instanceData, direction, handlePtr) + ClientData instanceData; /* The exp state. */ + int direction; /* TCL_READABLE or TCL_WRITABLE */ + ClientData *handlePtr; /* Where to store the handle. */ +{ + ExpState *esPtr = (ExpState *) instanceData; + + if (direction & TCL_WRITABLE) { + *handlePtr = (ClientData) esPtr->fdin; + } + if (direction & TCL_READABLE) { + *handlePtr = (ClientData) esPtr->fdin; + } else { + return TCL_ERROR; + } + return TCL_OK; +} + +int +expChannelCountGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->channelCount; +} + +int +expSizeGet(esPtr) + ExpState *esPtr; +{ + int len; + Tcl_GetStringFromObj(esPtr->buffer,&len); + return len; +} + +int +expSizeZero(esPtr) + ExpState *esPtr; +{ + int len; + Tcl_GetStringFromObj(esPtr->buffer,&len); + return (len == 0); +} + +void +expStateFree(esPtr) + ExpState *esPtr; +{ + if (esPtr->fdBusy) { + close(esPtr->fdin); + } + + esPtr->valid = FALSE; + + if (!esPtr->keepForever) { + ckfree((char *)esPtr); + } +} + +/* close all connections + * + * The kernel would actually do this by default, however Tcl is going to come + * along later and try to reap its exec'd processes. If we have inherited any + * via spawn -open, Tcl can hang if we don't close the connections first. + */ +void +exp_close_all(interp) +Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ExpState *esPtr; + + /* no need to keep things in sync (i.e., tsdPtr, count) since we could only + be doing this if we're exiting. Just close everything down. */ + + for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) { + exp_close(interp,esPtr); + } +} + +/* wait for any of our own spawned processes we call waitpid rather + * than wait to avoid running into someone else's processes. Yes, + * according to Ousterhout this is the best way to do it. + * returns the ExpState or 0 if nothing to wait on */ +ExpState * +expWaitOnAny() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int result; + ExpState *esPtr; + + for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) { + if (esPtr->pid == exp_getpid) continue; /* skip ourself */ + if (esPtr->user_waited) continue; /* one wait only! */ + if (esPtr->sys_waited) break; + restart: + result = waitpid(esPtr->pid,&esPtr->wait,WNOHANG); + if (result == esPtr->pid) break; + if (result == 0) continue; /* busy, try next */ + if (result == -1) { + if (errno == EINTR) goto restart; + else break; + } + } + return esPtr; +} + +ExpState * +expWaitOnOne() { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ExpState *esPtr; + int pid; + /* should really be recoded using the common wait code in command.c */ + WAIT_STATUS_TYPE status; + + pid = wait(&status); + for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) { + if (esPtr->pid == pid) { + esPtr->sys_waited = TRUE; + esPtr->wait = status; + return esPtr; + } + } +} + +void +exp_background_channelhandlers_run_all() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ExpState *esPtr; + + /* kick off any that already have input waiting */ + for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) { + /* is bg_interp the best way to check if armed? */ + if (esPtr->bg_interp && !expSizeZero(esPtr)) { + exp_background_channelhandler((ClientData)esPtr,0); + } + } +} + +ExpState * +expCreateChannel(interp,fdin,fdout,pid) + Tcl_Interp *interp; + int fdin; + int fdout; + int pid; +{ + ExpState *esPtr; + int mask; + Tcl_ChannelType *channelTypePtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + channelTypePtr = &expChannelType; + + esPtr = (ExpState *) ckalloc((unsigned) sizeof(ExpState)); + + esPtr->nextPtr = tsdPtr->firstExpPtr; + tsdPtr->firstExpPtr = esPtr; + + sprintf(esPtr->name,"exp%d",fdin); + + /* + * For now, stupidly assume this. We we will likely have to revisit this + * later to prevent people from doing stupid things. + */ + mask = TCL_READABLE | TCL_WRITABLE; + + /* not sure about this - what about adopted channels */ + esPtr->validMask = mask | TCL_EXCEPTION; + esPtr->fdin = fdin; + esPtr->fdout = fdout; + + /* set close-on-exec for everything but std channels */ + /* (system and stty commands need access to std channels) */ + if (fdin != 0 && fdin != 2) { + expCloseOnExec(fdin); + if (fdin != fdout) expCloseOnExec(fdout); + } + + esPtr->fdBusy = FALSE; + esPtr->channel = Tcl_CreateChannel(channelTypePtr, esPtr->name, + (ClientData) esPtr, mask); + Tcl_RegisterChannel(interp,esPtr->channel); + esPtr->registered = TRUE; + Tcl_SetChannelOption(interp,esPtr->channel,"-buffering","none"); + Tcl_SetChannelOption(interp,esPtr->channel,"-blocking","0"); + Tcl_SetChannelOption(interp,esPtr->channel,"-translation","lf"); + + esPtr->pid = pid; + esPtr->msize = 0; + + /* initialize a dummy buffer */ + esPtr->buffer = Tcl_NewStringObj("",0); + Tcl_IncrRefCount(esPtr->buffer); + esPtr->umsize = exp_default_match_max; + /* this will reallocate object with an appropriate sized buffer */ + expAdjust(esPtr); + + esPtr->printed = 0; + esPtr->echoed = 0; + esPtr->rm_nulls = exp_default_rm_nulls; + esPtr->parity = exp_default_parity; + esPtr->key = expect_key++; + esPtr->force_read = FALSE; + esPtr->fg_armed = FALSE; + esPtr->channel_orig = 0; + esPtr->fd_slave = EXP_NOFD; +#ifdef HAVE_PTYTRAP + esPtr->slave_name = 0; +#endif /* HAVE_PTYTRAP */ + esPtr->open = TRUE; + esPtr->notified = FALSE; + esPtr->user_waited = FALSE; + esPtr->sys_waited = FALSE; + esPtr->bg_interp = 0; + esPtr->bg_status = unarmed; + esPtr->bg_ecount = 0; + esPtr->freeWhenBgHandlerUnblocked = FALSE; + esPtr->keepForever = FALSE; + esPtr->valid = TRUE; + tsdPtr->channelCount++; + + return esPtr; +} + +void +expChannelInit() { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->channelCount = 0; +} Index: exp_clib.c ================================================================== --- exp_clib.c +++ exp_clib.c @@ -53,22 +53,2104 @@ #include /*#include - deprecated - ANSI C moves them into string.h */ #include "string.h" #include -#include "exp_rename.h" -#define EXP_AVOID_INCLUDING_TCL_H -#include "expect.h" -#include "exp_int.h" - -#include "exp_printify.h" #ifdef NO_STDLIB_H -#include "../compat/stdlib.h" + +/* + * Tcl's compat/stdlib.h + */ + +/* + * stdlib.h -- + * + * Declares facilities exported by the "stdlib" portion of + * the C library. This file isn't complete in the ANSI-C + * sense; it only declares things that are needed by Tcl. + * This file is needed even on many systems with their own + * stdlib.h (e.g. SunOS) because not all stdlib.h files + * declare all the procedures needed here (such as strtod). + * + * Copyright (c) 1991 The Regents of the University of California. + * Copyright (c) 1994 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: exp_clib.c,v 5.28.1.1.2.13 1999/12/22 17:45:57 libes Exp $ + */ + +#ifndef _STDLIB +#define _STDLIB + +#include + +extern void abort _ANSI_ARGS_((void)); +extern double atof _ANSI_ARGS_((CONST char *string)); +extern int atoi _ANSI_ARGS_((CONST char *string)); +extern long atol _ANSI_ARGS_((CONST char *string)); +extern char * calloc _ANSI_ARGS_((unsigned int numElements, + unsigned int size)); +extern void exit _ANSI_ARGS_((int status)); +extern int free _ANSI_ARGS_((char *blockPtr)); +extern char * getenv _ANSI_ARGS_((CONST char *name)); +extern char * malloc _ANSI_ARGS_((unsigned int numBytes)); +extern void qsort _ANSI_ARGS_((VOID *base, int n, int size, + int (*compar)(CONST VOID *element1, CONST VOID + *element2))); +extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes)); +extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr)); +extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr, + int base)); +extern unsigned long strtoul _ANSI_ARGS_((CONST char *string, + char **endPtr, int base)); + +#endif /* _STDLIB */ + +/* + * end of Tcl's compat/stdlib.h + */ + #else #include /* for malloc */ #endif + +#include "expect.h" +#define TclRegError exp_TclRegError + +/* + * regexp code - from tcl8.0.4/generic/regexp.c + */ + +/* + * TclRegComp and TclRegExec -- TclRegSub is elsewhere + * + * Copyright (c) 1986 by University of Toronto. + * Written by Henry Spencer. Not derived from licensed software. + * + * Permission is granted to anyone to use this software for any + * purpose on any computer system, and to redistribute it freely, + * subject to the following restrictions: + * + * 1. The author is not responsible for the consequences of use of + * this software, no matter how awful, even if they arise + * from defects in it. + * + * 2. The origin of this software must not be misrepresented, either + * by explicit claim or by omission. + * + * 3. Altered versions must be plainly marked as such, and must not + * be misrepresented as being the original software. + * + * Beware that some of this code is subtly aware of the way operator + * precedence is structured in regular expressions. Serious changes in + * regular-expression syntax might require a total rethink. + * + * *** NOTE: this code has been altered slightly for use in Tcl: *** + * *** 1. Use ckalloc and ckfree instead of malloc and free. *** + * *** 2. Add extra argument to regexp to specify the real *** + * *** start of the string separately from the start of the *** + * *** current search. This is needed to search for multiple *** + * *** matches within a string. *** + * *** 3. Names have been changed, e.g. from regcomp to *** + * *** TclRegComp, to avoid clashes with other *** + * *** regexp implementations used by applications. *** + * *** 4. Added errMsg declaration and TclRegError procedure *** + * *** 5. Various lint-like things, such as casting arguments *** + * *** in procedure calls. *** + * + * *** NOTE: This code has been altered for use in MT-Sturdy Tcl *** + * *** 1. All use of static variables has been changed to access *** + * *** fields of a structure. *** + * *** 2. This in addition to changes to TclRegError makes the *** + * *** code multi-thread safe. *** + * + * RCS: @(#) $Id: exp_clib.c,v 5.28.1.1.2.13 1999/12/22 17:45:57 libes Exp $ + */ + +#if 0 +#include "tclInt.h" +#include "tclPort.h" +#endif + +/* + * The variable below is set to NULL before invoking regexp functions + * and checked after those functions. If an error occurred then TclRegError + * will set the variable to point to a (static) error message. This + * mechanism unfortunately does not support multi-threading, but the + * procedures TclRegError and TclGetRegError can be modified to use + * thread-specific storage for the variable and thereby make the code + * thread-safe. + */ + +static char *errMsg = NULL; + +/* + * The "internal use only" fields in regexp.h are present to pass info from + * compile to execute that permits the execute phase to run lots faster on + * simple cases. They are: + * + * regstart char that must begin a match; '\0' if none obvious + * reganch is the match anchored (at beginning-of-line only)? + * regmust string (pointer into program) that match must include, or NULL + * regmlen length of regmust string + * + * Regstart and reganch permit very fast decisions on suitable starting points + * for a match, cutting down the work a lot. Regmust permits fast rejection + * of lines that cannot possibly match. The regmust tests are costly enough + * that TclRegComp() supplies a regmust only if the r.e. contains something + * potentially expensive (at present, the only such thing detected is * or + + * at the start of the r.e., which can involve a lot of backup). Regmlen is + * supplied because the test in TclRegExec() needs it and TclRegComp() is + * computing it anyway. + */ + +/* + * Structure for regexp "program". This is essentially a linear encoding + * of a nondeterministic finite-state machine (aka syntax charts or + * "railroad normal form" in parsing technology). Each node is an opcode + * plus a "next" pointer, possibly plus an operand. "Next" pointers of + * all nodes except BRANCH implement concatenation; a "next" pointer with + * a BRANCH on both ends of it is connecting two alternatives. (Here we + * have one of the subtle syntax dependencies: an individual BRANCH (as + * opposed to a collection of them) is never concatenated with anything + * because of operator precedence.) The operand of some types of node is + * a literal string; for others, it is a node leading into a sub-FSM. In + * particular, the operand of a BRANCH node is the first node of the branch. + * (NB this is *not* a tree structure: the tail of the branch connects + * to the thing following the set of BRANCHes.) The opcodes are: + */ + +/* definition number opnd? meaning */ +#define END 0 /* no End of program. */ +#define BOL 1 /* no Match "" at beginning of line. */ +#define EOL 2 /* no Match "" at end of line. */ +#define ANY 3 /* no Match any one character. */ +#define ANYOF 4 /* str Match any character in this string. */ +#define ANYBUT 5 /* str Match any character not in this string. */ +#define BRANCH 6 /* node Match this alternative, or the next... */ +#define BACK 7 /* no Match "", "next" ptr points backward. */ +#define EXACTLY 8 /* str Match this string. */ +#define NOTHING 9 /* no Match empty string. */ +#define STAR 10 /* node Match this (simple) thing 0 or more times. */ +#define PLUS 11 /* node Match this (simple) thing 1 or more times. */ +#define OPEN 20 /* no Mark this point in input as start of #n. */ + /* OPEN+1 is number 1, etc. */ +#define CLOSE (OPEN+NSUBEXP) /* no Analogous to OPEN. */ + +/* + * Opcode notes: + * + * BRANCH The set of branches constituting a single choice are hooked + * together with their "next" pointers, since precedence prevents + * anything being concatenated to any individual branch. The + * "next" pointer of the last BRANCH in a choice points to the + * thing following the whole choice. This is also where the + * final "next" pointer of each individual branch points; each + * branch starts with the operand node of a BRANCH node. + * + * BACK Normal "next" pointers all implicitly point forward; BACK + * exists to make loop structures possible. + * + * STAR,PLUS '?', and complex '*' and '+', are implemented as circular + * BRANCH structures using BACK. Simple cases (one character + * per match) are implemented with STAR and PLUS for speed + * and to minimize recursive plunges. + * + * OPEN,CLOSE ...are numbered at compile time. + */ + +/* + * A node is one char of opcode followed by two chars of "next" pointer. + * "Next" pointers are stored as two 8-bit pieces, high order first. The + * value is a positive offset from the opcode of the node containing it. + * An operand, if any, simply follows the node. (Note that much of the + * code generation knows about this implicit relationship.) + * + * Using two bytes for the "next" pointer is vast overkill for most things, + * but allows patterns to get big without disasters. + */ +#define OP(p) (*(p)) +#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377)) +#define OPERAND(p) ((p) + 3) + +/* + * See regmagic.h for one further detail of program structure. + */ + + +/* + * Utility definitions. + */ +#ifndef CHARBITS +#define UCHARAT(p) ((int)*(unsigned char *)(p)) +#else +#define UCHARAT(p) ((int)*(p)&CHARBITS) +#endif + +#define FAIL(m) { TclRegError(m); return(NULL); } +#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?') +#define META "^$.[()|?+*\\" + +/* + * Flags to be passed up and down. + */ +#define HASWIDTH 01 /* Known never to match null string. */ +#define SIMPLE 02 /* Simple enough to be STAR/PLUS operand. */ +#define SPSTART 04 /* Starts with * or +. */ +#define WORST 0 /* Worst case. */ + +/* + * Global work variables for TclRegComp(). + */ +struct regcomp_state { + char *regparse; /* Input-scan pointer. */ + int regnpar; /* () count. */ + char *regcode; /* Code-emit pointer; ®dummy = don't. */ + long regsize; /* Code size. */ +}; + +static char regdummy; + +/* + * The first byte of the regexp internal "program" is actually this magic + * number; the start node begins in the second byte. + */ +#define MAGIC 0234 + + +/* + * Forward declarations for TclRegComp()'s friends. + */ + +static char * reg _ANSI_ARGS_((int paren, int *flagp, + struct regcomp_state *rcstate)); +static char * regatom _ANSI_ARGS_((int *flagp, + struct regcomp_state *rcstate)); +static char * regbranch _ANSI_ARGS_((int *flagp, + struct regcomp_state *rcstate)); +static void regc _ANSI_ARGS_((int b, + struct regcomp_state *rcstate)); +static void reginsert _ANSI_ARGS_((int op, char *opnd, + struct regcomp_state *rcstate)); +static char * regnext _ANSI_ARGS_((char *p)); +static char * regnode _ANSI_ARGS_((int op, + struct regcomp_state *rcstate)); +static void regoptail _ANSI_ARGS_((char *p, char *val)); +static char * regpiece _ANSI_ARGS_((int *flagp, + struct regcomp_state *rcstate)); +static void regtail _ANSI_ARGS_((char *p, char *val)); + +#ifdef STRCSPN +static int strcspn _ANSI_ARGS_((char *s1, char *s2)); +#endif + +/* + - TclRegComp - compile a regular expression into internal code + * + * We can't allocate space until we know how big the compiled form will be, + * but we can't compile it (and thus know how big it is) until we've got a + * place to put the code. So we cheat: we compile it twice, once with code + * generation turned off and size counting turned on, and once "for real". + * This also means that we don't allocate space until we are sure that the + * thing really will compile successfully, and we never have to move the + * code and thus invalidate pointers into it. (Note that it has to be in + * one piece because free() must be able to free it all.) + * + * Beware that the optimization-preparation code in here knows about some + * of the structure of the compiled regexp. + */ +regexp * +TclRegComp(exp) +char *exp; +{ + register regexp *r; + register char *scan; + register char *longest; + register int len; + int flags; + struct regcomp_state state; + struct regcomp_state *rcstate= &state; + + if (exp == NULL) + FAIL("NULL argument"); + + /* First pass: determine size, legality. */ + rcstate->regparse = exp; + rcstate->regnpar = 1; + rcstate->regsize = 0L; + rcstate->regcode = ®dummy; + regc(MAGIC, rcstate); + if (reg(0, &flags, rcstate) == NULL) + return(NULL); + + /* Small enough for pointer-storage convention? */ + if (rcstate->regsize >= 32767L) /* Probably could be 65535L. */ + FAIL("regexp too big"); + + /* Allocate space. */ + r = (regexp *)ckalloc(sizeof(regexp) + (unsigned)rcstate->regsize); + if (r == NULL) + FAIL("out of space"); + + /* Second pass: emit code. */ + rcstate->regparse = exp; + rcstate->regnpar = 1; + rcstate->regcode = r->program; + regc(MAGIC, rcstate); + if (reg(0, &flags, rcstate) == NULL) + return(NULL); + + /* Dig out information for optimizations. */ + r->regstart = '\0'; /* Worst-case defaults. */ + r->reganch = 0; + r->regmust = NULL; + r->regmlen = 0; + scan = r->program+1; /* First BRANCH. */ + if (OP(regnext(scan)) == END) { /* Only one top-level choice. */ + scan = OPERAND(scan); + + /* Starting-point info. */ + if (OP(scan) == EXACTLY) + r->regstart = *OPERAND(scan); + else if (OP(scan) == BOL) + r->reganch++; + + /* + * If there's something expensive in the r.e., find the + * longest literal string that must appear and make it the + * regmust. Resolve ties in favor of later strings, since + * the regstart check works with the beginning of the r.e. + * and avoiding duplication strengthens checking. Not a + * strong reason, but sufficient in the absence of others. + */ + if (flags&SPSTART) { + longest = NULL; + len = 0; + for (; scan != NULL; scan = regnext(scan)) + if (OP(scan) == EXACTLY && ((int) strlen(OPERAND(scan))) >= len) { + longest = OPERAND(scan); + len = strlen(OPERAND(scan)); + } + r->regmust = longest; + r->regmlen = len; + } + } + + return(r); +} + +/* + - reg - regular expression, i.e. main body or parenthesized thing + * + * Caller must absorb opening parenthesis. + * + * Combining parenthesis handling with the base level of regular expression + * is a trifle forced, but the need to tie the tails of the branches to what + * follows makes it hard to avoid. + */ +static char * +reg(paren, flagp, rcstate) +int paren; /* Parenthesized? */ +int *flagp; +struct regcomp_state *rcstate; +{ + register char *ret; + register char *br; + register char *ender; + register int parno = 0; + int flags; + + *flagp = HASWIDTH; /* Tentatively. */ + + /* Make an OPEN node, if parenthesized. */ + if (paren) { + if (rcstate->regnpar >= NSUBEXP) + FAIL("too many ()"); + parno = rcstate->regnpar; + rcstate->regnpar++; + ret = regnode(OPEN+parno,rcstate); + } else + ret = NULL; + + /* Pick up the branches, linking them together. */ + br = regbranch(&flags,rcstate); + if (br == NULL) + return(NULL); + if (ret != NULL) + regtail(ret, br); /* OPEN -> first. */ + else + ret = br; + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + while (*rcstate->regparse == '|') { + rcstate->regparse++; + br = regbranch(&flags,rcstate); + if (br == NULL) + return(NULL); + regtail(ret, br); /* BRANCH -> BRANCH. */ + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + } + + /* Make a closing node, and hook it on the end. */ + ender = regnode((paren) ? CLOSE+parno : END,rcstate); + regtail(ret, ender); + + /* Hook the tails of the branches to the closing node. */ + for (br = ret; br != NULL; br = regnext(br)) + regoptail(br, ender); + + /* Check for proper termination. */ + if (paren && *rcstate->regparse++ != ')') { + FAIL("unmatched ()"); + } else if (!paren && *rcstate->regparse != '\0') { + if (*rcstate->regparse == ')') { + FAIL("unmatched ()"); + } else + FAIL("junk on end"); /* "Can't happen". */ + /* NOTREACHED */ + } + + return(ret); +} + +/* + - regbranch - one alternative of an | operator + * + * Implements the concatenation operator. + */ +static char * +regbranch(flagp, rcstate) +int *flagp; +struct regcomp_state *rcstate; +{ + register char *ret; + register char *chain; + register char *latest; + int flags; + + *flagp = WORST; /* Tentatively. */ + + ret = regnode(BRANCH,rcstate); + chain = NULL; + while (*rcstate->regparse != '\0' && *rcstate->regparse != '|' && + *rcstate->regparse != ')') { + latest = regpiece(&flags, rcstate); + if (latest == NULL) + return(NULL); + *flagp |= flags&HASWIDTH; + if (chain == NULL) /* First piece. */ + *flagp |= flags&SPSTART; + else + regtail(chain, latest); + chain = latest; + } + if (chain == NULL) /* Loop ran zero times. */ + (void) regnode(NOTHING,rcstate); + + return(ret); +} + +/* + - regpiece - something followed by possible [*+?] + * + * Note that the branching code sequences used for ? and the general cases + * of * and + are somewhat optimized: they use the same NOTHING node as + * both the endmarker for their branch list and the body of the last branch. + * It might seem that this node could be dispensed with entirely, but the + * endmarker role is not redundant. + */ +static char * +regpiece(flagp, rcstate) +int *flagp; +struct regcomp_state *rcstate; +{ + register char *ret; + register char op; + register char *next; + int flags; + + ret = regatom(&flags,rcstate); + if (ret == NULL) + return(NULL); + + op = *rcstate->regparse; + if (!ISMULT(op)) { + *flagp = flags; + return(ret); + } + + if (!(flags&HASWIDTH) && op != '?') + FAIL("*+ operand could be empty"); + *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH); + + if (op == '*' && (flags&SIMPLE)) + reginsert(STAR, ret, rcstate); + else if (op == '*') { + /* Emit x* as (x&|), where & means "self". */ + reginsert(BRANCH, ret, rcstate); /* Either x */ + regoptail(ret, regnode(BACK,rcstate)); /* and loop */ + regoptail(ret, ret); /* back */ + regtail(ret, regnode(BRANCH,rcstate)); /* or */ + regtail(ret, regnode(NOTHING,rcstate)); /* null. */ + } else if (op == '+' && (flags&SIMPLE)) + reginsert(PLUS, ret, rcstate); + else if (op == '+') { + /* Emit x+ as x(&|), where & means "self". */ + next = regnode(BRANCH,rcstate); /* Either */ + regtail(ret, next); + regtail(regnode(BACK,rcstate), ret); /* loop back */ + regtail(next, regnode(BRANCH,rcstate)); /* or */ + regtail(ret, regnode(NOTHING,rcstate)); /* null. */ + } else if (op == '?') { + /* Emit x? as (x|) */ + reginsert(BRANCH, ret, rcstate); /* Either x */ + regtail(ret, regnode(BRANCH,rcstate)); /* or */ + next = regnode(NOTHING,rcstate); /* null. */ + regtail(ret, next); + regoptail(ret, next); + } + rcstate->regparse++; + if (ISMULT(*rcstate->regparse)) + FAIL("nested *?+"); + + return(ret); +} + +/* + - regatom - the lowest level + * + * Optimization: gobbles an entire sequence of ordinary characters so that + * it can turn them into a single node, which is smaller to store and + * faster to run. Backslashed characters are exceptions, each becoming a + * separate node; the code is simpler that way and it's not worth fixing. + */ +static char * +regatom(flagp, rcstate) +int *flagp; +struct regcomp_state *rcstate; +{ + register char *ret; + int flags; + + *flagp = WORST; /* Tentatively. */ + + switch (*rcstate->regparse++) { + case '^': + ret = regnode(BOL,rcstate); + break; + case '$': + ret = regnode(EOL,rcstate); + break; + case '.': + ret = regnode(ANY,rcstate); + *flagp |= HASWIDTH|SIMPLE; + break; + case '[': { + register int clss; + register int classend; + + if (*rcstate->regparse == '^') { /* Complement of range. */ + ret = regnode(ANYBUT,rcstate); + rcstate->regparse++; + } else + ret = regnode(ANYOF,rcstate); + if (*rcstate->regparse == ']' || *rcstate->regparse == '-') + regc(*rcstate->regparse++,rcstate); + while (*rcstate->regparse != '\0' && *rcstate->regparse != ']') { + if (*rcstate->regparse == '-') { + rcstate->regparse++; + if (*rcstate->regparse == ']' || *rcstate->regparse == '\0') + regc('-',rcstate); + else { + clss = UCHARAT(rcstate->regparse-2)+1; + classend = UCHARAT(rcstate->regparse); + if (clss > classend+1) + FAIL("invalid [] range"); + for (; clss <= classend; clss++) + regc((char)clss,rcstate); + rcstate->regparse++; + } + } else + regc(*rcstate->regparse++,rcstate); + } + regc('\0',rcstate); + if (*rcstate->regparse != ']') + FAIL("unmatched []"); + rcstate->regparse++; + *flagp |= HASWIDTH|SIMPLE; + } + break; + case '(': + ret = reg(1, &flags, rcstate); + if (ret == NULL) + return(NULL); + *flagp |= flags&(HASWIDTH|SPSTART); + break; + case '\0': + case '|': + case ')': + FAIL("internal urp"); /* Supposed to be caught earlier. */ + /* NOTREACHED */ + case '?': + case '+': + case '*': + FAIL("?+* follows nothing"); + /* NOTREACHED */ + case '\\': + if (*rcstate->regparse == '\0') + FAIL("trailing \\"); + ret = regnode(EXACTLY,rcstate); + regc(*rcstate->regparse++,rcstate); + regc('\0',rcstate); + *flagp |= HASWIDTH|SIMPLE; + break; + default: { + register int len; + register char ender; + + rcstate->regparse--; + len = strcspn(rcstate->regparse, META); + if (len <= 0) + FAIL("internal disaster"); + ender = *(rcstate->regparse+len); + if (len > 1 && ISMULT(ender)) + len--; /* Back off clear of ?+* operand. */ + *flagp |= HASWIDTH; + if (len == 1) + *flagp |= SIMPLE; + ret = regnode(EXACTLY,rcstate); + while (len > 0) { + regc(*rcstate->regparse++,rcstate); + len--; + } + regc('\0',rcstate); + } + break; + } + + return(ret); +} + +/* + - regnode - emit a node + */ +static char * /* Location. */ +regnode(op, rcstate) +int op; +struct regcomp_state *rcstate; +{ + register char *ret; + register char *ptr; + + ret = rcstate->regcode; + if (ret == ®dummy) { + rcstate->regsize += 3; + return(ret); + } + + ptr = ret; + *ptr++ = (char)op; + *ptr++ = '\0'; /* Null "next" pointer. */ + *ptr++ = '\0'; + rcstate->regcode = ptr; + + return(ret); +} + +/* + - regc - emit (if appropriate) a byte of code + */ +static void +regc(b, rcstate) +int b; +struct regcomp_state *rcstate; +{ + if (rcstate->regcode != ®dummy) + *rcstate->regcode++ = (char)b; + else + rcstate->regsize++; +} + +/* + - reginsert - insert an operator in front of already-emitted operand + * + * Means relocating the operand. + */ +static void +reginsert(op, opnd, rcstate) +int op; +char *opnd; +struct regcomp_state *rcstate; +{ + register char *src; + register char *dst; + register char *place; + + if (rcstate->regcode == ®dummy) { + rcstate->regsize += 3; + return; + } + + src = rcstate->regcode; + rcstate->regcode += 3; + dst = rcstate->regcode; + while (src > opnd) + *--dst = *--src; + + place = opnd; /* Op node, where operand used to be. */ + *place++ = (char)op; + *place++ = '\0'; + *place = '\0'; +} + +/* + - regtail - set the next-pointer at the end of a node chain + */ +static void +regtail(p, val) +char *p; +char *val; +{ + register char *scan; + register char *temp; + register int offset; + + if (p == ®dummy) + return; + + /* Find last node. */ + scan = p; + for (;;) { + temp = regnext(scan); + if (temp == NULL) + break; + scan = temp; + } + + if (OP(scan) == BACK) + offset = scan - val; + else + offset = val - scan; + *(scan+1) = (char)((offset>>8)&0377); + *(scan+2) = (char)(offset&0377); +} + +/* + - regoptail - regtail on operand of first argument; nop if operandless + */ +static void +regoptail(p, val) +char *p; +char *val; +{ + /* "Operandless" and "op != BRANCH" are synonymous in practice. */ + if (p == NULL || p == ®dummy || OP(p) != BRANCH) + return; + regtail(OPERAND(p), val); +} + +/* + * TclRegExec and friends + */ + +/* + * Global work variables for TclRegExec(). + */ +struct regexec_state { + char *reginput; /* String-input pointer. */ + char *regbol; /* Beginning of input, for ^ check. */ + char **regstartp; /* Pointer to startp array. */ + char **regendp; /* Ditto for endp. */ +}; + +/* + * Forwards. + */ +static int regtry _ANSI_ARGS_((regexp *prog, char *string, + struct regexec_state *restate)); +static int regmatch _ANSI_ARGS_((char *prog, + struct regexec_state *restate)); +static int regrepeat _ANSI_ARGS_((char *p, + struct regexec_state *restate)); + +#ifdef DEBUG +int regnarrate = 0; +void regdump _ANSI_ARGS_((regexp *r)); +static char *regprop _ANSI_ARGS_((char *op)); +#endif + +/* + - TclRegExec - match a regexp against a string + */ +int +TclRegExec(prog, string, start) +register regexp *prog; +register char *string; +char *start; +{ + register char *s; + struct regexec_state state; + struct regexec_state *restate= &state; + + /* Be paranoid... */ + if (prog == NULL || string == NULL) { + TclRegError("NULL parameter"); + return(0); + } + + /* Check validity of program. */ + if (UCHARAT(prog->program) != MAGIC) { + TclRegError("corrupted program"); + return(0); + } + + /* If there is a "must appear" string, look for it. */ + if (prog->regmust != NULL) { + s = string; + while ((s = strchr(s, prog->regmust[0])) != NULL) { + if (strncmp(s, prog->regmust, (size_t) prog->regmlen) + == 0) + break; /* Found it. */ + s++; + } + if (s == NULL) /* Not present. */ + return(0); + } + + /* Mark beginning of line for ^ . */ + restate->regbol = start; + + /* Simplest case: anchored match need be tried only once. */ + if (prog->reganch) + return(regtry(prog, string, restate)); + + /* Messy cases: unanchored match. */ + s = string; + if (prog->regstart != '\0') + /* We know what char it must start with. */ + while ((s = strchr(s, prog->regstart)) != NULL) { + if (regtry(prog, s, restate)) + return(1); + s++; + } + else + /* We don't -- general case. */ + do { + if (regtry(prog, s, restate)) + return(1); + } while (*s++ != '\0'); + + /* Failure. */ + return(0); +} + +/* + - regtry - try match at specific point + */ +static int /* 0 failure, 1 success */ +regtry(prog, string, restate) +regexp *prog; +char *string; +struct regexec_state *restate; +{ + register int i; + register char **sp; + register char **ep; + + restate->reginput = string; + restate->regstartp = prog->startp; + restate->regendp = prog->endp; + + sp = prog->startp; + ep = prog->endp; + for (i = NSUBEXP; i > 0; i--) { + *sp++ = NULL; + *ep++ = NULL; + } + if (regmatch(prog->program + 1,restate)) { + prog->startp[0] = string; + prog->endp[0] = restate->reginput; + return(1); + } else + return(0); +} + +/* + - regmatch - main matching routine + * + * Conceptually the strategy is simple: check to see whether the current + * node matches, call self recursively to see whether the rest matches, + * and then act accordingly. In practice we make some effort to avoid + * recursion, in particular by going through "ordinary" nodes (that don't + * need to know whether the rest of the match failed) by a loop instead of + * by recursion. + */ +static int /* 0 failure, 1 success */ +regmatch(prog, restate) +char *prog; +struct regexec_state *restate; +{ + register char *scan; /* Current node. */ + char *next; /* Next node. */ + + scan = prog; +#ifdef DEBUG + if (scan != NULL && regnarrate) + fprintf(stderr, "%s(\n", regprop(scan)); +#endif + while (scan != NULL) { +#ifdef DEBUG + if (regnarrate) + fprintf(stderr, "%s...\n", regprop(scan)); +#endif + next = regnext(scan); + + switch (OP(scan)) { + case BOL: + if (restate->reginput != restate->regbol) { + return 0; + } + break; + case EOL: + if (*restate->reginput != '\0') { + return 0; + } + break; + case ANY: + if (*restate->reginput == '\0') { + return 0; + } + restate->reginput++; + break; + case EXACTLY: { + register int len; + register char *opnd; + + opnd = OPERAND(scan); + /* Inline the first character, for speed. */ + if (*opnd != *restate->reginput) { + return 0 ; + } + len = strlen(opnd); + if (len > 1 && strncmp(opnd, restate->reginput, (size_t) len) + != 0) { + return 0; + } + restate->reginput += len; + break; + } + case ANYOF: + if (*restate->reginput == '\0' + || strchr(OPERAND(scan), *restate->reginput) == NULL) { + return 0; + } + restate->reginput++; + break; + case ANYBUT: + if (*restate->reginput == '\0' + || strchr(OPERAND(scan), *restate->reginput) != NULL) { + return 0; + } + restate->reginput++; + break; + case NOTHING: + break; + case BACK: + break; + case OPEN+1: + case OPEN+2: + case OPEN+3: + case OPEN+4: + case OPEN+5: + case OPEN+6: + case OPEN+7: + case OPEN+8: + case OPEN+9: { + register int no; + register char *save; + + doOpen: + no = OP(scan) - OPEN; + save = restate->reginput; + + if (regmatch(next,restate)) { + /* + * Don't set startp if some later invocation of the + * same parentheses already has. + */ + if (restate->regstartp[no] == NULL) { + restate->regstartp[no] = save; + } + return 1; + } else { + return 0; + } + } + case CLOSE+1: + case CLOSE+2: + case CLOSE+3: + case CLOSE+4: + case CLOSE+5: + case CLOSE+6: + case CLOSE+7: + case CLOSE+8: + case CLOSE+9: { + register int no; + register char *save; + + doClose: + no = OP(scan) - CLOSE; + save = restate->reginput; + + if (regmatch(next,restate)) { + /* + * Don't set endp if some later + * invocation of the same parentheses + * already has. + */ + if (restate->regendp[no] == NULL) + restate->regendp[no] = save; + return 1; + } else { + return 0; + } + } + case BRANCH: { + register char *save; + + if (OP(next) != BRANCH) { /* No choice. */ + next = OPERAND(scan); /* Avoid recursion. */ + } else { + do { + save = restate->reginput; + if (regmatch(OPERAND(scan),restate)) + return(1); + restate->reginput = save; + scan = regnext(scan); + } while (scan != NULL && OP(scan) == BRANCH); + return 0; + } + break; + } + case STAR: + case PLUS: { + register char nextch; + register int no; + register char *save; + register int min; + + /* + * Lookahead to avoid useless match attempts + * when we know what character comes next. + */ + nextch = '\0'; + if (OP(next) == EXACTLY) + nextch = *OPERAND(next); + min = (OP(scan) == STAR) ? 0 : 1; + save = restate->reginput; + no = regrepeat(OPERAND(scan),restate); + while (no >= min) { + /* If it could work, try it. */ + if (nextch == '\0' || *restate->reginput == nextch) + if (regmatch(next,restate)) + return(1); + /* Couldn't or didn't -- back up. */ + no--; + restate->reginput = save + no; + } + return(0); + } + case END: + return(1); /* Success! */ + default: + if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) { + goto doOpen; + } else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) { + goto doClose; + } + TclRegError("memory corruption"); + return 0; + } + + scan = next; + } + + /* + * We get here only if there's trouble -- normally "case END" is + * the terminating point. + */ + TclRegError("corrupted pointers"); + return(0); +} + +/* + - regrepeat - repeatedly match something simple, report how many + */ +static int +regrepeat(p, restate) +char *p; +struct regexec_state *restate; +{ + register int count = 0; + register char *scan; + register char *opnd; + + scan = restate->reginput; + opnd = OPERAND(p); + switch (OP(p)) { + case ANY: + count = strlen(scan); + scan += count; + break; + case EXACTLY: + while (*opnd == *scan) { + count++; + scan++; + } + break; + case ANYOF: + while (*scan != '\0' && strchr(opnd, *scan) != NULL) { + count++; + scan++; + } + break; + case ANYBUT: + while (*scan != '\0' && strchr(opnd, *scan) == NULL) { + count++; + scan++; + } + break; + default: /* Oh dear. Called inappropriately. */ + TclRegError("internal foulup"); + count = 0; /* Best compromise. */ + break; + } + restate->reginput = scan; + + return(count); +} + +/* + - regnext - dig the "next" pointer out of a node + */ +static char * +regnext(p) +register char *p; +{ + register int offset; + + if (p == ®dummy) + return(NULL); + + offset = NEXT(p); + if (offset == 0) + return(NULL); + + if (OP(p) == BACK) + return(p-offset); + else + return(p+offset); +} + +#ifdef DEBUG + +static char *regprop(); + +/* + - regdump - dump a regexp onto stdout in vaguely comprehensible form + */ +void +regdump(r) +regexp *r; +{ + register char *s; + register char op = EXACTLY; /* Arbitrary non-END op. */ + register char *next; + + + s = r->program + 1; + while (op != END) { /* While that wasn't END last time... */ + op = OP(s); + printf("%2d%s", s-r->program, regprop(s)); /* Where, what. */ + next = regnext(s); + if (next == NULL) /* Next ptr. */ + printf("(0)"); + else + printf("(%d)", (s-r->program)+(next-s)); + s += 3; + if (op == ANYOF || op == ANYBUT || op == EXACTLY) { + /* Literal string, where present. */ + while (*s != '\0') { + putchar(*s); + s++; + } + s++; + } + putchar('\n'); + } + + /* Header fields of interest. */ + if (r->regstart != '\0') + printf("start `%c' ", r->regstart); + if (r->reganch) + printf("anchored "); + if (r->regmust != NULL) + printf("must have \"%s\"", r->regmust); + printf("\n"); +} + +/* + - regprop - printable representation of opcode + */ +static char * +regprop(op) +char *op; +{ + register char *p; + static char buf[50]; + + (void) strcpy(buf, ":"); + + switch (OP(op)) { + case BOL: + p = "BOL"; + break; + case EOL: + p = "EOL"; + break; + case ANY: + p = "ANY"; + break; + case ANYOF: + p = "ANYOF"; + break; + case ANYBUT: + p = "ANYBUT"; + break; + case BRANCH: + p = "BRANCH"; + break; + case EXACTLY: + p = "EXACTLY"; + break; + case NOTHING: + p = "NOTHING"; + break; + case BACK: + p = "BACK"; + break; + case END: + p = "END"; + break; + case OPEN+1: + case OPEN+2: + case OPEN+3: + case OPEN+4: + case OPEN+5: + case OPEN+6: + case OPEN+7: + case OPEN+8: + case OPEN+9: + sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN); + p = NULL; + break; + case CLOSE+1: + case CLOSE+2: + case CLOSE+3: + case CLOSE+4: + case CLOSE+5: + case CLOSE+6: + case CLOSE+7: + case CLOSE+8: + case CLOSE+9: + sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE); + p = NULL; + break; + case STAR: + p = "STAR"; + break; + case PLUS: + p = "PLUS"; + break; + default: + if (OP(op) > OPEN && OP(op) < OPEN+NSUBEXP) { + sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN); + p = NULL; + break; + } else if (OP(op) > CLOSE && OP(op) < CLOSE+NSUBEXP) { + sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE); + p = NULL; + } else { + TclRegError("corrupted opcode"); + } + break; + } + if (p != NULL) + (void) strcat(buf, p); + return(buf); +} +#endif + +/* + * The following is provided for those people who do not have strcspn() in + * their C libraries. They should get off their butts and do something + * about it; at least one public-domain implementation of those (highly + * useful) string routines has been published on Usenet. + */ +#ifdef STRCSPN +/* + * strcspn - find length of initial segment of s1 consisting entirely + * of characters not from s2 + */ + +static int +strcspn(s1, s2) +char *s1; +char *s2; +{ + register char *scan1; + register char *scan2; + register int count; + + count = 0; + for (scan1 = s1; *scan1 != '\0'; scan1++) { + for (scan2 = s2; *scan2 != '\0';) /* ++ moved down. */ + if (*scan1 == *scan2++) + return(count); + count++; + } + return(count); +} +#endif + +/* + *---------------------------------------------------------------------- + * + * TclRegError -- + * + * This procedure is invoked by the regexp code when an error + * occurs. It saves the error message so it can be seen by the + * code that called Spencer's code. + * + * Results: + * None. + * + * Side effects: + * The value of "string" is saved in "errMsg". + * + *---------------------------------------------------------------------- + */ + +void +exp_TclRegError(string) + char *string; /* Error message. */ +{ + errMsg = string; +} + +char * +TclGetRegError() +{ + return errMsg; +} + +/* + * end of regexp definitions and code + */ + +/* + * following stolen from tcl8.0.4/generic/tclPosixStr.c + */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_ErrnoMsg -- + * + * Return a human-readable message corresponding to a given + * errno value. + * + * Results: + * The return value is the standard POSIX error message for + * errno. This procedure is used instead of strerror because + * strerror returns slightly different values on different + * machines (e.g. different capitalizations), which cause + * problems for things such as regression tests. This procedure + * provides messages for most standard errors, then it calls + * strerror for things it doesn't understand. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static +char * +Tcl_ErrnoMsg(err) + int err; /* Error number (such as in errno variable). */ +{ + switch (err) { +#ifdef E2BIG + case E2BIG: return "argument list too long"; +#endif +#ifdef EACCES + case EACCES: return "permission denied"; +#endif +#ifdef EADDRINUSE + case EADDRINUSE: return "address already in use"; +#endif +#ifdef EADDRNOTAVAIL + case EADDRNOTAVAIL: return "can't assign requested address"; +#endif +#ifdef EADV + case EADV: return "advertise error"; +#endif +#ifdef EAFNOSUPPORT + case EAFNOSUPPORT: return "address family not supported by protocol family"; +#endif +#ifdef EAGAIN + case EAGAIN: return "resource temporarily unavailable"; +#endif +#ifdef EALIGN + case EALIGN: return "EALIGN"; +#endif +#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY )) + case EALREADY: return "operation already in progress"; +#endif +#ifdef EBADE + case EBADE: return "bad exchange descriptor"; +#endif +#ifdef EBADF + case EBADF: return "bad file number"; +#endif +#ifdef EBADFD + case EBADFD: return "file descriptor in bad state"; +#endif +#ifdef EBADMSG + case EBADMSG: return "not a data message"; +#endif +#ifdef EBADR + case EBADR: return "bad request descriptor"; +#endif +#ifdef EBADRPC + case EBADRPC: return "RPC structure is bad"; +#endif +#ifdef EBADRQC + case EBADRQC: return "bad request code"; +#endif +#ifdef EBADSLT + case EBADSLT: return "invalid slot"; +#endif +#ifdef EBFONT + case EBFONT: return "bad font file format"; +#endif +#ifdef EBUSY + case EBUSY: return "file busy"; +#endif +#ifdef ECHILD + case ECHILD: return "no children"; +#endif +#ifdef ECHRNG + case ECHRNG: return "channel number out of range"; +#endif +#ifdef ECOMM + case ECOMM: return "communication error on send"; +#endif +#ifdef ECONNABORTED + case ECONNABORTED: return "software caused connection abort"; +#endif +#ifdef ECONNREFUSED + case ECONNREFUSED: return "connection refused"; +#endif +#ifdef ECONNRESET + case ECONNRESET: return "connection reset by peer"; +#endif +#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK)) + case EDEADLK: return "resource deadlock avoided"; +#endif +#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK)) + case EDEADLOCK: return "resource deadlock avoided"; +#endif +#ifdef EDESTADDRREQ + case EDESTADDRREQ: return "destination address required"; +#endif +#ifdef EDIRTY + case EDIRTY: return "mounting a dirty fs w/o force"; +#endif +#ifdef EDOM + case EDOM: return "math argument out of range"; +#endif +#ifdef EDOTDOT + case EDOTDOT: return "cross mount point"; +#endif +#ifdef EDQUOT + case EDQUOT: return "disk quota exceeded"; +#endif +#ifdef EDUPPKG + case EDUPPKG: return "duplicate package name"; +#endif +#ifdef EEXIST + case EEXIST: return "file already exists"; +#endif +#ifdef EFAULT + case EFAULT: return "bad address in system call argument"; +#endif +#ifdef EFBIG + case EFBIG: return "file too large"; +#endif +#ifdef EHOSTDOWN + case EHOSTDOWN: return "host is down"; +#endif +#ifdef EHOSTUNREACH + case EHOSTUNREACH: return "host is unreachable"; +#endif +#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) + case EIDRM: return "identifier removed"; +#endif +#ifdef EINIT + case EINIT: return "initialization error"; +#endif +#ifdef EINPROGRESS + case EINPROGRESS: return "operation now in progress"; +#endif +#ifdef EINTR + case EINTR: return "interrupted system call"; +#endif +#ifdef EINVAL + case EINVAL: return "invalid argument"; +#endif +#ifdef EIO + case EIO: return "I/O error"; +#endif +#ifdef EISCONN + case EISCONN: return "socket is already connected"; +#endif +#ifdef EISDIR + case EISDIR: return "illegal operation on a directory"; +#endif +#ifdef EISNAME + case EISNAM: return "is a name file"; +#endif +#ifdef ELBIN + case ELBIN: return "ELBIN"; +#endif +#ifdef EL2HLT + case EL2HLT: return "level 2 halted"; +#endif +#ifdef EL2NSYNC + case EL2NSYNC: return "level 2 not synchronized"; +#endif +#ifdef EL3HLT + case EL3HLT: return "level 3 halted"; +#endif +#ifdef EL3RST + case EL3RST: return "level 3 reset"; +#endif +#ifdef ELIBACC + case ELIBACC: return "can not access a needed shared library"; +#endif +#ifdef ELIBBAD + case ELIBBAD: return "accessing a corrupted shared library"; +#endif +#ifdef ELIBEXEC + case ELIBEXEC: return "can not exec a shared library directly"; +#endif +#ifdef ELIBMAX + case ELIBMAX: return + "attempting to link in more shared libraries than system limit"; +#endif +#ifdef ELIBSCN + case ELIBSCN: return ".lib section in a.out corrupted"; +#endif +#ifdef ELNRNG + case ELNRNG: return "link number out of range"; +#endif +#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) + case ELOOP: return "too many levels of symbolic links"; +#endif +#ifdef EMFILE + case EMFILE: return "too many open files"; +#endif +#ifdef EMLINK + case EMLINK: return "too many links"; +#endif +#ifdef EMSGSIZE + case EMSGSIZE: return "message too long"; +#endif +#ifdef EMULTIHOP + case EMULTIHOP: return "multihop attempted"; +#endif +#ifdef ENAMETOOLONG + case ENAMETOOLONG: return "file name too long"; +#endif +#ifdef ENAVAIL + case ENAVAIL: return "not available"; +#endif +#ifdef ENET + case ENET: return "ENET"; +#endif +#ifdef ENETDOWN + case ENETDOWN: return "network is down"; +#endif +#ifdef ENETRESET + case ENETRESET: return "network dropped connection on reset"; +#endif +#ifdef ENETUNREACH + case ENETUNREACH: return "network is unreachable"; +#endif +#ifdef ENFILE + case ENFILE: return "file table overflow"; +#endif +#ifdef ENOANO + case ENOANO: return "anode table overflow"; +#endif +#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) + case ENOBUFS: return "no buffer space available"; +#endif +#ifdef ENOCSI + case ENOCSI: return "no CSI structure available"; +#endif +#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED)) + case ENODATA: return "no data available"; +#endif +#ifdef ENODEV + case ENODEV: return "no such device"; +#endif +#ifdef ENOENT + case ENOENT: return "no such file or directory"; +#endif +#ifdef ENOEXEC + case ENOEXEC: return "exec format error"; +#endif +#ifdef ENOLCK + case ENOLCK: return "no locks available"; +#endif +#ifdef ENOLINK + case ENOLINK: return "link has be severed"; +#endif +#ifdef ENOMEM + case ENOMEM: return "not enough memory"; +#endif +#ifdef ENOMSG + case ENOMSG: return "no message of desired type"; +#endif +#ifdef ENONET + case ENONET: return "machine is not on the network"; +#endif +#ifdef ENOPKG + case ENOPKG: return "package not installed"; +#endif +#ifdef ENOPROTOOPT + case ENOPROTOOPT: return "bad proocol option"; +#endif +#ifdef ENOSPC + case ENOSPC: return "no space left on device"; +#endif +#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) + case ENOSR: return "out of stream resources"; +#endif +#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) + case ENOSTR: return "not a stream device"; +#endif +#ifdef ENOSYM + case ENOSYM: return "unresolved symbol name"; +#endif +#ifdef ENOSYS + case ENOSYS: return "function not implemented"; +#endif +#ifdef ENOTBLK + case ENOTBLK: return "block device required"; +#endif +#ifdef ENOTCONN + case ENOTCONN: return "socket is not connected"; +#endif +#ifdef ENOTDIR + case ENOTDIR: return "not a directory"; +#endif +#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST)) + case ENOTEMPTY: return "directory not empty"; +#endif +#ifdef ENOTNAM + case ENOTNAM: return "not a name file"; +#endif +#ifdef ENOTSOCK + case ENOTSOCK: return "socket operation on non-socket"; +#endif +#ifdef ENOTSUP + case ENOTSUP: return "operation not supported"; +#endif +#ifdef ENOTTY + case ENOTTY: return "inappropriate device for ioctl"; +#endif +#ifdef ENOTUNIQ + case ENOTUNIQ: return "name not unique on network"; +#endif +#ifdef ENXIO + case ENXIO: return "no such device or address"; +#endif +#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP)) + case EOPNOTSUPP: return "operation not supported on socket"; +#endif +#ifdef EPERM + case EPERM: return "not owner"; +#endif +#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) + case EPFNOSUPPORT: return "protocol family not supported"; +#endif +#ifdef EPIPE + case EPIPE: return "broken pipe"; +#endif +#ifdef EPROCLIM + case EPROCLIM: return "too many processes"; +#endif +#ifdef EPROCUNAVAIL + case EPROCUNAVAIL: return "bad procedure for program"; +#endif +#ifdef EPROGMISMATCH + case EPROGMISMATCH: return "program version wrong"; +#endif +#ifdef EPROGUNAVAIL + case EPROGUNAVAIL: return "RPC program not available"; +#endif +#ifdef EPROTO + case EPROTO: return "protocol error"; +#endif +#ifdef EPROTONOSUPPORT + case EPROTONOSUPPORT: return "protocol not suppored"; +#endif +#ifdef EPROTOTYPE + case EPROTOTYPE: return "protocol wrong type for socket"; +#endif +#ifdef ERANGE + case ERANGE: return "math result unrepresentable"; +#endif +#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) + case EREFUSED: return "EREFUSED"; +#endif +#ifdef EREMCHG + case EREMCHG: return "remote address changed"; +#endif +#ifdef EREMDEV + case EREMDEV: return "remote device"; +#endif +#ifdef EREMOTE + case EREMOTE: return "pathname hit remote file system"; +#endif +#ifdef EREMOTEIO + case EREMOTEIO: return "remote i/o error"; +#endif +#ifdef EREMOTERELEASE + case EREMOTERELEASE: return "EREMOTERELEASE"; +#endif +#ifdef EROFS + case EROFS: return "read-only file system"; +#endif +#ifdef ERPCMISMATCH + case ERPCMISMATCH: return "RPC version is wrong"; +#endif +#ifdef ERREMOTE + case ERREMOTE: return "object is remote"; +#endif +#ifdef ESHUTDOWN + case ESHUTDOWN: return "can't send afer socket shutdown"; +#endif +#ifdef ESOCKTNOSUPPORT + case ESOCKTNOSUPPORT: return "socket type not supported"; +#endif +#ifdef ESPIPE + case ESPIPE: return "invalid seek"; +#endif +#ifdef ESRCH + case ESRCH: return "no such process"; +#endif +#ifdef ESRMNT + case ESRMNT: return "srmount error"; +#endif +#ifdef ESTALE + case ESTALE: return "stale remote file handle"; +#endif +#ifdef ESUCCESS + case ESUCCESS: return "Error 0"; +#endif +#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) + case ETIME: return "timer expired"; +#endif +#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR)) + case ETIMEDOUT: return "connection timed out"; +#endif +#ifdef ETOOMANYREFS + case ETOOMANYREFS: return "too many references: can't splice"; +#endif +#ifdef ETXTBSY + case ETXTBSY: return "text file or pseudo-device busy"; +#endif +#ifdef EUCLEAN + case EUCLEAN: return "structure needs cleaning"; +#endif +#ifdef EUNATCH + case EUNATCH: return "protocol driver not attached"; +#endif +#ifdef EUSERS + case EUSERS: return "too many users"; +#endif +#ifdef EVERSION + case EVERSION: return "version mismatch"; +#endif +#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN)) + case EWOULDBLOCK: return "operation would block"; +#endif +#ifdef EXDEV + case EXDEV: return "cross-domain link"; +#endif +#ifdef EXFULL + case EXFULL: return "message tables full"; +#endif + default: +#ifdef NO_STRERROR + return "unknown POSIX error"; +#else + return strerror(errno); +#endif + } +} + +/* + * end of excerpt from tcl8.0.X/generic/tclPosixStr.c + */ + +/* + * stolen from exp_log.c - this function is called from the Expect library + * but the one that the library supplies calls Tcl functions. So we supply + * our own. + */ + +static +void +expDiagLogU(str) + char *str; +{ + if (exp_is_debugging) { + fprintf(stderr,str); + if (exp_logfile) fprintf(exp_logfile,str); + } +} + +/* + * expect-specific definitions and code + */ + +#include "expect.h" +#include "exp_int.h" + +/* exp_glob.c - expect functions for doing glob + * + * Based on Tcl's glob functions but modified to support anchors and to + * return information about the possibility of future matches + * + * Modifications by: Don Libes, NIST, 2/6/90 + */ + +/* The following functions implement expect's glob-style string + * matching Exp_StringMatch allow's implements the unanchored front + * (or conversely the '^') feature. Exp_StringMatch2 does the rest of + * the work. + */ + +/* Exp_StringMatch2 -- + * + * Like Tcl_StringMatch except that + * 1) returns number of characters matched, -1 if failed. + * (Can return 0 on patterns like "" or "$") + * 2) does not require pattern to match to end of string + * 3) much of code is stolen from Tcl_StringMatch + * 4) front-anchor is assumed (Tcl_StringMatch retries for non-front-anchor) + */ +static +int +Exp_StringMatch2(string,pattern) + register char *string; /* String. */ + register char *pattern; /* Pattern, which may contain + * special characters. */ +{ + char c2; + int match = 0; /* # of chars matched */ + + while (1) { + /* If at end of pattern, success! */ + if (*pattern == 0) { + return match; + } + + /* If last pattern character is '$', verify that entire + * string has been matched. + */ + if ((*pattern == '$') && (pattern[1] == 0)) { + if (*string == 0) return(match); + else return(-1); + } + + /* Check for a "*" as the next pattern character. It matches + * any substring. We handle this by calling ourselves + * recursively for each postfix of string, until either we + * match or we reach the end of the string. + */ + + if (*pattern == '*') { + int head_len; + char *tail; + pattern += 1; + if (*pattern == 0) { + return(strlen(string)+match); /* DEL */ + } + /* find longest match - switched to this on 12/31/93 */ + head_len = strlen(string); /* length before tail */ + tail = string + head_len; + while (head_len >= 0) { + int rc; + + if (-1 != (rc = Exp_StringMatch2(tail, pattern))) { + return rc + match + head_len; /* DEL */ + } + tail--; + head_len--; + } + return -1; /* DEL */ + } + + /* + * after this point, all patterns must match at least one + * character, so check this + */ + + if (*string == 0) return -1; + + /* Check for a "?" as the next pattern character. It matches + * any single character. + */ + + if (*pattern == '?') { + goto thisCharOK; + } + + /* Check for a "[" as the next pattern character. It is followed + * by a list of characters that are acceptable, or by a range + * (two characters separated by "-"). + */ + + if (*pattern == '[') { + pattern += 1; + while (1) { + if ((*pattern == ']') || (*pattern == 0)) { + return -1; /* was 0; DEL */ + } + if (*pattern == *string) { + break; + } + if (pattern[1] == '-') { + c2 = pattern[2]; + if (c2 == 0) { + return -1; /* DEL */ + } + if ((*pattern <= *string) && (c2 >= *string)) { + break; + } + if ((*pattern >= *string) && (c2 <= *string)) { + break; + } + pattern += 2; + } + pattern += 1; + } + + while (*pattern != ']') { + if (*pattern == 0) { + pattern--; + break; + } + pattern += 1; + } + goto thisCharOK; + } + + /* If the next pattern character is backslash, strip it off + * so we do exact matching on the character that follows. + */ + + if (*pattern == '\\') { + pattern += 1; + if (*pattern == 0) { + return -1; + } + } + + /* There's no special character. Just make sure that the next + * characters of each string match. + */ + + if (*pattern != *string) { + return -1; + } + + thisCharOK: pattern += 1; + string += 1; + match++; + } +} + + +static +int /* returns # of chars that matched */ +Exp_StringMatch(string, pattern,offset) +char *string; +char *pattern; +int *offset; /* offset from beginning of string where pattern matches */ +{ + char *s; + int sm; /* count of chars matched or -1 */ + int caret = FALSE; + int star = FALSE; + + *offset = 0; + + if (pattern[0] == '^') { + caret = TRUE; + pattern++; + } else if (pattern[0] == '*') { + star = TRUE; + } + + /* + * test if pattern matches in initial position. + * This handles front-anchor and 1st iteration of non-front-anchor. + * Note that 1st iteration must be tried even if string is empty. + */ + + sm = Exp_StringMatch2(string,pattern); + if (sm >= 0) return(sm); + + if (caret) return -1; + if (star) return -1; + + if (*string == '\0') return -1; + + for (s = string+1;*s;s++) { + sm = Exp_StringMatch2(s,pattern); + if (sm != -1) { + *offset = s-string; + return(sm); + } + } + return -1; +} + #define EXP_MATCH_MAX 2000 /* public */ char *exp_buffer = 0; char *exp_buffer_end = 0; @@ -85,18 +2167,31 @@ char *exp_stty_init = 0; /* initial stty args */ int exp_ttycopy = TRUE; /* copy tty parms from /dev/tty */ int exp_ttyinit = TRUE; /* set tty parms to sane state */ int exp_console = FALSE; /* redirect console */ void (*exp_child_exec_prelude)() = 0; +void (*exp_close_in_child)() = 0; +#ifdef HAVE_SIGLONGJMP +sigjmp_buf exp_readenv; /* for interruptable read() */ +#else jmp_buf exp_readenv; /* for interruptable read() */ +#endif /* HAVE_SIGLONGJMP */ + int exp_reading = FALSE; /* whether we can longjmp or not */ -void debuglog(); -int getptymaster(); -int getptyslave(); -int Exp_StringMatch(); +int exp_is_debugging = FALSE; +FILE *exp_debugfile = 0; + +FILE *exp_logfile = 0; +int exp_logfile_all = FALSE; /* if TRUE, write log of all interactions */ +int exp_loguser = TRUE; /* if TRUE, user sees interactions on stdout */ + + +char *exp_printify(); +int exp_getptymaster(); +int exp_getptyslave(); #define sysreturn(x) return(errno = x, -1) void exp_init_pty(); @@ -107,24 +2202,18 @@ The functions are relatively small but painful enough that I don't care to recode them. You may, if you absolutely want to get rid of any vestiges of Tcl. */ -extern char *TclGetRegError(); -extern void TclRegError(); -char *Tcl_ErrnoMsg(); - - static unsigned int bufsiz = 2*EXP_MATCH_MAX; static struct f { int valid; char *buffer; /* buffer of matchable chars */ char *buffer_end; /* one beyond end of matchable chars */ - /*char *match; /* start of matched string */ char *match_end; /* one beyond end of matched string */ int msize; /* size of allocate space */ /* actual size is one larger for null */ } *fs = 0; @@ -175,10 +2264,27 @@ fp->buffer_end = fp->buffer; fp->match_end = fp->buffer; return fp; } + +static +void +exp_setpgrp() +{ +#ifdef MIPS_BSD + /* required on BSD side of MIPS OS */ +# include + syscall(SYS_setpgrp); +#endif + +#ifdef SETPGRP_VOID + (void) setpgrp(); +#else + (void) setpgrp(0,0); +#endif +} /* returns fd of master side of pty */ int exp_spawnv(file,argv) char *file; @@ -188,10 +2294,12 @@ int errorfd; /* place to stash fileno(stderr) in child */ /* while we're setting up new stderr */ int ttyfd; int sync_fds[2]; int sync2_fds[2]; + int status_pipe[2]; + int child_errno; char sync_byte; #ifdef PTYTRAP_DIES int slave_write_ioctls = 1; /* by default, slave will be write-ioctled this many times */ #endif @@ -200,15 +2308,17 @@ if (first_time) { first_time = FALSE; exp_init_pty(); exp_init_tty(); + expDiagLogPtrSet(expDiagLogU); + expErrnoMsgSet(Tcl_ErrnoMsg); } if (!file || !argv) sysreturn(EINVAL); if (!argv[0] || strcmp(file,argv[0])) { - debuglog("expect: warning: file (%s) != argv[0] (%s)\n", + exp_debuglog("expect: warning: file (%s) != argv[0] (%s)\n", file, argv[0]?argv[0]:""); } #ifdef PTYTRAP_DIES @@ -218,11 +2328,11 @@ slave_write_ioctls++; #endif #endif /*PTYTRAP_DIES*/ if (exp_autoallocpty) { - if (0 > (exp_pty[0] = getptymaster())) sysreturn(ENODEV); + if (0 > (exp_pty[0] = exp_getptymaster())) sysreturn(ENODEV); } fcntl(exp_pty[0],F_SETFD,1); /* close on exec */ #ifdef PTYTRAP_DIES exp_slave_control(exp_pty[0],1);*/ #endif @@ -234,18 +2344,30 @@ if (-1 == (pipe(sync_fds))) { return -1; } if (-1 == (pipe(sync2_fds))) { + close(sync_fds[0]); + close(sync_fds[1]); + return -1; + } + + if (-1 == pipe(status_pipe)) { + close(sync_fds[0]); + close(sync_fds[1]); + close(sync2_fds[0]); + close(sync2_fds[1]); return -1; } if ((exp_pid = fork()) == -1) return(-1); if (exp_pid) { /* parent */ close(sync_fds[1]); close(sync2_fds[0]); + close(status_pipe[1]); + if (!exp_autoallocpty) close(exp_pty[1]); #ifdef PTYTRAP_DIES #ifdef HAVE_PTYTRAP if (exp_autoallocpty) { @@ -274,43 +2396,68 @@ /* * wait for slave to initialize pty before allowing * user to send to it */ - debuglog("parent: waiting for sync byte\r\n"); + exp_debuglog("parent: waiting for sync byte\r\n"); cc = read(sync_fds[0],&sync_byte,1); if (cc == -1) { - fprintf(stderr,"parent sync byte read: %s\r\n",Tcl_ErrnoMsg(errno)); - exit(-1); + exp_errorlog("parent sync byte read: %s\r\n",Tcl_ErrnoMsg(errno)); + return -1; } /* turn on detection of eof */ exp_slave_control(exp_pty[0],1); /* * tell slave to go on now now that we have initialized pty */ - debuglog("parent: telling child to go ahead\r\n"); + exp_debuglog("parent: telling child to go ahead\r\n"); cc = write(sync2_fds[1]," ",1); if (cc == -1) { - errorlog("parent sync byte write: %s\r\n",Tcl_ErrnoMsg(errno)); - exit(-1); + exp_errorlog("parent sync byte write: %s\r\n",Tcl_ErrnoMsg(errno)); + return -1; } - debuglog("parent: now unsynchronized from child\r\n"); + exp_debuglog("parent: now unsynchronized from child\r\n"); close(sync_fds[0]); close(sync2_fds[1]); + /* see if child's exec worked */ + + retry: + switch (read(status_pipe[0],&child_errno,sizeof child_errno)) { + case -1: + if (errno == EINTR) goto retry; + /* well it's not really the child's errno */ + /* but it can be treated that way */ + child_errno = errno; + break; + case 0: + /* child's exec succeeded */ + child_errno = 0; + break; + default: + /* child's exec failed; err contains exec's errno */ + waitpid(exp_pid, NULL, 0); + errno = child_errno; + exp_pty[0] = -1; + } + close(status_pipe[0]); return(exp_pty[0]); } - /* child process - do not return from here! all errors must exit() */ + /* + * child process - do not return from here! all errors must exit() + */ close(sync_fds[0]); close(sync2_fds[1]); + close(status_pipe[0]); + fcntl(status_pipe[1],F_SETFD,1); /* close on exec */ #ifdef CRAY (void) close(exp_pty[0]); #endif @@ -326,20 +2473,14 @@ #ifdef DO_SETSID setsid(); #else #ifdef SYSV3 #ifndef CRAY - setpgrp(); + exp_setpgrp(); #endif /* CRAY */ #else /* !SYSV3 */ -#ifdef MIPS_BSD - /* required on BSD side of MIPS OS */ -# include - syscall(SYS_setpgrp); -#endif - setpgrp(0,0); -/* setpgrp(0,getpid());*/ /* make a new pgrp leader */ + exp_setpgrp(); #ifdef TIOCNOTTY ttyfd = open("/dev/tty", O_RDWR); if (ttyfd >= 0) { (void) ioctl(ttyfd, TIOCNOTTY, (char *)0); @@ -361,20 +2502,20 @@ close(1); close(2); /* since we closed fd 0, open of pty slave must return fd 0 */ - if (0 > (exp_pty[1] = getptyslave(exp_ttycopy,exp_ttyinit, + if (0 > (exp_pty[1] = exp_getptyslave(exp_ttycopy,exp_ttyinit, exp_stty_init))) { restore_error_fd fprintf(stderr,"open(slave pty): %s\n",Tcl_ErrnoMsg(errno)); exit(-1); } /* sanity check */ if (exp_pty[1] != 0) { restore_error_fd - fprintf(stderr,"getptyslave: slave = %d but expected 0\n", + fprintf(stderr,"exp_getptyslave: slave = %d but expected 0\n", exp_pty[1]); exit(-1); } } else { if (exp_pty[1] != 0) { @@ -394,17 +2535,24 @@ #if defined(TIOCSCTTY) && !defined(sun) && !defined(hpux) /* 4.3+BSD way to acquire controlling terminal */ /* according to Stevens - Adv. Prog..., p 642 */ #ifdef __QNX__ /* posix in general */ if (tcsetct(0, getpid()) == -1) { + restore_error_fd + expErrorLog("failed to get controlling terminal using TIOCSCTTY"); + exit(-1); + } #else - if (ioctl(0,TIOCSCTTY,(char *)0) < 0) { + (void) ioctl(0,TIOCSCTTY,(char *)0); + /* ignore return value - on some systems, it is defined but it + * fails and it doesn't seem to cause any problems. Or maybe + * it works but returns a bogus code. Noone seems to be able + * to explain this to me. The systems are an assortment of + * different linux systems (and FreeBSD 2.5), RedHat 5.2 and + * Debian 2.0 + */ #endif - restore_error_fd - fprintf(stderr,"failed to get controlling terminal using TIOCSCTTY"); - exit(-1); - } #endif #ifdef CRAY (void) setsid(); (void) ioctl(0,TCSETCTTY,0); @@ -488,32 +2636,29 @@ } /* tell parent that we are done setting up pty */ /* The actual char sent back is irrelevant. */ - /* debuglog("child: telling parent that pty is initialized\r\n");*/ + /* exp_debuglog("child: telling parent that pty is initialized\r\n");*/ cc = write(sync_fds[1]," ",1); if (cc == -1) { restore_error_fd fprintf(stderr,"child: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno)); exit(-1); } close(sync_fds[1]); /* wait for master to let us go on */ - /* debuglog("child: waiting for go ahead from parent\r\n"); */ - -/* close(master); /* force master-side close so we can read */ cc = read(sync2_fds[0],&sync_byte,1); if (cc == -1) { restore_error_fd - errorlog("child: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno)); + exp_errorlog("child: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno)); exit(-1); } close(sync2_fds[0]); - /* debuglog("child: now unsynchronized from parent\r\n"); */ + /* exp_debuglog("child: now unsynchronized from parent\r\n"); */ /* (possibly multiple) masters are closed automatically due to */ /* earlier fcntl(,,CLOSE_ON_EXEC); */ /* just in case, allow user to explicitly close other files */ @@ -521,17 +2666,18 @@ /* allow user to do anything else to child */ if (exp_child_exec_prelude) (*exp_child_exec_prelude)(); (void) execvp(file,argv); - /* Unfortunately, by now we've closed fd's to stderr, logfile and - debugfile. - The only reasonable thing to do is to send back the error as - part of the program output. This will be picked up in an - expect or interact command. - */ - fprintf(stderr,"execvp(%s): %s\n",file,Tcl_ErrnoMsg(errno)); + + /* Unfortunately, by now we've closed fd's to stderr, logfile + * and debugfile. The only reasonable thing to do is to send + * *back the error as part of the program output. This will + * be *picked up in an expect or interact command. + */ + + write(status_pipe[1], &errno, sizeof errno); exit(-1); /*NOTREACHED*/ } /* returns fd of master side of pty */ @@ -611,11 +2757,15 @@ { #ifdef REARM_SIG signal(SIGALRM,sigalarm_handler); #endif +#ifdef HAVE_SIGLONGJMP + siglongjmp(exp_readenv,1); +#else longjmp(exp_readenv,1); +#endif /* HAVE_SIGLONGJMP */ } /* interruptable read */ static int i_read(fd,fp,buffer,length,timeout) @@ -635,11 +2785,15 @@ if (timeout > 0) alarm(timeout); /* restart read if setjmp returns 0 (first time) or 2 (EXP_RESTART). */ /* abort if setjmp returns 1 (EXP_ABORT). */ +#ifdef HAVE_SIGLONGJMP + if (EXP_ABORT != sigsetjmp(exp_readenv,1)) { +#else if (EXP_ABORT != setjmp(exp_readenv)) { +#endif /* HAVE_SIGLONGJMP */ exp_reading = TRUE; if (fd == -1) { int c; c = getc(fp); if (c == EOF) { @@ -819,11 +2973,11 @@ /* continue, so we can do matches over multiple buffers */ if (buf_length == bufsiz) { int first_half, second_half; if (exp_full_buffer) { - debuglog("expect: full buffer\r\n"); + exp_debuglog("expect: full buffer\r\n"); exp_match = exp_buffer; exp_match_end = exp_buffer + buf_length; exp_buffer_end = exp_match_end; return_normally(EXP_FULLBUFFER); } @@ -845,11 +2999,11 @@ /* * check for timeout */ if ((exp_timeout >= 0) && ((remtime < 0) || polled)) { - debuglog("expect: timeout\r\n"); + exp_debuglog("expect: timeout\r\n"); exp_match_end = exp_buffer; return_normally(EXP_TIMEOUT); } /* @@ -864,42 +3018,42 @@ exp_buffer_end, bufsiz - buf_length, remtime); if (cc == 0) { - debuglog("expect: eof\r\n"); + exp_debuglog("expect: eof\r\n"); return_normally(EXP_EOF); /* normal EOF */ } else if (cc == -1) { /* abnormal EOF */ /* ptys produce EIO upon EOF - sigh */ if (i_read_errno == EIO) { /* convert to EOF indication */ - debuglog("expect: eof\r\n"); + exp_debuglog("expect: eof\r\n"); return_normally(EXP_EOF); } - debuglog("expect: error (errno = %d)\r\n",i_read_errno); + exp_debuglog("expect: error (errno = %d)\r\n",i_read_errno); return_errno(i_read_errno); } else if (cc == -2) { - debuglog("expect: timeout\r\n"); + exp_debuglog("expect: timeout\r\n"); exp_match_end = exp_buffer; return_normally(EXP_TIMEOUT); } old_length = buf_length; buf_length += cc; exp_buffer_end += buf_length; - if (logfile_all || (loguser && logfile)) { - fwrite(exp_buffer + old_length,1,cc,logfile); + if (exp_logfile_all || (exp_loguser && exp_logfile)) { + fwrite(exp_buffer + old_length,1,cc,exp_logfile); } - if (loguser) fwrite(exp_buffer + old_length,1,cc,stdout); - if (debugfile) fwrite(exp_buffer + old_length,1,cc,debugfile); + if (exp_loguser) fwrite(exp_buffer + old_length,1,cc,stdout); + if (exp_debugfile) fwrite(exp_buffer + old_length,1,cc,exp_debugfile); /* if we wrote to any logs, flush them */ - if (debugfile) fflush(debugfile); - if (loguser) { + if (exp_debugfile) fflush(exp_debugfile); + if (exp_loguser) { fflush(stdout); - if (logfile) fflush(logfile); + if (exp_logfile) fflush(exp_logfile); } /* remove nulls from input, so we can use C-style strings */ /* doing it here lets them be sent to the screen, just */ /* in case they are involved in formatting operations */ @@ -911,16 +3065,16 @@ exp_buffer_end = exp_buffer + buf_length; *exp_buffer_end = '\0'; exp_match_end = exp_buffer; after_read: - debuglog("expect: does {%s} match ",exp_printify(exp_buffer)); + exp_debuglog("expect: does {%s} match ",exp_printify(exp_buffer)); /* pattern supplied */ for (ec=ecases;ec->type != exp_end;ec++) { int matched = -1; - debuglog("{%s}? ",exp_printify(ec->pattern)); + exp_debuglog("{%s}? ",exp_printify(ec->pattern)); if (ec->type == exp_glob) { int offset; matched = Exp_StringMatch(exp_buffer,ec->pattern,&offset); if (matched >= 0) { exp_match = exp_buffer + offset; @@ -953,14 +3107,14 @@ fprintf(stderr,"r.e. match (pattern %s) failed: %s",ec->pattern,TclGetRegError()); } } if (matched != -1) { - debuglog("yes\nexp_buffer is {%s}\n", + exp_debuglog("yes\nexp_buffer is {%s}\n", exp_printify(exp_buffer)); return_normally(ec->value); - } else debuglog("no\n"); + } else exp_debuglog("no\n"); } /* * Update current time and remaining time. * Don't bother if we are waiting forever or polling. @@ -1169,22 +3323,17 @@ #ifdef POSIX setsid(); #else #ifdef SYSV3 /* put process in our own pgrp, and lose controlling terminal */ - setpgrp(); + exp_setpgrp(); signal(SIGHUP,SIG_IGN); if (fork()) exit(0); /* first child exits (as per Stevens, */ /* UNIX Network Programming, p. 79-80) */ /* second child process continues as daemon */ #else /* !SYSV3 */ -#ifdef MIPS_BSD - /* required on BSD side of MIPS OS */ -# include - syscall(SYS_setpgrp); -#endif - setpgrp(0,getpid()); /* put process in our own pgrp */ + exp_setpgrp(); /* Pyramid lacks this defn */ #ifdef TIOCNOTTY ttyfd = open("/dev/tty", O_RDWR); if (ttyfd >= 0) { /* zap controlling terminal if we had one */ @@ -1194,5 +3343,81 @@ #endif /* TIOCNOTTY */ #endif /* SYSV3 */ #endif /* POSIX */ return(0); } + +/* send to log if open and debugging enabled */ +/* send to stderr if debugging enabled */ +/* use this function for recording unusual things in the log */ +/*VARARGS*/ +void +exp_debuglog TCL_VARARGS_DEF(char *,arg1) +{ + char *fmt; + va_list args; + + fmt = TCL_VARARGS_START(char *,arg1,args); + if (exp_debugfile) vfprintf(exp_debugfile,fmt,args); + if (exp_is_debugging) { + vfprintf(stderr,fmt,args); + if (exp_logfile) vfprintf(exp_logfile,fmt,args); + } + + va_end(args); +} + + +/* send to log if open */ +/* send to stderr */ +/* use this function for error conditions */ +/*VARARGS*/ +void +exp_errorlog TCL_VARARGS_DEF(char *,arg1) +{ + char *fmt; + va_list args; + + fmt = TCL_VARARGS_START(char *,arg1,args); + vfprintf(stderr,fmt,args); + if (exp_debugfile) vfprintf(exp_debugfile,fmt,args); + if (exp_logfile) vfprintf(exp_logfile,fmt,args); + va_end(args); +} + +#include + +char * +exp_printify(s) +char *s; +{ + static int destlen = 0; + static char *dest = 0; + char *d; /* ptr into dest */ + unsigned int need; + + if (s == 0) return(""); + + /* worst case is every character takes 4 to printify */ + need = strlen(s)*4 + 1; + if (need > destlen) { + if (dest) ckfree(dest); + dest = ckalloc(need); + destlen = need; + } + + for (d = dest;*s;s++) { + if (*s == '\r') { + strcpy(d,"\\r"); d += 2; + } else if (*s == '\n') { + strcpy(d,"\\n"); d += 2; + } else if (*s == '\t') { + strcpy(d,"\\t"); d += 2; + } else if (isascii(*s) && isprint(*s)) { + *d = *s; d += 1; + } else { + sprintf(d,"\\x%02x",*s & 0xff); d += 4; + } + } + *d = '\0'; + return(dest); +} Index: exp_closetcl.c ================================================================== --- exp_closetcl.c +++ exp_closetcl.c @@ -1,22 +1,16 @@ +#if OBSOLETE /* exp_closetcl.c - close tcl files */ /* isolated in it's own file since it has hooks into Tcl and exp_clib user */ /* might like to avoid dragging it in */ #include "expect_cf.h" -#include "tclInt.h" void (*exp_close_in_child)() = 0; void exp_close_tcl_files() { - int i; - - /* So much for close-on-exec. Tcl doesn't mark its files that way */ - /* everything has to be closed explicitly. */ - -#if 0 -/* Not necessary with Tcl 7.5? */ - for (i=3; i #endif #include #include "exp_tty.h" -#ifdef HAVE_SYS_WAIT_H - /* ISC doesn't def WNOHANG unless _POSIX_SOURCE is def'ed */ -# ifdef WNOHANG_REQUIRES_POSIX_SOURCE -# define _POSIX_SOURCE -# endif -# include -# ifdef WNOHANG_REQUIRES_POSIX_SOURCE -# undef _POSIX_SOURCE -# endif -#endif - #include #include #if defined(SIGCLD) && !defined(SIGCHLD) #define SIGCHLD SIGCLD @@ -86,29 +75,33 @@ #include "exp_pty.h" #ifdef TCL_DEBUGGER #include "tcldbg.h" #endif +/* + * These constants refer to the UTF string that encodes a null character. + */ + +#define NULL_STRING "\300\200" /* hex C080 */ +#define NULL_LENGTH 2 + #define SPAWN_ID_VARNAME "spawn_id" -int getptymaster(); -int getptyslave(); +int exp_getptymaster(); +int exp_getptyslave(); int exp_forked = FALSE; /* whether we are child process */ -/* the following are just reserved addresses, to be used as ClientData */ +/* the following are use to create reserved addresses, to be used as ClientData */ /* args to be used to tell commands how they were called. */ /* The actual values won't be used, only the addresses, but I give them */ /* values out of my irrational fear the compiler might collapse them all. */ static int sendCD_error = 2; /* called as send_error */ static int sendCD_user = 3; /* called as send_user */ static int sendCD_proc = 4; /* called as send or send_spawn */ static int sendCD_tty = 6; /* called as send_tty */ -struct exp_f *exp_fs = 0; /* process array (indexed by spawn_id's) */ -int exp_fd_max = -1; /* highest fd */ - /* * expect_key is just a source for generating a unique stamp. As each * expect/interact command begins, it generates a new key and marks all * the spawn ids of interest with it. Then, if someone comes along and * marks them with yet a newer key, the old command will recognize this @@ -122,21 +115,33 @@ * interact commands to reexamine the state of the world and adjust * accordingly. */ int exp_configure_count = 0; -/* this message is required because fopen sometimes fails to set errno */ -/* Apparently, it "does the user a favor" and doesn't even call open */ -/* if the file name is bizarre enough. This means we can't handle fopen */ -/* with the obvious trivial logic. */ -static char *open_failed = "could not open - odd file name?"; - #ifdef HAVE_PTYTRAP /* slaveNames provides a mapping from the pty slave names to our */ /* spawn id entry. This is needed only on HPs for stty, sigh. */ static Tcl_HashTable slaveNames; #endif /* HAVE_PTYTRAP */ + +typedef struct ThreadSpecificData { + /* + * List of all exp channels currently open. This is per thread and is + * used to match up fd's to channels, which rarely occurs. + */ + + ExpState *stdinout; + ExpState *stderrX; /* grr....stderr is a macro */ + ExpState *devtty; + ExpState *any; /* for any_spawn_id */ + + Tcl_Channel *diagChannel; + Tcl_DString diagDString; + int diagEnabled; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; #ifdef FULLTRAPS static void init_traps(traps) RETSIGTYPE (*traps[])(); @@ -157,61 +162,83 @@ /*va_dcl*/ { Tcl_Interp *interp; char *fmt; va_list args; + char buffer[2000]; interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args); - /*va_start(args);*/ - /*interp = va_arg(args,Tcl_Interp *);*/ fmt = va_arg(args,char *); - vsprintf(interp->result,fmt,args); + vsprintf(buffer,fmt,args); + Tcl_SetResult(interp,buffer,TCL_VOLATILE); va_end(args); } -/* returns handle if fd is usable, 0 if not */ -struct exp_f * -exp_fd2f(interp,fd,opened,adjust,msg) +/* returns current ExpState or 0. If 0, may be immediately followed by return TCL_ERROR. */ +struct ExpState * +expStateCurrent(interp,opened,adjust,any) Tcl_Interp *interp; -int fd; -int opened; /* check not closed */ -int adjust; /* adjust buffer sizes */ -char *msg; -{ - if (fd >= 0 && fd <= exp_fd_max && (exp_fs[fd].valid)) { - struct exp_f *f = exp_fs + fd; - - /* following is a little tricky, do not be tempted do the */ - /* 'usual' boolean simplification */ - if ((!opened) || !f->user_closed) { - if (adjust) exp_adjust(f); - return f; - } - } - - exp_error(interp,"%s: invalid spawn id (%d)",msg,fd); +int opened; +int adjust; +int any; +{ + static char *user_spawn_id = "exp0"; + + char *name = exp_get_var(interp,SPAWN_ID_VARNAME); + if (!name) name = user_spawn_id; + + return expStateFromChannelName(interp,name,opened,adjust,any,SPAWN_ID_VARNAME); +} + +ExpState * +expStateCheck(interp,esPtr,open,adjust,msg) + Tcl_Interp *interp; + ExpState *esPtr; + int open; + int adjust; + char *msg; +{ + if (open && !esPtr->open) { + exp_error(interp,"%s: spawn id %s not open",msg,esPtr->name); + return(0); + } + if (adjust) expAdjust(esPtr); + return esPtr; +} + +ExpState * +expStateFromChannelName(interp,name,open,adjust,any,msg) + Tcl_Interp *interp; + char *name; + int open; + int adjust; + char *msg; +{ + ExpState *esPtr; + Tcl_Channel channel; + char *chanName; + + if (any) { + if (0 == strcmp(name,EXP_SPAWN_ID_ANY_LIT)) { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->any; + } + } + + channel = Tcl_GetChannel(interp,name,(int *)0); + if (!channel) return(0); + + chanName = Tcl_GetChannelName(channel); + if (!isExpChannelName(chanName)) { + exp_error(interp,"%s: %s is not an expect channel - use spawn -open to convert",msg,chanName); return(0); -} - -#if 0 -/* following routine is not current used, but might be later */ -/* returns fd or -1 if no such entry */ -static int -pid_to_fd(pid) -int pid; -{ - int fd; - - for (fd=0;fd<=exp_fd_max;fd++) { - if (exp_fs[fd].pid == pid) return(fd); - } - return 0; -} -#endif - -/* Tcl needs commands in writable space */ -static char close_cmd[] = "close"; + } + + esPtr = (ExpState *)Tcl_GetChannelInstanceData(channel); + + return expStateCheck(interp,esPtr,open,adjust,msg); +} /* zero out the wait status field */ static void exp_wait_zero(status) WAIT_STATUS_TYPE *status; @@ -221,49 +248,23 @@ for (i=0;ibuffer) { - ckfree(f->buffer); - f->buffer = 0; - f->msize = 0; - f->size = 0; - f->printed = 0; - f->echoed = 0; - if (f->fg_armed) { - exp_event_disarm(f-exp_fs); - f->fg_armed = FALSE; - } - ckfree(f->lower); - } - f->fg_armed = FALSE; +/* called just before an ExpState entry is about to be invalidated */ +void +exp_state_prep_for_invalidation(interp,esPtr) +Tcl_Interp *interp; +ExpState *esPtr; +{ + exp_ecmd_remove_state_direct_and_indirect(interp,esPtr); + + exp_configure_count++; + + if (esPtr->fg_armed) { + exp_event_disarm_fg(esPtr); + } } /*ARGSUSED*/ void exp_trap_on(master) @@ -278,292 +279,205 @@ int exp_trap_off(name) char *name; { #ifdef HAVE_PTYTRAP - int master; - struct exp_f *f; - int enable = 0; - - Tcl_HashEntry *entry = Tcl_FindHashEntry(&slaveNames,name); - if (!entry) { - debuglog("exp_trap_off: no entry found for %s\n",name); - return -1; - } - - f = (struct exp_f *)Tcl_GetHashValue(entry); - master = f - exp_fs; - - exp_slave_control(master,0); - - return master; -#else - return name[0]; /* pacify lint, use arg and return something */ -#endif -} - -/*ARGSUSED*/ -void -sys_close(fd,f) -int fd; -struct exp_f *f; -{ - /* Ignore close errors. Some systems are really odd and */ - /* return errors for no evident reason. Anyway, receiving */ - /* an error upon pty-close doesn't mean anything anyway as */ - /* far as I know. */ - close(fd); - f->sys_closed = TRUE; - -#ifdef HAVE_PTYTRAP - if (f->slave_name) { - Tcl_HashEntry *entry; - - entry = Tcl_FindHashEntry(&slaveNames,f->slave_name); - Tcl_DeleteHashEntry(entry); - - ckfree(f->slave_name); - f->slave_name = 0; - } -#endif -} - -/* given a Tcl file identifier, close it */ -static void -close_tcl_file(interp,file_id) -Tcl_Interp *interp; -char *file_id; -{ - Tcl_VarEval(interp,"close ",file_id,(char *)0); - -#if 0 /* old Tcl 7.6 code */ - char *argv[3]; - Tcl_CmdInfo info; - - argv[0] = close_cmd; - argv[1] = file_id; - argv[2] = 0; - - Tcl_ResetResult(interp); - Tcl_GetCommandInfo(interp,"close",&info); - if (0 == Tcl_GetCommandInfo(interp,"close",&info)) { - info.clientData = 0; - } - (void) Tcl_CloseCmd(info.clientData,interp,2,argv); -#endif -} - - -/* close all connections -The kernel would actually do this by default, however Tcl is going to -come along later and try to reap its exec'd processes. If we have -inherited any via spawn -open, Tcl can hang if we don't close the -connections first. -*/ - -void -exp_close_all(interp) -Tcl_Interp *interp; -{ - int fd; - - for (fd=0;fd<=exp_fd_max;fd++) { - if (exp_fs[fd].valid) { - exp_close(interp,fd); - } - } -} - -int -exp_close(interp,fd) -Tcl_Interp *interp; -int fd; -{ - struct exp_f *f = exp_fd2f(interp,fd,1,0,"close"); - if (!f) return(TCL_ERROR); - - f->user_closed = TRUE; - - if (f->slave_fd != EXP_NOFD) close(f->slave_fd); -#if 0 - if (f->tcl_handle) { - ckfree(f->tcl_handle); - if ((f - exp_fs) != f->tcl_output) close(f->tcl_output); - } -#endif - sys_close(fd,f); - - if (f->tcl_handle) { - if ((f - exp_fs) != f->tcl_output) close(f->tcl_output); - - if (!f->leaveopen) { - /* - * Ignore errors from close; they report things like - * broken pipeline, etc, which don't affect our - * subsequent handling. - */ - - close_tcl_file(interp,f->tcl_handle); - - ckfree(f->tcl_handle); - f->tcl_handle = 0; - } - } - - exp_f_prep_for_invalidation(interp,f); - - if (f->user_waited) { - f->valid = FALSE; - } else { - exp_busy(fd); - f->sys_closed = FALSE; - } - - return(TCL_OK); -} - -static struct exp_f * -fd_new(fd,pid) -int fd; -int pid; -{ - int i, low; - struct exp_f *newfs; /* temporary, so we don't lose old exp_fs */ - - /* resize table if nec */ - if (fd > exp_fd_max) { - if (!exp_fs) { /* no fd's yet allocated */ - newfs = (struct exp_f *)ckalloc(sizeof(struct exp_f)*(fd+1)); - low = 0; - } else { /* enlarge fd table */ - newfs = (struct exp_f *)ckrealloc((char *)exp_fs,sizeof(struct exp_f)*(fd+1)); - low = exp_fd_max+1; - } - exp_fs = newfs; - exp_fd_max = fd; - for (i = low; i <= exp_fd_max; i++) { /* init new fd entries */ - exp_fs[i].valid = FALSE; - exp_fs[i].fd_ptr = (int *)ckalloc(sizeof(int)); - *exp_fs[i].fd_ptr = i; - -/* exp_fs[i].ptr = (struct exp_f **)ckalloc(sizeof(struct exp_fs *));*/ - - } - -#if 0 - for (i = 0; i <= exp_fd_max; i++) { /* update all indirect ptrs */ - *exp_fs[i].ptr = exp_fs + i; - } -#endif - } - - /* this could happen if user does "spawn -open stdin" I suppose */ - if (exp_fs[fd].valid) return exp_fs+fd; - - /* close down old table entry if nec */ - exp_fs[fd].pid = pid; - exp_fs[fd].size = 0; - exp_fs[fd].msize = 0; - exp_fs[fd].buffer = 0; - exp_fs[fd].printed = 0; - exp_fs[fd].echoed = 0; - exp_fs[fd].rm_nulls = exp_default_rm_nulls; - exp_fs[fd].parity = exp_default_parity; - exp_fs[fd].key = expect_key++; - exp_fs[fd].force_read = FALSE; - exp_fs[fd].fg_armed = FALSE; -#if TCL_MAJOR_VERSION < 8 - /* Master must be inited each time because Tcl could have alloc'd */ - /* this fd and shut it down (deallocating the FileHandle) behind */ - /* our backs */ - exp_fs[fd].Master = Tcl_GetFile((ClientData)fd,TCL_UNIX_FD); - exp_fs[fd].MasterOutput = 0; - exp_fs[fd].Slave = 0; -#endif /* TCL_MAJOR_VERSION < 8 */ - exp_fs[fd].tcl_handle = 0; - exp_fs[fd].slave_fd = EXP_NOFD; -#ifdef HAVE_PTYTRAP - exp_fs[fd].slave_name = 0; -#endif /* HAVE_PTYTRAP */ - exp_fs[fd].umsize = exp_default_match_max; - exp_fs[fd].valid = TRUE; - exp_fs[fd].user_closed = FALSE; - exp_fs[fd].sys_closed = FALSE; - exp_fs[fd].user_waited = FALSE; - exp_fs[fd].sys_waited = FALSE; - exp_fs[fd].bg_interp = 0; - exp_fs[fd].bg_status = unarmed; - exp_fs[fd].bg_ecount = 0; - - return exp_fs+fd; -} - -#if 0 -void -exp_global_init(eg,duration,location) -struct expect_global *eg; -int duration; -int location; -{ - eg->ecases = 0; - eg->ecount = 0; - eg->i_list = 0; - eg->duration = duration; - eg->location = location; -} -#endif + ExpState *esPtr; + int enable = 0; + + Tcl_HashEntry *entry = Tcl_FindHashEntry(&slaveNames,name); + if (!entry) { + expDiagLog("exp_trap_off: no entry found for %s\n",name); + return -1; + } + + esPtr = (ExpState *)Tcl_GetHashValue(entry); + + exp_slave_control(esPtr->fdin,0); + + return esPtr->fdin; +#else + return name[0]; /* pacify lint, use arg and return something */ +#endif +} + +static +void +expBusy(esPtr) + ExpState *esPtr; +{ + int x = open("/dev/null",0); + if (x != esPtr->fdin) { + fcntl(x,F_DUPFD,esPtr->fdin); + close(x); + } + expCloseOnExec(esPtr->fdin); + esPtr->fdBusy = TRUE; +} + +int +exp_close(interp,esPtr) +Tcl_Interp *interp; +ExpState *esPtr; +{ + if (0 == expStateCheck(interp,esPtr,1,0,"close")) return TCL_ERROR; + esPtr->open = FALSE; + + /* + * Ignore close errors from ptys. Ptys on some systems return errors for + * no evident reason. Anyway, receiving an error upon pty-close doesn't + * mean anything anyway as far as I know. + */ + + close(esPtr->fdin); + if (esPtr->fd_slave != EXP_NOFD) close(esPtr->fd_slave); + if (esPtr->fdin != esPtr->fdout) close(esPtr->fdout); + + if (esPtr->channel_orig && !esPtr->leaveopen) { + /* + * Ignore close errors from Tcl channels. They indicate things + * like broken pipelines, etc, which don't affect our + * subsequent handling. + */ + Tcl_VarEval(interp,"close ",Tcl_GetChannelName(esPtr->channel_orig), + (char *)0); + } + +#ifdef HAVE_PTYTRAP + if (esPtr->slave_name) { + Tcl_HashEntry *entry; + + entry = Tcl_FindHashEntry(&slaveNames,esPtr->slave_name); + Tcl_DeleteHashEntry(entry); + + ckfree(esPtr->slave_name); + esPtr->slave_name = 0; + } +#endif + + exp_state_prep_for_invalidation(interp,esPtr); + + if (esPtr->user_waited) { + if (esPtr->registered) { + Tcl_UnregisterChannel(interp,esPtr->channel); + /* at this point esPtr may have been freed so don't touch it + any longer */ + } + } else { + expBusy(esPtr); + } + + return(TCL_OK); +} + +/* report whether this ExpState represents special spawn_id_any */ +/* we need a separate function because spawn_id_any is thread-specific */ +/* and can't be seen outside this file */ +expStateAnyIs(esPtr) + ExpState *esPtr; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return (esPtr == tsdPtr->any); +} + +expDevttyIs(esPtr) + ExpState *esPtr; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return (esPtr == tsdPtr->devtty); +} + +int +expStdinoutIs(esPtr) +ExpState *esPtr; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return (tsdPtr->stdinout == esPtr); +} + +ExpState * +expStdinoutGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return tsdPtr->stdinout; +} + +ExpState * +expDevttyGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return tsdPtr->devtty; +} void exp_init_spawn_id_vars(interp) Tcl_Interp *interp; { - Tcl_SetVar(interp,"user_spawn_id",EXP_SPAWN_ID_USER_LIT,0); - Tcl_SetVar(interp,"error_spawn_id",EXP_SPAWN_ID_ERROR_LIT,0); - - /* note that the user_spawn_id is NOT /dev/tty which could */ - /* (at least in theory anyway) be later re-opened on a different */ - /* fd, while stdin might have been redirected away from /dev/tty */ - - if (exp_dev_tty != -1) { - char dev_tty_str[10]; - sprintf(dev_tty_str,"%d",exp_dev_tty); - Tcl_SetVar(interp,"tty_spawn_id",dev_tty_str,0); - } -} - -void -exp_init_spawn_ids() -{ - /* note whether 0,1,2 are connected to a terminal so that if we */ - /* disconnect, we can shut these down. We would really like to */ - /* test if 0,1,2 are our controlling tty, but I don't know any */ - /* way to do that portably. Anyway, the likelihood of anyone */ - /* disconnecting after redirecting to a non-controlling tty is */ - /* virtually zero. */ - - fd_new(0,isatty(0)?exp_getpid:EXP_NOPID); - fd_new(1,isatty(1)?exp_getpid:EXP_NOPID); - fd_new(2,isatty(2)?exp_getpid:EXP_NOPID); - - if (exp_dev_tty != -1) { - fd_new(exp_dev_tty,exp_getpid); - } - - /* really should be in interpreter() but silly to do on every call */ - exp_adjust(&exp_fs[0]); -} - -void -exp_close_on_exec(fd) + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_SetVar(interp, "user_spawn_id", tsdPtr->stdinout->name,0); + Tcl_SetVar(interp,"error_spawn_id", tsdPtr->stderrX->name,0); + Tcl_SetVar(interp, "any_spawn_id", EXP_SPAWN_ID_ANY_LIT,0); + + /* user_spawn_id is NOT /dev/tty which could (at least in theory + * anyway) be later re-opened on a different fd, while stdin might + * have been redirected away from /dev/tty + */ + + if (exp_dev_tty != -1) { + Tcl_SetVar(interp,"tty_spawn_id",tsdPtr->devtty->name,0); + } +} + +void +exp_init_spawn_ids(interp) + Tcl_Interp *interp; +{ + static ExpState any_placeholder; /* can be shared process-wide */ + + /* note whether 0,1,2 are connected to a terminal so that if we */ + /* disconnect, we can shut these down. We would really like to */ + /* test if 0,1,2 are our controlling tty, but I don't know any */ + /* way to do that portably. Anyway, the likelihood of anyone */ + /* disconnecting after redirecting to a non-controlling tty is */ + /* virtually zero. */ + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->stdinout = expCreateChannel(interp,0,1,isatty(0)?exp_getpid:EXP_NOPID); + tsdPtr->stdinout->keepForever = 1; + /* hmm, now here's an example of a output-only descriptor!! */ + tsdPtr->stderrX = expCreateChannel(interp,2,2,isatty(2)?exp_getpid:EXP_NOPID); + tsdPtr->stderrX->keepForever = 1; + + if (exp_dev_tty != -1) { + tsdPtr->devtty = expCreateChannel(interp,exp_dev_tty,exp_dev_tty,exp_getpid); + tsdPtr->devtty->keepForever = 1; + } + + /* set up a dummy channel to give us something when we need to find out if + people have passed us "any_spawn_id" */ + tsdPtr->any = &any_placeholder; +} + +void +expCloseOnExec(fd) int fd; { - (void) fcntl(fd,F_SETFD,1); + (void) fcntl(fd,F_SETFD,1); } #define STTY_INIT "stty_init" #if 0 +/* + * DEBUGGING UTILITIES - DON'T DELETE */ static void show_pgrp(fd,string) int fd; char *string; { @@ -586,27 +500,45 @@ if (-1 == ioctl(fd,TIOCSETPGRP,&pgrp)) perror("TIOCSETPGRP"); if (-1 == ioctl(fd,TIOCSPGRP,&pgrp)) perror("TIOCSPGRP"); if (-1 == tcsetpgrp(fd,pgrp)) perror("tcsetpgrp"); } #endif + +static +void +expSetpgrp() +{ +#ifdef MIPS_BSD + /* required on BSD side of MIPS OS */ +# include + syscall(SYS_setpgrp); +#endif + +#ifdef SETPGRP_VOID + (void) setpgrp(); +#else + (void) setpgrp(0,0); +#endif +} + /*ARGSUSED*/ static void -set_slave_name(f,name) -struct exp_f *f; +set_slave_name(esPtr,name) +ExpState *esPtr; char *name; { #ifdef HAVE_PTYTRAP int newptr; Tcl_HashEntry *entry; /* save slave name */ - f->slave_name = ckalloc(strlen(exp_pty_slave_name)+1); - strcpy(f->slave_name,exp_pty_slave_name); + esPtr->slave_name = ckalloc(strlen(exp_pty_slave_name)+1); + strcpy(esPtr->slave_name,exp_pty_slave_name); entry = Tcl_CreateHashEntry(&slaveNames,exp_pty_slave_name,&newptr); - Tcl_SetHashValue(entry,(ClientData)f); + Tcl_SetHashValue(entry,(ClientData)esPtr); #endif /* HAVE_PTYTRAP */ } /* arguments are passed verbatim to execvp() */ /*ARGSUSED*/ @@ -615,574 +547,447 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - int slave; - int pid; - char **a; - /* tell Saber to ignore non-use of ttyfd */ - /*SUPPRESS 591*/ - int errorfd; /* place to stash fileno(stderr) in child */ + ExpState *esPtr = 0; + int slave; + int pid; + char **a; + /* tell Saber to ignore non-use of ttyfd */ + /*SUPPRESS 591*/ + int errorfd; /* place to stash fileno(stderr) in child */ /* while we're setting up new stderr */ - int ttyfd; - int master; - int write_master; /* write fd of Tcl-opened files */ - int ttyinit = TRUE; - int ttycopy = TRUE; - int echo = TRUE; - int console = FALSE; - int pty_only = FALSE; + int ttyfd; + int master; + int write_master; /* write fd of Tcl-opened files */ + int ttyinit = TRUE; + int ttycopy = TRUE; + int echo = TRUE; + int console = FALSE; + int pty_only = FALSE; #ifdef FULLTRAPS /* Allow user to reset signals in child */ /* The following array contains indicates */ /* whether sig should be DFL or IGN */ /* ERR is used to indicate no initialization */ - RETSIGTYPE (*traps[NSIG])(); + RETSIGTYPE (*traps[NSIG])(); #endif - int ignore[NSIG]; /* if true, signal in child is ignored */ + int ignore[NSIG]; /* if true, signal in child is ignored */ /* if false, signal gets default behavior */ - int i; /* trusty overused temporary */ - - char *argv0 = argv[0]; - char *openarg = 0; - int leaveopen = FALSE; - FILE *readfilePtr; - FILE *writefilePtr; - int rc, wc; - char *stty_init; - int slave_write_ioctls = 1; + int i; /* trusty overused temporary */ + + char *argv0 = argv[0]; + char *chanName = 0; + int leaveopen = FALSE; + int rc, wc; + char *stty_init; + int slave_write_ioctls = 1; /* by default, slave will be write-ioctled this many times */ - int slave_opens = 3; + int slave_opens = 3; /* by default, slave will be opened this many times */ /* first comes from initial allocation */ /* second comes from stty */ /* third is our own signal that stty is done */ - int sync_fds[2]; - int sync2_fds[2]; - int status_pipe[2]; - int child_errno; - char sync_byte; - - char buf[4]; /* enough space for a string literal */ - /* representing a file descriptor */ - Tcl_DString dstring; - Tcl_DStringInit(&dstring); - -#ifdef FULLTRAPS - init_traps(&traps); -#endif - /* don't ignore any signals in child by default */ - for (i=1;i0;argc--,argv++) { - if (streq(*argv,"-nottyinit")) { - ttyinit = FALSE; - slave_write_ioctls--; - slave_opens--; - } else if (streq(*argv,"-nottycopy")) { - ttycopy = FALSE; - } else if (streq(*argv,"-noecho")) { - echo = FALSE; - } else if (streq(*argv,"-console")) { - console = TRUE; - } else if (streq(*argv,"-pty")) { - pty_only = TRUE; - } else if (streq(*argv,"-open")) { - if (argc < 2) { - exp_error(interp,"usage: -open file-identifier"); - return TCL_ERROR; - } - openarg = argv[1]; - argc--; argv++; - } else if (streq(*argv,"-leaveopen")) { - if (argc < 2) { - exp_error(interp,"usage: -open file-identifier"); - return TCL_ERROR; - } - openarg = argv[1]; - leaveopen = TRUE; - argc--; argv++; - } else if (streq(*argv,"-ignore")) { - int sig; - - if (argc < 2) { - exp_error(interp,"usage: -ignore signal"); - return TCL_ERROR; - } - sig = exp_string_to_signal(interp,argv[1]); - if (sig == -1) { - exp_error(interp,"usage: -ignore %s: unknown signal name",argv[1]); - return TCL_ERROR; - } - ignore[sig] = TRUE; - argc--; argv++; -#ifdef FULLTRAPS - } else if (streq(*argv,"-trap")) { - /* argv[1] is action */ - /* argv[2] is list of signals */ - - RETSIGTYPE (*sig_handler)(); - int n; /* number of signals in list */ - char **list; /* list of signals */ - - if (argc < 3) { - exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN"); - return TCL_ERROR; - } - - if (0 == strcmp(argv[2],"SIG_DFL")) { - sig_handler = SIG_DFL; - } else if (0 == strcmp(argv[2],"SIG_IGN")) { - sig_handler = SIG_IGN; - } else { - exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN"); - return TCL_ERROR; - } - - if (TCL_OK != Tcl_SplitList(interp,argv[1],&n,&list)) { - errorlog("%s\r\n",interp->result); - exp_error(interp,"usage: -trap {siglist} ..."); - return TCL_ERROR; - } - for (i=0;i0;argc--,argv++) { + if (streq(*argv,"-nottyinit")) { + ttyinit = FALSE; + slave_write_ioctls--; + slave_opens--; + } else if (streq(*argv,"-nottycopy")) { + ttycopy = FALSE; + } else if (streq(*argv,"-noecho")) { + echo = FALSE; + } else if (streq(*argv,"-console")) { + console = TRUE; + } else if (streq(*argv,"-pty")) { + pty_only = TRUE; + } else if (streq(*argv,"-open")) { + if (argc < 2) { + exp_error(interp,"usage: -open file-identifier"); + return TCL_ERROR; + } + chanName = argv[1]; + argc--; argv++; + } else if (streq(*argv,"-leaveopen")) { + if (argc < 2) { + exp_error(interp,"usage: -open file-identifier"); + return TCL_ERROR; + } + chanName = argv[1]; + leaveopen = TRUE; + argc--; argv++; + } else if (streq(*argv,"-ignore")) { + int sig; + + if (argc < 2) { + exp_error(interp,"usage: -ignore signal"); + return TCL_ERROR; + } + sig = exp_string_to_signal(interp,argv[1]); + if (sig == -1) { + exp_error(interp,"usage: -ignore %s: unknown signal name",argv[1]); + return TCL_ERROR; + } + ignore[sig] = TRUE; + argc--; argv++; +#ifdef FULLTRAPS + } else if (streq(*argv,"-trap")) { + /* argv[1] is action */ + /* argv[2] is list of signals */ + + RETSIGTYPE (*sig_handler)(); + int n; /* number of signals in list */ + char **list; /* list of signals */ + + if (argc < 3) { + exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN"); + return TCL_ERROR; + } + + if (0 == strcmp(argv[2],"SIG_DFL")) { + sig_handler = SIG_DFL; + } else if (0 == strcmp(argv[2],"SIG_IGN")) { + sig_handler = SIG_IGN; + } else { + exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN"); + return TCL_ERROR; + } + + if (TCL_OK != Tcl_SplitList(interp,argv[1],&n,&list)) { + expErrorLogU(interp->result); + expErrorLogU("\r\n"); + exp_error(interp,"usage: -trap {siglist} ..."); + return TCL_ERROR; + } + for (i=0;i (master = getptymaster())) { - /* - * failed to allocate pty, try and figure out why - * so we can suggest to user what to do about it. - */ - - int count; - int testfd; - - if (exp_pty_error) { - exp_error(interp,"%s",exp_pty_error); - return TCL_ERROR; - } - - count = 0; - for (i=3;i<=exp_fd_max;i++) { - count += exp_fs[i].valid; - } - if (count > 10) { - exp_error(interp,"The system only has a finite number of ptys and you have many of them in use. The usual reason for this is that you forgot (or didn't know) to call \"wait\" after closing each of them."); - return TCL_ERROR; - } - - testfd = open("/",0); - close(testfd); - - if (testfd != -1) { - exp_error(interp,"The system has no more ptys. Ask your system administrator to create more."); - } else { - exp_error(interp,"- You have too many files are open. Close some files or increase your per-process descriptor limit."); - } - return(TCL_ERROR); - } -#ifdef PTYTRAP_DIES - if (!pty_only) exp_slave_control(master,1); -#endif /* PTYTRAP_DIES */ + exp_pty_slave_name = 0; + + Tcl_ReapDetachedProcs(); + + if (!chanName) { + if (echo) { + expStdoutLogU(argv0,0); + for (a = argv;*a;a++) { + expStdoutLogU(" ",0); + expStdoutLogU(*a,0); + } + expStdoutLogU("\r\n",0); + } + + if (0 > (master = exp_getptymaster())) { + /* + * failed to allocate pty, try and figure out why + * so we can suggest to user what to do about it. + */ + + int testfd; + + if (exp_pty_error) { + exp_error(interp,"%s",exp_pty_error); + return TCL_ERROR; + } + + if (expChannelCountGet() > 10) { + exp_error(interp,"The system only has a finite number of ptys and you have many of them in use. The usual reason for this is that you forgot (or didn't know) to call \"wait\" after closing each of them."); + return TCL_ERROR; + } + + testfd = open("/",0); + close(testfd); + + if (testfd != -1) { + exp_error(interp,"The system has no more ptys. Ask your system administrator to create more."); + } else { + exp_error(interp,"- You have too many files are open. Close some files or increase your per-process descriptor limit."); + } + return(TCL_ERROR); + } + + /* ordinarily channel creation takes care of close-on-exec + * but because that will occur *after* fork, force close-on-exec + * now in this case. + */ + expCloseOnExec(master); #define SPAWN_OUT "spawn_out" - Tcl_SetVar2(interp,SPAWN_OUT,"slave,name",exp_pty_slave_name,0); - } else { - Tcl_Channel chan; - int mode; -#if TCL_MAJOR_VERSION < 8 - Tcl_File tclReadFile, tclWriteFile; -#endif /* TCL_MAJOR_VERSION < 8 */ - int rfd, wfd; - - if (echo) exp_log(0,"%s [open ...]\r\n",argv0); - -#if TCL7_4 - rc = Tcl_GetOpenFile(interp,openarg,0,1,&readfilePtr); - wc = Tcl_GetOpenFile(interp,openarg,1,1,&writefilePtr); - - /* fail only if both descriptors are bad */ - if (rc == TCL_ERROR && wc == TCL_ERROR) { - return TCL_ERROR; - } - - master = fileno((rc == TCL_OK)?readfilePtr:writefilePtr); - - /* make a new copy of file descriptor */ - if (-1 == (write_master = master = dup(master))) { - exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); - return TCL_ERROR; - } - - /* if writefilePtr is different, dup that too */ - if ((rc == TCL_OK) && (wc == TCL_OK) && (fileno(writefilePtr) != fileno(readfilePtr))) { - if (-1 == (write_master = dup(fileno(writefilePtr)))) { - exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); - return TCL_ERROR; - } - exp_close_on_exec(write_master); - } - -#endif - if (!(chan = Tcl_GetChannel(interp,openarg,&mode))) { - return TCL_ERROR; - } - if (!mode) { - exp_error(interp,"channel is neither readable nor writable"); - return TCL_ERROR; - } - if (mode & TCL_READABLE) { -#if TCL_MAJOR_VERSION < 8 - tclReadFile = Tcl_GetChannelFile(chan, TCL_READABLE); - rfd = (int)Tcl_GetFileInfo(tclReadFile, (int *)0); -#else - if (TCL_ERROR == Tcl_GetChannelHandle(chan, TCL_READABLE, (ClientData) &rfd)) { - return TCL_ERROR; - } -#endif - } - if (mode & TCL_WRITABLE) { -#if TCL_MAJOR_VERSION < 8 - tclWriteFile = Tcl_GetChannelFile(chan, TCL_WRITABLE); - wfd = (int)Tcl_GetFileInfo(tclWriteFile, (int *)0); -#else - if (TCL_ERROR == Tcl_GetChannelHandle(chan, TCL_WRITABLE, (ClientData) &wfd)) { - return TCL_ERROR; - } -#endif - } - - master = ((mode & TCL_READABLE)?rfd:wfd); - - /* make a new copy of file descriptor */ - if (-1 == (write_master = master = dup(master))) { - exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); - return TCL_ERROR; - } - - /* if writefilePtr is different, dup that too */ - if ((mode & TCL_READABLE) && (mode & TCL_WRITABLE) && (wfd != rfd)) { - if (-1 == (write_master = dup(wfd))) { - exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); - return TCL_ERROR; - } - exp_close_on_exec(write_master); - } - - /* - * It would be convenient now to tell Tcl to close its - * file descriptor. Alas, if involved in a pipeline, Tcl - * will be unable to complete a wait on the process. - * So simply remember that we meant to close it. We will - * do so later in our own close routine. - */ - } - - /* much easier to set this, than remember all masters */ - exp_close_on_exec(master); - - if (openarg || pty_only) { - struct exp_f *f; - - f = fd_new(master,EXP_NOPID); - - if (openarg) { - /* save file# handle */ - f->tcl_handle = ckalloc(strlen(openarg)+1); - strcpy(f->tcl_handle,openarg); - - f->tcl_output = write_master; -#if 0 - /* save fd handle for output */ - if (wc == TCL_OK) { -/* f->tcl_output = fileno(writefilePtr);*/ - f->tcl_output = write_master; - } else { - /* if we actually try to write to it at some */ - /* time in the future, then this will cause */ - /* an error */ - f->tcl_output = master; - } -#endif - - f->leaveopen = leaveopen; - } - - if (exp_pty_slave_name) set_slave_name(f,exp_pty_slave_name); - - /* make it appear as if process has been waited for */ - f->sys_waited = TRUE; - exp_wait_zero(&f->wait); - - /* tell user id of new process */ - sprintf(buf,"%d",master); - Tcl_SetVar(interp,SPAWN_ID_VARNAME,buf,0); - - if (!openarg) { - char value[20]; - int dummyfd1, dummyfd2; - - /* - * open the slave side in the same process to support - * the -pty flag. - */ - - /* Start by working around a bug in Tcl's exec. - It closes all the file descriptors from 3 to it's - own fd_max which inappropriately closes our slave - fd. To avoid this, open several dummy fds. Then - exec's fds will fall below ours. - Note that if you do something like pre-allocating - a bunch before using them or generating a pipeline, - then this code won't help. - Instead you'll need to add the right number of - explicit Tcl open's of /dev/null. - The right solution is fix Tcl's exec so it is not - so cavalier. - */ - - dummyfd1 = open("/dev/null",0); - dummyfd2 = open("/dev/null",0); - - if (0 > (f->slave_fd = getptyslave(ttycopy,ttyinit, - stty_init))) { - exp_error(interp,"open(slave pty): %s\r\n",Tcl_PosixError(interp)); - return TCL_ERROR; - } - - close(dummyfd1); - close(dummyfd2); - - exp_slave_control(master,1); - - sprintf(value,"%d",f->slave_fd); - Tcl_SetVar2(interp,SPAWN_OUT,"slave,fd",value,0); - } - sprintf(interp->result,"%d",EXP_NOPID); - debuglog("spawn: returns {%s}\r\n",interp->result); - - return TCL_OK; - } - - if (NULL == (argv[0] = Tcl_TildeSubst(interp,argv[0],&dstring))) { - goto parent_error; - } - - if (-1 == pipe(sync_fds)) { - exp_error(interp,"too many programs spawned? could not create pipe: %s",Tcl_PosixError(interp)); - goto parent_error; - } - - if (-1 == pipe(sync2_fds)) { - close(sync_fds[0]); - close(sync_fds[1]); - exp_error(interp,"too many programs spawned? could not create pipe: %s",Tcl_PosixError(interp)); - goto parent_error; - } - - if (-1 == pipe(status_pipe)) { - close(sync_fds[0]); - close(sync_fds[1]); - close(sync2_fds[0]); - close(sync2_fds[1]); - } - - if ((pid = fork()) == -1) { - exp_error(interp,"fork: %s",Tcl_PosixError(interp)); - goto parent_error; - } - - if (pid) { /* parent */ - struct exp_f *f; - - close(sync_fds[1]); - close(sync2_fds[0]); - close(status_pipe[1]); - - f = fd_new(master,pid); - - if (exp_pty_slave_name) set_slave_name(f,exp_pty_slave_name); + Tcl_SetVar2(interp,SPAWN_OUT,"slave,name",exp_pty_slave_name,0); + + if (pty_only) { + write_master = master; + } + } else { + /* + * process "-open $channel" + */ + int mode; + int rfd, wfd; + + if (echo) { + expStdoutLogU(argv0,0); + expStdoutLogU(" [open ...]\r\n",0); + } + if (!(channel = Tcl_GetChannel(interp,chanName,&mode))) { + return TCL_ERROR; + } + if (!mode) { + exp_error(interp,"channel is neither readable nor writable"); + return TCL_ERROR; + } + if (mode & TCL_READABLE) { + if (TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, (ClientData) &rfd)) { + return TCL_ERROR; + } + } + if (mode & TCL_WRITABLE) { + if (TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, (ClientData) &wfd)) { + return TCL_ERROR; + } + } + master = ((mode & TCL_READABLE)?rfd:wfd); + + /* make a new copy of file descriptor */ + if (-1 == (write_master = master = dup(master))) { + exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); + return TCL_ERROR; + } + + /* if writefilePtr is different, dup that too */ + if ((mode & TCL_READABLE) && (mode & TCL_WRITABLE) && (wfd != rfd)) { + if (-1 == (write_master = dup(wfd))) { + exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); + return TCL_ERROR; + } + } + + /* + * It would be convenient now to tell Tcl to close its + * file descriptor. Alas, if involved in a pipeline, Tcl + * will be unable to complete a wait on the process. + * So simply remember that we meant to close it. We will + * do so later in our own close routine. + */ + } + + if (chanName || pty_only) { + esPtr = expCreateChannel(interp,master,write_master,EXP_NOPID); + + if (chanName) { + esPtr->channel_orig = channel; + esPtr->leaveopen = leaveopen; + } + + if (exp_pty_slave_name) set_slave_name(esPtr,exp_pty_slave_name); + + /* make it appear as if process has been waited for */ + esPtr->sys_waited = TRUE; + exp_wait_zero(&esPtr->wait); + + /* tell user of new spawn id */ + Tcl_SetVar(interp,SPAWN_ID_VARNAME,esPtr->name,0); + + if (!chanName) { + char value[20]; + + /* + * open the slave side in the same process to support + * the -pty flag. + */ + + if (0 > (esPtr->fd_slave = exp_getptyslave(ttycopy,ttyinit, + stty_init))) { + exp_error(interp,"open(slave pty): %s\r\n",Tcl_PosixError(interp)); + return TCL_ERROR; + } + + exp_slave_control(master,1); + + sprintf(value,"%d",esPtr->fd_slave); + Tcl_SetVar2(interp,SPAWN_OUT,"slave,fd",value,0); + } + sprintf(interp->result,"%d",EXP_NOPID); + expDiagLog("spawn: returns {%s}\r\n",interp->result); + + return TCL_OK; + } + + if (NULL == (argv[0] = Tcl_TranslateFileName(interp,argv[0],&dstring))) { + goto parent_error; + } + + if (-1 == pipe(sync_fds)) { + exp_error(interp,"too many programs spawned? could not create pipe: %s",Tcl_PosixError(interp)); + goto parent_error; + } + + if (-1 == pipe(sync2_fds)) { + close(sync_fds[0]); + close(sync_fds[1]); + exp_error(interp,"too many programs spawned? could not create pipe: %s",Tcl_PosixError(interp)); + goto parent_error; + } + + if (-1 == pipe(status_pipe)) { + close(sync_fds[0]); + close(sync_fds[1]); + close(sync2_fds[0]); + close(sync2_fds[1]); + } + + if ((pid = fork()) == -1) { + exp_error(interp,"fork: %s",Tcl_PosixError(interp)); + goto parent_error; + } + + if (pid) { /* parent */ + close(sync_fds[1]); + close(sync2_fds[0]); + close(status_pipe[1]); + + esPtr = expCreateChannel(interp,master,master,pid); + + if (exp_pty_slave_name) set_slave_name(esPtr,exp_pty_slave_name); #ifdef CRAY - setptypid(pid); -#endif - - -#if PTYTRAP_DIES -#ifdef HAVE_PTYTRAP - - while (slave_opens) { - int cc; - cc = exp_wait_for_slave_open(master); -#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300) - if (cc == TIOCSCTTY) slave_opens = 0; -#endif - if (cc == TIOCOPEN) slave_opens--; - if (cc == -1) { - exp_error(interp,"failed to trap slave pty"); - goto parent_error; - } - } - -#if 0 - /* trap initial ioctls in a feeble attempt to not block */ - /* the initially. If the process itself ioctls */ - /* /dev/tty, such blocks will be trapped later */ - /* during normal event processing */ - - /* initial slave ioctl */ - while (slave_write_ioctls) { - int cc; - - cc = exp_wait_for_slave_open(master); -#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300) - if (cc == TIOCSCTTY) slave_write_ioctls = 0; -#endif - if (cc & IOC_IN) slave_write_ioctls--; - else if (cc == -1) { - exp_error(interp,"failed to trap slave pty"); - goto parent_error; - } - } -#endif /*0*/ - -#endif /* HAVE_PTYTRAP */ -#endif /* PTYTRAP_DIES */ - - /* - * wait for slave to initialize pty before allowing - * user to send to it - */ - - debuglog("parent: waiting for sync byte\r\n"); - while (((rc = read(sync_fds[0],&sync_byte,1)) < 0) && (errno == EINTR)) { - /* empty */; - } - if (rc == -1) { - errorlog("parent: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno)); - exit(-1); - } - - /* turn on detection of eof */ - exp_slave_control(master,1); - - /* - * tell slave to go on now now that we have initialized pty - */ - - debuglog("parent: telling child to go ahead\r\n"); - wc = write(sync2_fds[1]," ",1); - if (wc == -1) { - errorlog("parent: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno)); - exit(-1); - } - - debuglog("parent: now unsynchronized from child\r\n"); - close(sync_fds[0]); - close(sync2_fds[1]); - - /* see if child's exec worked */ + setptypid(pid); +#endif + + /* + * wait for slave to initialize pty before allowing + * user to send to it + */ + + expDiagLog("parent: waiting for sync byte\r\n"); + while (((rc = read(sync_fds[0],&sync_byte,1)) < 0) && (errno == EINTR)) { + /* empty */; + } + if (rc == -1) { + expErrorLogU("parent: sync byte read: "); + expErrorLogU(Tcl_ErrnoMsg(errno)); + expErrorLogU("\r\n"); + exit(-1); + } + + /* turn on detection of eof */ + exp_slave_control(master,1); + + /* + * tell slave to go on now now that we have initialized pty + */ + + expDiagLog("parent: telling child to go ahead\r\n"); + wc = write(sync2_fds[1]," ",1); + if (wc == -1) { + expErrorLog("parent: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno)); + exit(-1); + } + + expDiagLog("parent: now unsynchronized from child\r\n"); + close(sync_fds[0]); + close(sync2_fds[1]); + + /* see if child's exec worked */ retry: - switch (read(status_pipe[0],&child_errno,sizeof child_errno)) { + switch (read(status_pipe[0],&child_errno,sizeof child_errno)) { case -1: - if (errno == EINTR) goto retry; - /* well it's not really the child's errno */ - /* but it can be treated that way */ - child_errno = errno; - break; + if (errno == EINTR) goto retry; + /* well it's not really the child's errno */ + /* but it can be treated that way */ + child_errno = errno; + break; case 0: - /* child's exec succeeded */ - child_errno = 0; - break; + /* child's exec succeeded */ + child_errno = 0; + break; default: - /* child's exec failed; err contains exec's errno */ - waitpid(pid, NULL, 0); - /* in order to get Tcl to set errorcode, we must */ - /* hand set errno */ - errno = child_errno; - exp_error(interp, "couldn't execute \"%s\": %s", - argv[0],Tcl_PosixError(interp)); - goto parent_error; - } - close(status_pipe[0]); - - - /* tell user id of new process */ - sprintf(buf,"%d",master); - Tcl_SetVar(interp,SPAWN_ID_VARNAME,buf,0); - - sprintf(interp->result,"%d",pid); - debuglog("spawn: returns {%s}\r\n",interp->result); - - Tcl_DStringFree(&dstring); - return(TCL_OK); -parent_error: - Tcl_DStringFree(&dstring); - return TCL_ERROR; + /* child's exec failed; err contains exec's errno */ + waitpid(pid, NULL, 0); + /* in order to get Tcl to set errorcode, we must */ + /* hand set errno */ + errno = child_errno; + exp_error(interp, "couldn't execute \"%s\": %s", + argv[0],Tcl_PosixError(interp)); + goto parent_error; + } + close(status_pipe[0]); + + /* tell user of new spawn id */ + Tcl_SetVar(interp,SPAWN_ID_VARNAME,esPtr->name,0); + + sprintf(interp->result,"%d",pid); + expDiagLog("spawn: returns {%s}\r\n",interp->result); + + Tcl_DStringFree(&dstring); + return(TCL_OK); } /* child process - do not return from here! all errors must exit() */ close(sync_fds[0]); close(sync2_fds[1]); close(status_pipe[0]); - exp_close_on_exec(status_pipe[1]); + expCloseOnExec(status_pipe[1]); if (exp_dev_tty != -1) { close(exp_dev_tty); exp_dev_tty = -1; } @@ -1203,20 +1008,14 @@ #ifdef DO_SETSID setsid(); #else #ifdef SYSV3 #ifndef CRAY - setpgrp(); + expSetpgrp(); #endif /* CRAY */ #else /* !SYSV3 */ -#ifdef MIPS_BSD - /* required on BSD side of MIPS OS */ -# include - syscall(SYS_setpgrp); -#endif - setpgrp(0,0); -/* setpgrp(0,getpid());*/ /* make a new pgrp leader */ + expSetpgrp(); /* Pyramid lacks this defn */ #ifdef TIOCNOTTY ttyfd = open("/dev/tty", O_RDWR); if (ttyfd >= 0) { @@ -1240,22 +1039,27 @@ close(1); close(2); /* since we closed fd 0, open of pty slave must return fd 0 */ - /* since getptyslave may have to run stty, (some of which work on fd */ - /* 0 and some of which work on 1) do the dup's inside getptyslave. */ + /* since exp_getptyslave may have to run stty, (some of which work on fd */ + /* 0 and some of which work on 1) do the dup's inside exp_getptyslave. */ - if (0 > (slave = getptyslave(ttycopy,ttyinit,stty_init))) { + if (0 > (slave = exp_getptyslave(ttycopy,ttyinit,stty_init))) { restore_error_fd - errorlog("open(slave pty): %s\r\n",Tcl_ErrnoMsg(errno)); + + if (exp_pty_error) { + expErrorLog("open(slave pty): %s\r\n",exp_pty_error); + } else { + expErrorLog("open(slave pty): %s\r\n",Tcl_ErrnoMsg(errno)); + } exit(-1); } /* sanity check */ if (slave != 0) { restore_error_fd - errorlog("getptyslave: slave = %d but expected 0\n",slave); + expErrorLog("exp_getptyslave: slave = %d but expected 0\n",slave); exit(-1); } /* The test for hpux may have to be more specific. In particular, the */ /* code should be skipped on the hp9000s300 and hp9000s720 (but there */ @@ -1267,26 +1071,33 @@ /* according to Stevens - Adv. Prog..., p 642 */ /* Oops, it appears that the CIBAUD is on Linux also */ /* so let's try without... */ #ifdef __QNX__ if (tcsetct(0, getpid()) == -1) { + restore_error_fd + expErrorLog("failed to get controlling terminal using TIOCSCTTY"); + exit(-1); + } #else - if (ioctl(0,TIOCSCTTY,(char *)0) < 0) { + (void) ioctl(0,TIOCSCTTY,(char *)0); + /* ignore return value - on some systems, it is defined but it + * fails and it doesn't seem to cause any problems. Or maybe + * it works but returns a bogus code. Noone seems to be able + * to explain this to me. The systems are an assortment of + * different linux systems (and FreeBSD 2.5), RedHat 5.2 and + * Debian 2.0 + */ #endif - restore_error_fd - errorlog("failed to get controlling terminal using TIOCSCTTY"); - exit(-1); - } #endif #ifdef CRAY (void) setsid(); (void) ioctl(0,TCSETCTTY,0); (void) close(0); if (open("/dev/tty", O_RDWR) < 0) { restore_error_fd - errorlog("open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno)); + expErrorLog("open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno)); exit(-1); } (void) close(1); (void) close(2); (void) dup(0); @@ -1302,11 +1113,11 @@ * bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at * least). */ if ((pid = fork()) == -1) { restore_error_fd - errorlog("second fork: %s\r\n",Tcl_ErrnoMsg(errno)); + expErrorLog("second fork: %s\r\n",Tcl_ErrnoMsg(errno)); exit(-1); } if (pid) { /* Intermediate process. */ @@ -1351,69 +1162,67 @@ for (i=1;ipid,&esPtr->wait,0); + if (esPtr->registered) { + Tcl_UnregisterChannel(interp,esPtr->channel); + } + } + return TCL_ERROR; } /*ARGSUSED*/ static int Exp_ExpPidCmd(clientData,interp,argc,argv) @@ -1420,34 +1229,34 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - struct exp_f *f; - int m = -1; - - argc--; argv++; - - for (;argc>0;argc--,argv++) { - if (streq(*argv,"-i")) { - argc--; argv++; - if (!*argv) goto usage; - m = atoi(*argv); - } else goto usage; - } - - if (m == -1) { - if (exp_update_master(interp,&m,0,0) == 0) return TCL_ERROR; - } - - if (0 == (f = exp_fd2f(interp,m,1,0,"exp_pid"))) return TCL_ERROR; - - sprintf(interp->result,"%d",f->pid); - return TCL_OK; - usage: - exp_error(interp,"usage: -i spawn_id"); - return TCL_ERROR; + char *chanName = 0; + ExpState *esPtr = 0; + + argc--; argv++; + + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-i")) { + argc--; argv++; + if (!*argv) goto usage; + chanName = *argv; + } else goto usage; + } + + if (chanName) { + if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"exp_pid"))) return TCL_ERROR; + } else { + if (!(esPtr = expStateCurrent(interp,0,0,0))) return TCL_ERROR; + } + + sprintf(interp->result,"%d",esPtr->pid); + return TCL_OK; + usage: + exp_error(interp,"usage: -i spawn_id"); + return TCL_ERROR; } /*ARGSUSED*/ static int Exp_GetpidDeprecatedCmd(clientData, interp, argc, argv) @@ -1454,30 +1263,15 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - debuglog("getpid is deprecated, use pid\r\n"); + expDiagLog("getpid is deprecated, use pid\r\n"); sprintf(interp->result,"%d",getpid()); return(TCL_OK); } -/* returns current master (via out-parameter) */ -/* returns f or 0, but note that since exp_fd2f calls tcl_error, this */ -/* may be immediately followed by a "return(TCL_ERROR)"!!! */ -struct exp_f * -exp_update_master(interp,m,opened,adjust) -Tcl_Interp *interp; -int *m; -int opened; -int adjust; -{ - char *s = exp_get_var(interp,SPAWN_ID_VARNAME); - *m = (s?atoi(s):EXP_SPAWN_ID_USER); - return(exp_fd2f(interp,*m,opened,adjust,(s?s:EXP_SPAWN_ID_USER_LIT))); -} - /*ARGSUSED*/ static int Exp_SleepCmd(clientData,interp,argc,argv) ClientData clientData; Tcl_Interp *interp; @@ -1492,41 +1286,25 @@ } return(exp_dsleep(interp,(double)atof(*argv))); } -/* write exactly this many bytes, i.e. retry partial writes */ -/* returns 0 for success, -1 for failure */ +/* if this works, exact_write should disappear and function should + call Tcl_WriteChars directly */ static int -exact_write(fd,buffer,rembytes) -int fd; +exact_write(esPtr,buffer,rembytes) /* INTL */ +ExpState *esPtr; char *buffer; int rembytes; { - int cc; - - while (rembytes) { - if (-1 == (cc = write(fd,buffer,rembytes))) return(-1); - if (0 == cc) { - /* This shouldn't happen but I'm told that it does */ - /* nonetheless (at least on SunOS 4.1.3). Since */ - /* this is not a documented return value, the most */ - /* reasonable thing is to complain here and retry */ - /* in the hopes that is some transient condition. */ - sleep(1); - exp_debuglog("write() failed to write anything but returned - sleeping and retrying...\n"); - } - - buffer += cc; - rembytes -= cc; - } - return(0); + Tcl_WriteChars(esPtr->channel,buffer,rembytes); + return(0); } struct slow_arg { - int size; - double time; + int size; + double time; }; /* returns 0 for success, -1 for failure */ static int get_slow_args(interp,x) @@ -1554,24 +1332,24 @@ return(0); } /* returns 0 for success, -1 for failure, pos. for Tcl return value */ static int -slow_write(interp,fd,buffer,rembytes,arg) +slow_write(interp,esPtr,buffer,rembytes,arg) /* INTL */ Tcl_Interp *interp; -int fd; +ExpState *esPtr; char *buffer; int rembytes; struct slow_arg *arg; { int rc; while (rembytes > 0) { int len; - + len = (arg->sizesize:rembytes); - if (0 > exact_write(fd,buffer,len)) return(-1); + if (0 > exact_write(esPtr,buffer,len)) return(-1); rembytes -= arg->size; buffer += arg->size; /* skip sleep after last write */ if (rembytes > 0) { @@ -1653,53 +1431,55 @@ /* I've added a max time and an "alpha_eow" that captures the slight */ /* but noticable change in human typists when hitting end-of-word */ /* transitions. */ /* returns 0 for success, -1 for failure, pos. for Tcl return value */ static int -human_write(interp,fd,buffer,arg) +human_write(interp,esPtr,buffer,arg) /* INTL */ Tcl_Interp *interp; -int fd; +ExpState *esPtr; char *buffer; struct human_arg *arg; { - char *sp; - float t; - float alpha; - int wc; - int in_word = TRUE; - - debuglog("human_write: avg_arr=%f/%f 1/shape=%f min=%f max=%f\r\n", - arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max); - - for (sp = buffer;*sp;sp++) { - /* use the end-of-word alpha at eow transitions */ - if (in_word && (ispunct(*sp) || isspace(*sp))) - alpha = arg->alpha_eow; - else alpha = arg->alpha; - in_word = !(ispunct(*sp) || isspace(*sp)); - - t = alpha * pow(-log((double)unit_random()),arg->c); - - /* enforce min and max times */ - if (tmin) t = arg->min; - else if (t>arg->max) t = arg->max; - -/*fprintf(stderr,"\nwriting <%c> but first sleep %f seconds\n",*sp,t);*/ + char *sp; + int size; + float t; + float alpha; + int wc; + int in_word = TRUE; + Tcl_UniChar ch; + + expDiagLog("human_write: avg_arr=%f/%f 1/shape=%f min=%f max=%f\r\n", + arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max); + + for (sp = buffer;*sp;sp += size) { + size = Tcl_UtfToUniChar(sp, &ch); + /* use the end-of-word alpha at eow transitions */ + if (in_word && (Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch))) + alpha = arg->alpha_eow; + else alpha = arg->alpha; + in_word = !(Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch)); + + t = alpha * pow(-log((double)unit_random()),arg->c); + + /* enforce min and max times */ + if (tmin) t = arg->min; + else if (t>arg->max) t = arg->max; + /* skip sleep before writing first character */ - if (sp != buffer) { - wc = exp_dsleep(interp,(double)t); - if (wc > 0) return wc; - } - - wc = write(fd,sp,1); - if (0 > wc) return(wc); - } - return(0); + if (sp != buffer) { + wc = exp_dsleep(interp,(double)t); + if (wc > 0) return wc; + } + + wc = Tcl_WriteChars(esPtr->channel, sp, size); + if (0 > wc) return(wc); + } + return(0); } struct exp_i *exp_i_pool = 0; -struct exp_fd_list *exp_fd_list_pool = 0; +struct exp_state_list *exp_state_list_pool = 0; #define EXP_I_INIT_COUNT 10 #define EXP_FD_INIT_COUNT 10 struct exp_i * @@ -1722,47 +1502,47 @@ i = exp_i_pool; exp_i_pool = exp_i_pool->next; i->value = 0; i->variable = 0; - i->fd_list = 0; + i->state_list = 0; i->ecount = 0; i->next = 0; return i; } -struct exp_fd_list * -exp_new_fd(val) -int val; -{ - int n; - struct exp_fd_list *fd; - - if (!exp_fd_list_pool) { - /* none avail, generate some new ones */ - exp_fd_list_pool = fd = (struct exp_fd_list *)ckalloc( - EXP_FD_INIT_COUNT * sizeof(struct exp_fd_list)); - for (n=0;nnext = fd+1; - } - fd->next = 0; - } - - /* now that we've made some, unlink one and give to user */ - - fd = exp_fd_list_pool; - exp_fd_list_pool = exp_fd_list_pool->next; - fd->fd = val; - /* fd->next is assumed to be changed by caller */ - return fd; +struct exp_state_list * +exp_new_state(esPtr) +ExpState *esPtr; +{ + int n; + struct exp_state_list *fd; + + if (!exp_state_list_pool) { + /* none avail, generate some new ones */ + exp_state_list_pool = fd = (struct exp_state_list *)ckalloc( + EXP_FD_INIT_COUNT * sizeof(struct exp_state_list)); + for (n=0;nnext = fd+1; + } + fd->next = 0; + } + + /* now that we've made some, unlink one and give to user */ + + fd = exp_state_list_pool; + exp_state_list_pool = exp_state_list_pool->next; + fd->esPtr = esPtr; + /* fd->next is assumed to be changed by caller */ + return fd; } void -exp_free_fd(fd_first) -struct exp_fd_list *fd_first; +exp_free_state(fd_first) +struct exp_state_list *fd_first; { - struct exp_fd_list *fd, *penultimate; + struct exp_state_list *fd, *penultimate; if (!fd_first) return; /* link entire chain back in at once by first finding last pointer */ /* making that point back to pool, and then resetting pool to this */ @@ -1769,21 +1549,21 @@ /* run to end */ for (fd = fd_first;fd;fd=fd->next) { penultimate = fd; } - penultimate->next = exp_fd_list_pool; - exp_fd_list_pool = fd_first; + penultimate->next = exp_state_list_pool; + exp_state_list_pool = fd_first; } /* free a single fd */ void -exp_free_fd_single(fd) -struct exp_fd_list *fd; +exp_free_state_single(fd) +struct exp_state_list *fd; { - fd->next = exp_fd_list_pool; - exp_fd_list_pool = fd; + fd->next = exp_state_list_pool; + exp_state_list_pool = fd; } void exp_free_i(interp,i,updateproc) Tcl_Interp *interp; @@ -1790,11 +1570,11 @@ struct exp_i *i; Tcl_VarTraceProc *updateproc; /* proc to invoke if indirect is written */ { if (i->next) exp_free_i(interp,i->next,updateproc); - exp_free_fd(i->fd_list); + exp_free_state(i->state_list); if (i->direct == EXP_INDIRECT) { Tcl_UntraceVar(interp,i->variable, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES, updateproc,(ClientData)i); @@ -1824,11 +1604,12 @@ i->next = exp_i_pool; exp_i_pool = i; } /* generate a descriptor for a "-i" flag */ -/* cannot fail */ +/* can only fail on bad direct descriptors */ +/* indirect descriptors always succeed */ struct exp_i * exp_new_i_complex(interp,arg,duration,updateproc) Tcl_Interp *interp; char *arg; /* spawn id list or a variable containing a list */ int duration; /* if we have to copy the args */ @@ -1838,11 +1619,14 @@ struct exp_i *i; char **stringp; i = exp_new_i(); + i->direct = (isExpChannelName(arg)?EXP_DIRECT:EXP_INDIRECT); +#if OBSOLETE i->direct = (isdigit(arg[0]) || (arg[0] == '-'))?EXP_DIRECT:EXP_INDIRECT; +#endif if (i->direct == EXP_DIRECT) { stringp = &i->value; } else { stringp = &i->variable; } @@ -1853,12 +1637,15 @@ strcpy(*stringp,arg); } else { *stringp = arg; } - i->fd_list = 0; - exp_i_update(interp,i); + i->state_list = 0; + if (TCL_ERROR == exp_i_update(interp,i)) { + exp_free_i(interp,i,(Tcl_VarTraceProc *)0); + return 0; + } /* if indirect, ask Tcl to tell us when variable is modified */ if (i->direct == EXP_INDIRECT) { Tcl_TraceVar(interp, i->variable, @@ -1868,92 +1655,90 @@ return i; } void -exp_i_add_fd(i,fd) -struct exp_i *i; -int fd; -{ - struct exp_fd_list *new_fd; - - new_fd = exp_new_fd(fd); - new_fd->next = i->fd_list; - i->fd_list = new_fd; -} - -/* this routine assumes i->fd is meaningful */ -void -exp_i_parse_fds(i) -struct exp_i *i; -{ - char *p = i->value; - - /* reparse it */ - while (1) { - int m; - int negative = 0; - int valid_spawn_id = 0; - - m = 0; - while (isspace(*p)) p++; - for (;;p++) { - if (*p == '-') negative = 1; - else if (isdigit(*p)) { - m = m*10 + (*p-'0'); - valid_spawn_id = 1; - } else if (*p == '\0' || isspace(*p)) break; - } - - /* we either have a spawn_id or whitespace at end of string */ - - /* skip whitespace end-of-string */ - if (!valid_spawn_id) break; - - if (negative) m = -m; - - exp_i_add_fd(i,m); - } +exp_i_add_state(i,esPtr) +struct exp_i *i; +ExpState *esPtr; +{ + struct exp_state_list *new_state; + + new_state = exp_new_state(esPtr); + new_state->next = i->state_list; + i->state_list = new_state; +} + +/* this routine assumes i->esPtr is meaningful */ +/* returns TCL_ERROR only on direct */ +/* indirects always succeed */ +static int +exp_i_parse_states(interp,i) /* INTL */ +Tcl_Interp *interp; +struct exp_i *i; +{ + struct ExpState *esPtr; + char *p = i->value; + int argc; + char **argv; + int j; + + if (Tcl_SplitList(NULL, p, &argc, &argv) != TCL_OK) goto error; + + for (j = 0; j < argc; j++) { + esPtr = expStateFromChannelName(interp,argv[j],1,0,0,""); + if (!esPtr) goto error; + exp_i_add_state(i,esPtr); + } + ckfree((char*)argv); + return TCL_OK; +error: + expDiagLogU("exp_i_parse_states: "); + expDiagLogU(Tcl_GetStringResult(interp)); + return TCL_ERROR; } /* updates a single exp_i struct */ -void +/* return TCL_ERROR only on direct variables */ +/* indirect variables always succeed */ +int exp_i_update(interp,i) Tcl_Interp *interp; struct exp_i *i; { - char *p; /* string representation of list of spawn ids */ - - if (i->direct == EXP_INDIRECT) { - p = Tcl_GetVar(interp,i->variable,TCL_GLOBAL_ONLY); - if (!p) { - p = ""; - exp_debuglog("warning: indirect variable %s undefined",i->variable); - } - - if (i->value) { - if (streq(p,i->value)) return; - - /* replace new value with old */ - ckfree(i->value); - } - i->value = ckalloc(strlen(p)+1); - strcpy(i->value,p); - - exp_free_fd(i->fd_list); - i->fd_list = 0; - } else { - /* no free, because this should only be called on */ - /* "direct" i's once */ - i->fd_list = 0; - } - exp_i_parse_fds(i); + char *p; /* string representation of list of spawn ids */ + + if (i->direct == EXP_INDIRECT) { + p = Tcl_GetVar(interp,i->variable,TCL_GLOBAL_ONLY); + if (!p) { + p = ""; + /* *really* big variable names could blow up expDiagLog! */ + expDiagLog("warning: indirect variable %s undefined",i->variable); + } + + if (i->value) { + if (streq(p,i->value)) return TCL_OK; + + /* replace new value with old */ + ckfree(i->value); + } + i->value = ckalloc(strlen(p)+1); + strcpy(i->value,p); + + exp_free_state(i->state_list); + i->state_list = 0; + } else { + /* no free, because this should only be called on */ + /* "direct" i's once */ + i->state_list = 0; + } + return exp_i_parse_states(interp, i); } struct exp_i * -exp_new_i_simple(fd,duration) -int fd; +exp_new_i_simple(esPtr,duration) +ExpState *esPtr; int duration; /* if we have to copy the args */ /* should only need do this in expect_before/after */ { struct exp_i *i; @@ -1960,11 +1745,11 @@ i = exp_new_i(); i->direct = EXP_DIRECT; i->duration = duration; - exp_i_add_fd(i,fd); + exp_i_add_state(i,esPtr); return i; } /*ARGSUSED*/ @@ -1973,16 +1758,12 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - char *string; - int len; - argv++; argc--; - if (argc) { if (streq(*argv,"--")) { argc--; argv++; } } @@ -1990,423 +1771,311 @@ if (argc != 1) { exp_error(interp,"usage: send [args] string"); return TCL_ERROR; } - string = *argv; - - len = strlen(string); - - if (debugfile) fwrite(string,1,len,debugfile); - if (logfile) fwrite(string,1,len,logfile); - + expLogDiagU(*argv); return(TCL_OK); } /* I've rewritten this to be unbuffered. I did this so you could shove */ /* large files through "send". If you are concerned about efficiency */ /* you should quote all your send args to make them one single argument. */ /*ARGSUSED*/ static int -Exp_SendCmd(clientData, interp, argc, argv) +Exp_SendObjCmd(clientData, interp, objc, objv) /* INTL */ ClientData clientData; Tcl_Interp *interp; -int argc; -char **argv; +int objc; +Tcl_Obj *CONST objv[]; { - int m = -1; /* spawn id (master) */ - int rc; /* final result of this procedure */ - struct human_arg human_args; - struct slow_arg slow_args; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ExpState *esPtr = 0; + int rc; /* final result of this procedure */ + struct human_arg human_args; + struct slow_arg slow_args; #define SEND_STYLE_STRING_MASK 0x07 /* mask to detect a real string arg */ #define SEND_STYLE_PLAIN 0x01 #define SEND_STYLE_HUMAN 0x02 #define SEND_STYLE_SLOW 0x04 #define SEND_STYLE_ZERO 0x10 #define SEND_STYLE_BREAK 0x20 - int send_style = SEND_STYLE_PLAIN; - int want_cooked = TRUE; - char *string; /* string to send */ - int len; /* length of string to send */ - int zeros; /* count of how many ascii zeros to send */ - - char *i_masters = 0; - struct exp_fd_list *fd; - struct exp_i *i; - char *arg; - - argv++; - argc--; - while (argc) { - arg = *argv; - if (arg[0] != '-') break; - arg++; - if (exp_flageq1('-',arg)) { /* "--" */ - argc--; argv++; - break; - } else if (exp_flageq1('i',arg)) { /* "-i" */ - argc--; argv++; - if (argc==0) { - exp_error(interp,"usage: -i spawn_id"); - return(TCL_ERROR); - } - i_masters = *argv; - argc--; argv++; - continue; - } else if (exp_flageq1('h',arg)) { /* "-h" */ - argc--; argv++; - if (-1 == get_human_args(interp,&human_args)) - return(TCL_ERROR); - send_style = SEND_STYLE_HUMAN; - continue; - } else if (exp_flageq1('s',arg)) { /* "-s" */ - argc--; argv++; - if (-1 == get_slow_args(interp,&slow_args)) - return(TCL_ERROR); - send_style = SEND_STYLE_SLOW; - continue; - } else if (exp_flageq("null",arg,1) || exp_flageq1('0',arg)) { - argc--; argv++; /* "-null" */ - if (!*argv) zeros = 1; - else { - zeros = atoi(*argv); - argc--; argv++; - if (zeros < 1) return TCL_OK; - } - send_style = SEND_STYLE_ZERO; - string = ""; - continue; - } else if (exp_flageq("raw",arg,1)) { /* "-raw" */ - argc--; argv++; - want_cooked = FALSE; - continue; - } else if (exp_flageq("break",arg,1)) { /* "-break" */ - argc--; argv++; - send_style = SEND_STYLE_BREAK; - string = ""; - continue; - } else { - exp_error(interp,"usage: unrecognized flag <-%.80s>",arg); - return TCL_ERROR; - } - } - - if (send_style & SEND_STYLE_STRING_MASK) { - if (argc != 1) { - exp_error(interp,"usage: send [args] string"); - return TCL_ERROR; - } - string = *argv; - } + int send_style = SEND_STYLE_PLAIN; + int want_cooked = TRUE; + char *string; /* string to send */ + int len = -1; /* length of string to send */ + int zeros; /* count of how many ascii zeros to send */ + + char *chanName = 0; + struct exp_state_list *state_list; + struct exp_i *i; + int j; + + static char *options[] = { + "-i", "-h", "-s", "-null", "-0", "-raw", "-break", "--", (char *)0 + }; + enum options { + SEND_SPAWNID, SEND_HUMAN, SEND_SLOW, SEND_NULL, SEND_ZERO, + SEND_RAW, SEND_BREAK, SEND_LAST + }; + + for (j = 1; j < objc; j++) { + char *name; + int index; + + name = Tcl_GetString(objv[j]); + if (name[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[j], options, "flag", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum options) index) { + case SEND_SPAWNID: + j++; + chanName = Tcl_GetString(objv[j]); + break; + + case SEND_LAST: + j++; + goto getString; + + case SEND_HUMAN: + if (-1 == get_human_args(interp,&human_args)) + return(TCL_ERROR); + send_style = SEND_STYLE_HUMAN; + break; + + case SEND_SLOW: + if (-1 == get_slow_args(interp,&slow_args)) + return(TCL_ERROR); + send_style = SEND_STYLE_SLOW; + break; + + case SEND_NULL: + case SEND_ZERO: + j++; + if (j >= objc) { + zeros = 1; + } else if (Tcl_GetIntFromObj(interp, objv[j], &zeros) + != TCL_OK) { + return TCL_ERROR; + } + if (zeros < 1) return TCL_OK; + send_style = SEND_STYLE_ZERO; + string = ""; + break; + + case SEND_RAW: + want_cooked = FALSE; + break; + + case SEND_BREAK: + send_style = SEND_STYLE_BREAK; + string = ""; + break; + } + } + + if (send_style & SEND_STYLE_STRING_MASK) { + if (j != objc-1) { + exp_error(interp,"usage: send [args] string"); + return TCL_ERROR; + } +getString: + string = Tcl_GetStringFromObj(objv[j], &len); + } else { len = strlen(string); - - if (clientData == &sendCD_user) m = 1; - else if (clientData == &sendCD_error) m = 2; - else if (clientData == &sendCD_tty) m = exp_dev_tty; - else if (!i_masters) { - /* we really do want to check if it is open */ - /* but since stdin could be closed, we have to first */ - /* get the fd and then convert it from 0 to 1 if necessary */ - if (0 == exp_update_master(interp,&m,0,0)) - return(TCL_ERROR); - } - - /* if master != -1, then it holds desired master */ - /* else i_masters does */ - - if (m != -1) { - i = exp_new_i_simple(m,EXP_TEMPORARY); - } else { - i = exp_new_i_complex(interp,i_masters,FALSE,(Tcl_VarTraceProc *)0); - } + } + + if (clientData == &sendCD_user) esPtr = tsdPtr->stdinout; + else if (clientData == &sendCD_error) esPtr = tsdPtr->stderrX; + else if (clientData == &sendCD_tty) esPtr = tsdPtr->devtty; + else if (!chanName) { + /* we want to check if it is open */ + /* but since stdin could be closed, we have to first */ + /* get the fd and then convert it from 0 to 1 if necessary */ + if (!(esPtr = expStateCurrent(interp,0,0,0))) return(TCL_ERROR); + } + + if (esPtr) { + i = exp_new_i_simple(esPtr,EXP_TEMPORARY); + } else { + i = exp_new_i_complex(interp,chanName,FALSE,(Tcl_VarTraceProc *)0); + if (!i) return TCL_ERROR; + } #define send_to_stderr (clientData == &sendCD_error) #define send_to_proc (clientData == &sendCD_proc) #define send_to_user ((clientData == &sendCD_user) || \ (clientData == &sendCD_tty)) - if (send_to_proc) { - want_cooked = FALSE; - debuglog("send: sending \"%s\" to {",dprintify(string)); - /* if closing brace doesn't appear, that's because an error */ - /* was encountered before we could send it */ - } else { - if (debugfile) - fwrite(string,1,len,debugfile); - if ((send_to_user && logfile_all) || logfile) - fwrite(string,1,len,logfile); - } - - for (fd=i->fd_list;fd;fd=fd->next) { - m = fd->fd; - - if (send_to_proc) { - debuglog(" %d ",m); - } - - /* true if called as Send with user_spawn_id */ - if (exp_is_stdinfd(m)) m = 1; - - /* check validity of each - i.e., are they open */ - if (0 == exp_fd2f(interp,m,1,0,"send")) { - rc = TCL_ERROR; - goto finish; - } - /* Check if Tcl is using a different fd for output */ - if (exp_fs[m].tcl_handle) { - m = exp_fs[m].tcl_output; - } - - if (want_cooked) string = exp_cook(string,&len); - - switch (send_style) { - case SEND_STYLE_PLAIN: - rc = exact_write(m,string,len); - break; - case SEND_STYLE_SLOW: - rc = slow_write(interp,m,string,len,&slow_args); - break; - case SEND_STYLE_HUMAN: - rc = human_write(interp,m,string,&human_args); - break; - case SEND_STYLE_ZERO: - for (;zeros>0;zeros--) rc = write(m,"",1); - /* catching error on last write is sufficient */ - rc = ((rc==1) ? 0 : -1); /* normal is 1 not 0 */ - break; - case SEND_STYLE_BREAK: - exp_tty_break(interp,m); - rc = 0; - break; - } - - if (rc != 0) { - if (rc == -1) { - exp_error(interp,"write(spawn_id=%d): %s",m,Tcl_PosixError(interp)); - rc = TCL_ERROR; - } - goto finish; - } - } - if (send_to_proc) debuglog("}\r\n"); - - rc = TCL_OK; + if (send_to_proc) { + want_cooked = FALSE; + expDiagLogU("send: sending \""); + expDiagLogU(expPrintify(string)); + expDiagLogU("\" to {"); + /* if closing brace doesn't appear, that's because an error */ + /* was encountered before we could send it */ + } else { + expLogDiagU(string); + } + + for (state_list=i->state_list;state_list;state_list=state_list->next) { + esPtr = state_list->esPtr; + + if (send_to_proc) { + expDiagLog(" %s ",esPtr->name); + } + + /* check validity of each - i.e., are they open */ + if (0 == expStateCheck(interp,esPtr,1,0,"send")) { + rc = TCL_ERROR; + goto finish; + } + if (want_cooked) string = exp_cook(string,&len); + + switch (send_style) { + case SEND_STYLE_PLAIN: + rc = exact_write(esPtr,string,len); + break; + case SEND_STYLE_SLOW: + rc = slow_write(interp,esPtr,string,len,&slow_args); + break; + case SEND_STYLE_HUMAN: + rc = human_write(interp,esPtr,string,&human_args); + break; + case SEND_STYLE_ZERO: + for (;zeros>0;zeros--) { + rc = Tcl_WriteChars(esPtr->channel, + NULL_STRING, NULL_LENGTH); + } + /* catching error on last write is sufficient */ + rc = ((rc==1) ? 0 : -1); /* normal is 1 not 0 */ + break; + case SEND_STYLE_BREAK: + exp_tty_break(interp,esPtr->fdout); + rc = 0; + break; + } + + if (rc != 0) { + if (rc == -1) { + exp_error(interp,"write(spawn_id=%d): %s",esPtr->fdout,Tcl_PosixError(interp)); + rc = TCL_ERROR; + } + goto finish; + } + } + if (send_to_proc) expDiagLogU("}\r\n"); + + rc = TCL_OK; finish: - exp_free_i(interp,i,(Tcl_VarTraceProc *)0); - return rc; + exp_free_i(interp,i,(Tcl_VarTraceProc *)0); + return rc; } /*ARGSUSED*/ static int Exp_LogFileCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - static Tcl_DString dstring; - static int first_time = TRUE; - static int current_append; /* true if currently appending */ - static char *openarg = 0; /* Tcl file identifier from -open */ - static int leaveopen = FALSE; /* true if -leaveopen was used */ - - int old_logfile_all = logfile_all; - FILE *old_logfile = logfile; - char *old_openarg = openarg; - int old_leaveopen = leaveopen; - - int aflag = FALSE; - int append = TRUE; - char *filename = 0; - char *type; - FILE *writefilePtr; - int usage_error_occurred = FALSE; - - openarg = 0; - leaveopen = FALSE; - - if (first_time) { - Tcl_DStringInit(&dstring); - first_time = FALSE; - } - - -#define usage_error if (0) ; else {\ - usage_error_occurred = TRUE;\ - goto error;\ - } - - /* when this function returns, we guarantee that if logfile_all */ - /* is TRUE, then logfile is non-zero */ - - argv++; - argc--; - for (;argc>0;argc--,argv++) { - if (streq(*argv,"-open")) { - if (!argv[1]) usage_error; - openarg = ckalloc(strlen(argv[1])+1); - strcpy(openarg,argv[1]); - argc--; argv++; - } else if (streq(*argv,"-leaveopen")) { - if (!argv[1]) usage_error; - openarg = ckalloc(strlen(argv[1])+1); - strcpy(openarg,argv[1]); - leaveopen = TRUE; - argc--; argv++; - } else if (streq(*argv,"-a")) { - aflag = TRUE; - } else if (streq(*argv,"-info")) { - if (logfile) { - if (logfile_all) strcat(interp->result,"-a "); - if (!current_append) strcat(interp->result,"-noappend "); - strcat(interp->result,Tcl_DStringValue(&dstring)); - } - return TCL_OK; - } else if (streq(*argv,"-noappend")) { - append = FALSE; - } else break; - } - - if (argc == 1) { - filename = argv[0]; - } else if (argc > 1) { - /* too many arguments */ - usage_error - } - - if (openarg && filename) { - usage_error - } - if (aflag && !(openarg || filename)) { - usage_error - } - - logfile = 0; - logfile_all = aflag; - - current_append = append; - - type = (append?"a":"w"); - - if (filename) { - filename = Tcl_TildeSubst(interp,filename,&dstring); - if (filename == NULL) { - goto error; - } else { - /* Tcl_TildeSubst doesn't store into dstring */ - /* if no ~, so force string into dstring */ - /* this is only needed so that next time around */ - /* we can get dstring for -info if necessary */ - if (Tcl_DStringValue(&dstring)[0] == '\0') { - Tcl_DStringAppend(&dstring,filename,-1); - } - } - - errno = 0; - if (NULL == (logfile = fopen(filename,type))) { - char *msg; - - if (errno == 0) { - msg = open_failed; - } else { - msg = Tcl_PosixError(interp); - } - exp_error(interp,"%s: %s",filename,msg); - Tcl_DStringFree(&dstring); - goto error; - } - } else if (openarg) { - int cc; - int fd; - Tcl_Channel chan; - int mode; -#if TCL_MAJOR_VERSION < 8 - Tcl_File tclWriteFile; -#endif /* TCL_MAJOR_VERSION < 8 */ - - Tcl_DStringTrunc(&dstring,0); - -#if TCL7_4 - cc = Tcl_GetOpenFile(interp,openarg,1,1,&writefilePtr); - if (cc == TCL_ERROR) goto error; - - if (-1 == (fd = dup(fileno(writefilePtr)))) { - exp_error(interp,"dup: %s",Tcl_PosixError(interp)); - goto error; - } -#endif - if (!(chan = Tcl_GetChannel(interp,openarg,&mode))) { - return TCL_ERROR; - } - if (!(mode & TCL_WRITABLE)) { - exp_error(interp,"channel is not writable"); - } -#if TCL_MAJOR_VERSION < 8 - tclWriteFile = Tcl_GetChannelFile(chan, TCL_WRITABLE); - fd = dup((int)Tcl_GetFileInfo(tclWriteFile, (int *)0)); -#else - if (TCL_ERROR == Tcl_GetChannelHandle(chan, TCL_WRITABLE, (ClientData) &fd)) { - goto error; - } - fd = dup(fd); -#endif - - if (!(logfile = fdopen(fd,type))) { - exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); - close(fd); - goto error; - } - - if (leaveopen) { - Tcl_DStringAppend(&dstring,"-leaveopen ",-1); - } else { - Tcl_DStringAppend(&dstring,"-open ",-1); - } - Tcl_DStringAppend(&dstring,openarg,-1); - - /* - * It would be convenient now to tell Tcl to close its - * file descriptor. Alas, if involved in a pipeline, Tcl - * will be unable to complete a wait on the process. - * So simply remember that we meant to close it. We will - * do so later in our own close routine. - */ - } - if (logfile) { - setbuf(logfile,(char *)0); - exp_close_on_exec(fileno(logfile)); - } - - if (old_logfile) { - fclose(old_logfile); - } - - if (old_openarg) { - if (!old_leaveopen) { - close_tcl_file(interp,old_openarg); - } - ckfree((char *)old_openarg); - } - - return TCL_OK; - - error: - if (old_logfile) { - logfile = old_logfile; - logfile_all = old_logfile_all; - } - - if (openarg) ckfree(openarg); - openarg = old_openarg; - leaveopen = old_leaveopen; - - if (usage_error_occurred) { - exp_error(interp,"usage: log_file [-info] [-noappend] [[-a] file] [-[leave]open [open ...]]"); - } - - return TCL_ERROR; + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + static char resultbuf[1000]; + char *chanName = 0; + int leaveOpen = FALSE; + int logAll = FALSE; + int append = TRUE; + char *filename = 0; + + argv++; + argc--; + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-open")) { + if (!argv[1]) goto usage_error; + chanName = argv[1]; + argc--; argv++; + } else if (streq(*argv,"-leaveopen")) { + if (!argv[1]) goto usage_error; + chanName = argv[1]; + leaveOpen = TRUE; + argc--; argv++; + } else if (streq(*argv,"-a")) { + logAll = TRUE; + } else if (streq(*argv,"-info")) { + resultbuf[0] = '\0'; + if (expLogChannelGet()) { + if (expLogAllGet()) strcat(resultbuf,"-a "); + if (!expLogAppendGet()) strcat(resultbuf,"-noappend "); + if (expLogFilenameGet()) { + strcat(resultbuf,expLogFilenameGet()); + } else { + if (expLogLeaveOpenGet()) { + strcat(resultbuf,"-leaveopen "); + } + strcat(resultbuf,Tcl_GetChannelName(expLogChannelGet())); + } + Tcl_SetResult(interp,resultbuf,TCL_STATIC); + } + return TCL_OK; + } else if (streq(*argv,"-noappend")) { + append = FALSE; + } else break; + } + + if (argc == 1) { + filename = argv[0]; + } else if (argc > 1) { + /* too many arguments */ + goto usage_error; + } + + if (chanName && filename) { + goto usage_error; + } + + /* check if user merely wants to change logAll (-a) */ + if (expLogChannelGet() && (chanName || filename)) { + if (filename && (0 == strcmp(filename,expLogFilenameGet()))) { + expLogAllSet(logAll); + return TCL_OK; + } else if (chanName && (0 == strcmp(filename,Tcl_GetChannelName(expLogChannelGet())))) { + expLogAllSet(logAll); + return TCL_OK; + } else { + exp_error(interp,"cannot start logging without first stopping logging"); + return TCL_ERROR; + } + } + + if (filename) { + if (TCL_ERROR == expLogChannelOpen(interp,filename,append)) { + return TCL_ERROR; + } + } else if (chanName) { + if (TCL_ERROR == expLogChannelSet(interp,chanName)) { + return TCL_ERROR; + } + } else { + expLogChannelClose(interp); + if (logAll) { + exp_error(interp,"cannot use -a without a file or channel"); + return TCL_ERROR; + } + } + expLogAllSet(logAll); + expLogLeaveOpenSet(leaveOpen); + + return TCL_OK; + + usage_error: + exp_error(interp,"usage: log_file [-info] [-noappend] [[-a] file] [-[leave]open [open ...]]"); + return TCL_ERROR; } /*ARGSUSED*/ static int Exp_LogUserCmd(clientData, interp, argc, argv) @@ -2413,24 +2082,23 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - int old_loguser = loguser; - - if (argc == 0 || (argc == 2 && streq(argv[1],"-info"))) { - /* do nothing */ - } else if (argc == 2) { - if (0 == atoi(argv[1])) loguser = FALSE; - else loguser = TRUE; - } else { - exp_error(interp,"usage: [-info|1|0]"); - } - - sprintf(interp->result,"%d",old_loguser); - - return(TCL_OK); + int old_loguser = expLogUserGet(); + + if (argc == 0 || (argc == 2 && streq(argv[1],"-info"))) { + /* do nothing */ + } else if (argc == 2) { + expLogUserSet(atoi(argv[1])); + } else { + exp_error(interp,"usage: [-info|1|0]"); + } + + sprintf(interp->result,"%d",old_loguser); + + return(TCL_OK); } #ifdef TCL_DEBUGGER /*ARGSUSED*/ static int @@ -2438,132 +2106,102 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - int now = FALSE; /* soon if FALSE, now if TRUE */ - int exp_tcl_debugger_was_available = exp_tcl_debugger_available; - - if (argc > 3) goto usage; - - if (argc == 1) { - sprintf(interp->result,"%d",exp_tcl_debugger_available); - return TCL_OK; - } - - argv++; - - while (*argv) { - if (streq(*argv,"-now")) { - now = TRUE; - argv++; - } - else break; - } - - if (!*argv) { - if (now) { - Dbg_On(interp,1); - exp_tcl_debugger_available = 1; - } else { - goto usage; - } - } else if (streq(*argv,"0")) { - Dbg_Off(interp); - exp_tcl_debugger_available = 0; - } else { - Dbg_On(interp,now); - exp_tcl_debugger_available = 1; - } - sprintf(interp->result,"%d",exp_tcl_debugger_was_available); - return(TCL_OK); - usage: - exp_error(interp,"usage: [[-now] 1|0]"); - return TCL_ERROR; -} -#endif + int now = FALSE; /* soon if FALSE, now if TRUE */ + int exp_tcl_debugger_was_available = exp_tcl_debugger_available; + + if (argc > 3) goto usage; + + if (argc == 1) { + sprintf(interp->result,"%d",exp_tcl_debugger_available); + return TCL_OK; + } + + argv++; + + while (*argv) { + if (streq(*argv,"-now")) { + now = TRUE; + argv++; + } + else break; + } + + if (!*argv) { + if (now) { + Dbg_On(interp,1); + exp_tcl_debugger_available = 1; + } else { + goto usage; + } + } else if (streq(*argv,"0")) { + Dbg_Off(interp); + exp_tcl_debugger_available = 0; + } else { + Dbg_On(interp,now); + exp_tcl_debugger_available = 1; + } + sprintf(interp->result,"%d",exp_tcl_debugger_was_available); + return(TCL_OK); + usage: + exp_error(interp,"usage: [[-now] 1|0]"); + return TCL_ERROR; +} +#endif + /*ARGSUSED*/ static int Exp_ExpInternalCmd(clientData, interp, argc, argv) ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - static Tcl_DString dstring; - static int first_time = TRUE; - int fopened = FALSE; - - if (first_time) { - Tcl_DStringInit(&dstring); - first_time = FALSE; - } - - if (argc > 1 && streq(argv[1],"-info")) { - if (debugfile) { - sprintf(interp->result,"-f %s ", - Tcl_DStringValue(&dstring)); - } - strcat(interp->result,((exp_is_debugging==0)?"0":"1")); - return TCL_OK; - } - - argv++; - argc--; - while (argc) { - if (!streq(*argv,"-f")) break; - argc--;argv++; - if (argc < 1) goto usage; - if (debugfile) fclose(debugfile); - argv[0] = Tcl_TildeSubst(interp, argv[0],&dstring); - if (argv[0] == NULL) goto error; - else { - /* Tcl_TildeSubst doesn't store into dstring */ - /* if no ~, so force string into dstring */ - /* this is only needed so that next time around */ - /* we can get dstring for -info if necessary */ - if (Tcl_DStringValue(&dstring)[0] == '\0') { - Tcl_DStringAppend(&dstring,argv[0],-1); - } - } - - errno = 0; - if (NULL == (debugfile = fopen(*argv,"a"))) { - char *msg; - - if (errno == 0) { - msg = open_failed; - } else { - msg = Tcl_PosixError(interp); - } - - exp_error(interp,"%s: %s",*argv,msg); - goto error; - } - setbuf(debugfile,(char *)0); - exp_close_on_exec(fileno(debugfile)); - fopened = TRUE; - argc--;argv++; - } - - if (argc != 1) goto usage; - - /* if no -f given, close file */ - if (fopened == FALSE && debugfile) { - fclose(debugfile); - debugfile = 0; - Tcl_DStringFree(&dstring); - } - - exp_is_debugging = atoi(*argv); - return(TCL_OK); + int newChannel = FALSE; + Tcl_Channel oldChannel; + static char resultbuf[1000]; + + if ((argc > 1) && streq(argv[1],"-info")) { + resultbuf[0] = '\0'; + oldChannel = expDiagChannelGet(); + if (oldChannel) { + sprintf(resultbuf,"-f %s ",expDiagFilename()); + } + strcat(resultbuf,expDiagToStderrGet()?"1":"0"); + Tcl_SetResult(interp,resultbuf,TCL_STATIC); + return TCL_OK; + } + + argv++; + argc--; + + while (argc) { + if (!streq(*argv,"-f")) break; + argc--;argv++; + if (argc < 1) goto usage; + expDiagChannelClose(interp); + if (TCL_OK != expDiagChannelOpen(interp,argv[0])) { + return TCL_ERROR; + } + newChannel = TRUE; + argc--;argv++; + } + + if (argc != 1) goto usage; + + /* if no -f given, close file */ + if (!newChannel) { + expDiagChannelClose(interp); + } + expDiagToStderrSet(atoi(*argv)); + return(TCL_OK); usage: - exp_error(interp,"usage: [-f file] expr"); - error: - Tcl_DStringFree(&dstring); - return TCL_ERROR; + exp_error(interp,"usage: [-f file] 0|1"); + return TCL_ERROR; } char *exp_onexit_action = 0; /*ARGSUSED*/ @@ -2602,117 +2240,96 @@ if (Tcl_GetInt(interp, *argv, &value) != TCL_OK) { return TCL_ERROR; } } - exp_exit(interp,value); + Tcl_Exit(value); /*NOTREACHED*/ } -/* so cmd table later is more intuitive */ -#define Exp_CloseObjCmd Exp_CloseCmd - /*ARGSUSED*/ static int -Exp_CloseCmd(clientData, interp, argc, argv) +Exp_CloseObjCmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; -int argc; -#if TCL_MAJOR_VERSION < 8 -char **argv; -#else -Tcl_Obj *CONST argv[]; /* Argument objects. */ -#endif -{ - int onexec_flag = FALSE; /* true if -onexec seen */ - int close_onexec; - int slave_flag = FALSE; - int m = -1; - - int argc_orig = argc; -#if TCL_MAJOR_VERSION < 8 - char **argv_orig = argv; -#else - Tcl_Obj *CONST *argv_orig = argv; -#endif - - argc--; argv++; - -#if TCL_MAJOR_VERSION < 8 -#define STARARGV *argv -#else -#define STARARGV Tcl_GetStringFromObj(*argv,(int *)0) -#endif - - for (;argc>0;argc--,argv++) { - if (streq("-i",STARARGV)) { - argc--; argv++; - if (argc == 0) { - exp_error(interp,"usage: -i spawn_id"); - return(TCL_ERROR); - } - m = atoi(STARARGV); - } else if (streq(STARARGV,"-slave")) { - slave_flag = TRUE; - } else if (streq(STARARGV,"-onexec")) { - argc--; argv++; - if (argc == 0) { - exp_error(interp,"usage: -onexec 0|1"); - return(TCL_ERROR); - } - onexec_flag = TRUE; - close_onexec = atoi(STARARGV); - } else break; - } - - if (argc) { - /* doesn't look like our format, it must be a Tcl-style file */ - /* handle. Lucky that formats are easily distinguishable. */ - /* Historical note: we used "close" long before there was a */ - /* Tcl builtin by the same name. */ - - Tcl_CmdInfo info; - Tcl_ResetResult(interp); - if (0 == Tcl_GetCommandInfo(interp,"close",&info)) { - info.clientData = 0; - } -#if TCL_MAJOR_VERSION < 8 - return(Tcl_CloseCmd(info.clientData,interp,argc_orig,argv_orig)); -#else - return(Tcl_CloseObjCmd(info.clientData,interp,argc_orig,argv_orig)); -#endif - } - - if (m == -1) { - if (exp_update_master(interp,&m,1,0) == 0) return(TCL_ERROR); - } - - if (slave_flag) { - struct exp_f *f = exp_fd2f(interp,m,1,0,"-slave"); - if (!f) return TCL_ERROR; - - if (f->slave_fd) { - close(f->slave_fd); - f->slave_fd = EXP_NOFD; - - exp_slave_control(m,1); - - return TCL_OK; - } else { - exp_error(interp,"no such slave"); - return TCL_ERROR; - } - } - - if (onexec_flag) { - /* heck, don't even bother to check if fd is open or a real */ - /* spawn id, nothing else depends on it */ - fcntl(m,F_SETFD,close_onexec); - return TCL_OK; - } - - return(exp_close(interp,m)); +int objc; +Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + int onexec_flag = FALSE; /* true if -onexec seen */ + int close_onexec; + int slave_flag = FALSE; + ExpState *esPtr = 0; + char *chanName = 0; + + int objc_orig = objc; + Tcl_Obj *CONST *objv_orig = objv; + + objc--; objv++; + + for (;objc>0;objc--,objv++) { + if (streq("-i",Tcl_GetString(*objv))) { + objc--; objv++; + if (objc == 0) { + exp_error(interp,"usage: -i spawn_id"); + return(TCL_ERROR); + } + chanName = Tcl_GetString(*objv); + } else if (streq(Tcl_GetString(*objv),"-slave")) { + slave_flag = TRUE; + } else if (streq(Tcl_GetString(*objv),"-onexec")) { + objc--; objv++; + if (objc == 0) { + exp_error(interp,"usage: -onexec 0|1"); + return(TCL_ERROR); + } + onexec_flag = TRUE; + close_onexec = atoi(Tcl_GetString(*objv)); + } else break; + } + + if (objc) { + /* doesn't look like our format, it must be a Tcl-style file */ + /* handle. Lucky that formats are easily distinguishable. */ + /* Historical note: we used "close" long before there was a */ + /* Tcl builtin by the same name. */ + + Tcl_CmdInfo info; + Tcl_ResetResult(interp); + if (0 == Tcl_GetCommandInfo(interp,"close",&info)) { + info.clientData = 0; + } + return(Tcl_CloseObjCmd(info.clientData,interp,objc_orig,objv_orig)); + } + + if (chanName) { + if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"close"))) return TCL_ERROR; + } else { + if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR; + } + + if (slave_flag) { + if (esPtr->fd_slave != EXP_NOFD) { + close(esPtr->fd_slave); + esPtr->fd_slave = EXP_NOFD; + + exp_slave_control(esPtr->fdin,1); + + return TCL_OK; + } else { + exp_error(interp,"no such slave"); + return TCL_ERROR; + } + } + + if (onexec_flag) { + /* heck, don't even bother to check if fd is open or a real */ + /* spawn id, nothing else depends on it */ + fcntl(esPtr->fdin,F_SETFD,close_onexec); + return TCL_OK; + } + + return(exp_close(interp,esPtr)); } /*ARGSUSED*/ static void tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv) @@ -2725,14 +2342,15 @@ int argc; char *argv[]; { int i; - /* come out on stderr, by using errorlog */ - errorlog("%2d",level); - for (i = 0;i0;argc--,argv++) { - if (streq(*argv,"-i")) { - argc--; argv++; - if (argc==0) { - exp_error(interp,"usage: -i spawn_id"); - return(TCL_ERROR); - } - master_supplied = TRUE; - m = atoi(*argv); - } else if (streq(*argv,"-nowait")) { - nowait = TRUE; - } - } - - if (!master_supplied) { - if (0 == exp_update_master(interp,&m,0,0)) - return TCL_ERROR; - } - - if (m != EXP_SPAWN_ID_ANY) { - if (0 == exp_fd2f(interp,m,0,0,"wait")) { - return TCL_ERROR; - } - - f = exp_fs + m; - - /* check if waited on already */ - /* things opened by "open" or set with -nowait */ - /* are marked sys_waited already */ - if (!f->sys_waited) { - if (nowait) { - /* should probably generate an error */ - /* if SIGCHLD is trapped. */ - - /* pass to Tcl, so it can do wait */ - /* in background */ -#if TCL_MAJOR_VERSION < 8 - Tcl_DetachPids(1,&f->pid); -#else - Tcl_DetachPids(1,(Tcl_Pid *)&f->pid); -#endif - exp_wait_zero(&f->wait); - } else { - while (1) { - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(rc); - } - - result = waitpid(f->pid,&f->wait,0); - if (result == f->pid) break; - if (result == -1) { - if (errno == EINTR) continue; - else break; - } - } - } - } - - /* - * Now have Tcl reap anything we just detached. - * This also allows procs user has created with "exec &" - * and and associated with an "exec &" process to be reaped. - */ - - Tcl_ReapDetachedProcs(); - exp_rearm_sigchld(interp); /* new */ - } else { - /* wait for any of our own spawned processes */ - /* we call waitpid rather than wait to avoid running into */ - /* someone else's processes. Yes, according to Ousterhout */ - /* this is the best way to do it. */ - - for (m=0;m<=exp_fd_max;m++) { - f = exp_fs + m; - if (!f->valid) continue; - if (f->pid == exp_getpid) continue; /* skip ourself */ - if (f->user_waited) continue; /* one wait only! */ - if (f->sys_waited) break; - restart: - result = waitpid(f->pid,&f->wait,WNOHANG); - if (result == f->pid) break; - if (result == 0) continue; /* busy, try next */ - if (result == -1) { - if (errno == EINTR) goto restart; - else break; - } - } - - /* if it's not a spawned process, maybe its a forked process */ - for (fp=forked_proc_base;fp;fp=fp->next) { - if (fp->link_status == not_in_use) continue; - restart2: - result = waitpid(fp->pid,&fp->wait_status,WNOHANG); - if (result == fp->pid) { - m = -1; /* DOCUMENT THIS! */ - break; - } - if (result == 0) continue; /* busy, try next */ - if (result == -1) { - if (errno == EINTR) goto restart2; - else break; - } - } - - if (m > exp_fd_max) { - result = NO_CHILD; /* no children */ - Tcl_ReapDetachedProcs(); - } - exp_rearm_sigchld(interp); - } - - /* sigh, wedge forked_proc into an exp_f structure so we don't - * have to rewrite remaining code (too much) - */ - if (fp) { - f = &ftmp; - f->pid = fp->pid; - f->wait = fp->wait_status; - } - - /* non-portable assumption that pid_t can be printed with %d */ - - if (result == -1) { - sprintf(interp->result,"%d %d -1 %d POSIX %s %s", - f->pid,m,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno)); - result = TCL_OK; - } else if (result == NO_CHILD) { - interp->result = "no children"; - return TCL_ERROR; - } else { - sprintf(interp->result,"%d %d 0 %d", - f->pid,m,WEXITSTATUS(f->wait)); - if (WIFSIGNALED(f->wait)) { - Tcl_AppendElement(interp,"CHILDKILLED"); - Tcl_AppendElement(interp,Tcl_SignalId((int)(WTERMSIG(f->wait)))); - Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WTERMSIG(f->wait)))); - } else if (WIFSTOPPED(f->wait)) { - Tcl_AppendElement(interp,"CHILDSUSP"); - Tcl_AppendElement(interp,Tcl_SignalId((int) (WSTOPSIG(f->wait)))); - Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WSTOPSIG(f->wait)))); - } - } - - if (fp) { - fp->link_status = not_in_use; - return ((result == -1)?TCL_ERROR:TCL_OK); - } - - f->sys_waited = TRUE; - f->user_waited = TRUE; - - /* if user has already called close, make sure fd really is closed */ - /* and forget about this entry entirely */ - if (f->user_closed) { - if (!f->sys_closed) { - sys_close(m,f); - } - f->valid = FALSE; - } - return ((result == -1)?TCL_ERROR:TCL_OK); + argv++; + argc--; + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-i")) { + argc--; argv++; + if (argc==0) { + exp_error(interp,"usage: -i spawn_id"); + return(TCL_ERROR); + } + chanName = *argv; + } else if (streq(*argv,"-nowait")) { + nowait = TRUE; + } + } + + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,0,0,1))) return TCL_ERROR; + } else { + if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,1,"wait"))) + return TCL_ERROR; + } + + if (!expStateAnyIs(esPtr)) { + /* check if waited on already */ + /* things opened by "open" or set with -nowait */ + /* are marked sys_waited already */ + if (!esPtr->sys_waited) { + if (nowait) { + /* should probably generate an error */ + /* if SIGCHLD is trapped. */ + + /* pass to Tcl, so it can do wait */ + /* in background */ + Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid); + exp_wait_zero(&esPtr->wait); + } else { + while (1) { + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(rc); + } + + result = waitpid(esPtr->pid,&esPtr->wait,0); + if (result == esPtr->pid) break; + if (result == -1) { + if (errno == EINTR) continue; + else break; + } + } + } + } + + /* + * Now have Tcl reap anything we just detached. + * This also allows procs user has created with "exec &" + * and and associated with an "exec &" process to be reaped. + */ + + Tcl_ReapDetachedProcs(); + exp_rearm_sigchld(interp); /* new */ + + strcpy(spawn_id,esPtr->name); + } else { + /* wait for any of our own spawned processes */ + /* we call waitpid rather than wait to avoid running into */ + /* someone else's processes. Yes, according to Ousterhout */ + /* this is the best way to do it. */ + + int waited_on_forked_process = 0; + + esPtr = expWaitOnAny(); + if (!esPtr) { + /* if it's not a spawned process, maybe its a forked process */ + for (fp=forked_proc_base;fp;fp=fp->next) { + if (fp->link_status == not_in_use) continue; + restart: + result = waitpid(fp->pid,&fp->wait_status,WNOHANG); + if (result == fp->pid) { + waited_on_forked_process = 1; + break; + } + if (result == 0) continue; /* busy, try next */ + if (result == -1) { + if (errno == EINTR) goto restart; + else break; + } + } + + if (waited_on_forked_process) { + /* + * The literal spawn id in the return value from wait appears + * as a -1 to indicate a forked process was waited on. + */ + strcpy(spawn_id,"-1"); + } else { + result = NO_CHILD; /* no children */ + Tcl_ReapDetachedProcs(); + } + exp_rearm_sigchld(interp); + } + } + + /* sigh, wedge forked_proc into an ExpState structure so we don't + * have to rewrite remaining code (too much) + */ + if (fp) { + esPtr = &esTmp; + esPtr->pid = fp->pid; + esPtr->wait = fp->wait_status; + } + + /* non-portable assumption that pid_t can be printed with %d */ + + if (result == -1) { + sprintf(interp->result,"%d %s -1 %d POSIX %s %s", + esPtr->pid,spawn_id,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno)); + result = TCL_OK; + } else if (result == NO_CHILD) { + exp_error(interp,"no children"); + return TCL_ERROR; + } else { + sprintf(interp->result,"%d %s 0 %d", + esPtr->pid,spawn_id,WEXITSTATUS(esPtr->wait)); + if (WIFSIGNALED(esPtr->wait)) { + Tcl_AppendElement(interp,"CHILDKILLED"); + Tcl_AppendElement(interp,Tcl_SignalId((int)(WTERMSIG(esPtr->wait)))); + Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WTERMSIG(esPtr->wait)))); + } else if (WIFSTOPPED(esPtr->wait)) { + Tcl_AppendElement(interp,"CHILDSUSP"); + Tcl_AppendElement(interp,Tcl_SignalId((int) (WSTOPSIG(esPtr->wait)))); + Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WSTOPSIG(esPtr->wait)))); + } + } + + if (fp) { + fp->link_status = not_in_use; + return ((result == -1)?TCL_ERROR:TCL_OK); + } + + esPtr->sys_waited = TRUE; + esPtr->user_waited = TRUE; + + /* if user has already called close, forget about this entry entirely */ + if (!esPtr->open) { + if (esPtr->registered) { + Tcl_UnregisterChannel(interp,esPtr->channel); + } + } + + return ((result == -1)?TCL_ERROR:TCL_OK); } /*ARGSUSED*/ static int Exp_ForkCmd(clientData, interp, argc, argv) @@ -3097,11 +2701,11 @@ fork_add(rc); } /* both child and parent follow remainder of code */ sprintf(interp->result,"%d",rc); - debuglog("fork: returns {%s}\r\n",interp->result); + expDiagLog("fork: returns {%s}\r\n",interp->result); return(TCL_OK); } /*ARGSUSED*/ static int @@ -3109,93 +2713,109 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - /* tell Saber to ignore non-use of ttyfd */ - /*SUPPRESS 591*/ - int ttyfd; - - if (argc > 1) { - exp_error(interp,"usage: disconnect"); - return(TCL_ERROR); - } - - if (exp_disconnected) { - exp_error(interp,"already disconnected"); - return(TCL_ERROR); - } - if (!exp_forked) { - exp_error(interp,"can only disconnect child process"); - return(TCL_ERROR); - } - exp_disconnected = TRUE; - - /* ignore hangup signals generated by testing ptys in getptymaster */ - /* and other places */ - signal(SIGHUP,SIG_IGN); - - /* reopen prevents confusion between send/expect_user */ - /* accidentally mapping to a real spawned process after a disconnect */ - if (exp_fs[0].pid != EXP_NOPID) { - exp_close(interp,0); - open("/dev/null",0); - fd_new(0, EXP_NOPID); - } - if (exp_fs[1].pid != EXP_NOPID) { - exp_close(interp,1); - open("/dev/null",1); - fd_new(1, EXP_NOPID); - } - if (exp_fs[2].pid != EXP_NOPID) { - /* reopen stderr saves error checking in error/log routines. */ - exp_close(interp,2); - open("/dev/null",1); - fd_new(2, EXP_NOPID); - } - - Tcl_UnsetVar(interp,"tty_spawn_id",TCL_GLOBAL_ONLY); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + + /* tell CenterLine to ignore non-use of ttyfd */ + /*SUPPRESS 591*/ + int ttyfd; + + if (argc > 1) { + exp_error(interp,"usage: disconnect"); + return(TCL_ERROR); + } + + if (exp_disconnected) { + exp_error(interp,"already disconnected"); + return(TCL_ERROR); + } + if (!exp_forked) { + exp_error(interp,"can only disconnect child process"); + return(TCL_ERROR); + } + exp_disconnected = TRUE; + + /* ignore hangup signals generated by testing ptys in getptymaster */ + /* and other places */ + signal(SIGHUP,SIG_IGN); + + /* reopen prevents confusion between send/expect_user */ + /* accidentally mapping to a real spawned process after a disconnect */ + + /* if we're in a child that's about to be disconnected from the + controlling tty, close and reopen 0, 1, and 2 but associated + with /dev/null. This prevents send and expect_user doing + special things if newly spawned processes accidentally + get allocated 0, 1, and 2. + */ + + if (isatty(0)) { + ExpState *stdinout = tsdPtr->stdinout; + if (stdinout->valid) { + exp_close(interp,stdinout); + if (stdinout->registered) { + Tcl_UnregisterChannel(interp,stdinout->channel); + } + } + open("/dev/null",0); + open("/dev/null",1); + /* tsdPtr->stdinout = expCreateChannel(interp,0,1,EXP_NOPID);*/ + /* tsdPtr->stdinout->keepForever = 1;*/ + } + if (isatty(2)) { + ExpState *devtty = tsdPtr->devtty; + + /* reopen stderr saves error checking in error/log routines. */ + if (devtty->valid) { + exp_close(interp,devtty); + if (devtty->registered) { + Tcl_UnregisterChannel(interp,devtty->channel); + } + } + open("/dev/null",1); + /* tsdPtr->devtty = expCreateChannel(interp,2,2,EXP_NOPID);*/ + /* tsdPtr->devtty->keepForever = 1;*/ + } + + Tcl_UnsetVar(interp,"tty_spawn_id",TCL_GLOBAL_ONLY); #ifdef DO_SETSID - setsid(); + setsid(); #else #ifdef SYSV3 - /* put process in our own pgrp, and lose controlling terminal */ + /* put process in our own pgrp, and lose controlling terminal */ #ifdef sysV88 - /* With setpgrp first, child ends up with closed stdio */ - /* according to Dave Schmitt */ - if (fork()) exit(0); - setpgrp(); + /* With setpgrp first, child ends up with closed stdio */ + /* according to Dave Schmitt */ + if (fork()) exit(0); + expSetpgrp(); #else - setpgrp(); - /*signal(SIGHUP,SIG_IGN); moved out to above */ - if (fork()) exit(0); /* first child exits (as per Stevens, */ - /* UNIX Network Programming, p. 79-80) */ - /* second child process continues as daemon */ + expSetpgrp(); + /*signal(SIGHUP,SIG_IGN); moved out to above */ + if (fork()) exit(0); /* first child exits (as per Stevens, */ + /* UNIX Network Programming, p. 79-80) */ + /* second child process continues as daemon */ #endif #else /* !SYSV3 */ -#ifdef MIPS_BSD - /* required on BSD side of MIPS OS */ -# include - syscall(SYS_setpgrp); -#endif - setpgrp(0,0); -/* setpgrp(0,getpid());*/ /* put process in our own pgrp */ + expSetpgrp(); /* Pyramid lacks this defn */ #ifdef TIOCNOTTY - ttyfd = open("/dev/tty", O_RDWR); - if (ttyfd >= 0) { - /* zap controlling terminal if we had one */ - (void) ioctl(ttyfd, TIOCNOTTY, (char *)0); - (void) close(ttyfd); - } + ttyfd = open("/dev/tty", O_RDWR); + if (ttyfd >= 0) { + /* zap controlling terminal if we had one */ + (void) ioctl(ttyfd, TIOCNOTTY, (char *)0); + (void) close(ttyfd); + } #endif /* TIOCNOTTY */ #endif /* SYSV3 */ #endif /* DO_SETSID */ - return(TCL_OK); + return(TCL_OK); } /*ARGSUSED*/ static int Exp_OverlayCmd(clientData, interp, argc, argv) @@ -3222,13 +2842,13 @@ exp_error(interp,"overlay -# requires additional argument"); return(TCL_ERROR); } oldfd = atoi(argv[0]); argc--; argv++; - debuglog("overlay: mapping fd %d to %d\r\n",oldfd,newfd); + expDiagLog("overlay: mapping fd %d to %d\r\n",oldfd,newfd); if (oldfd != newfd) (void) dup2(oldfd,newfd); - else debuglog("warning: overlay: old fd == new fd (%d)\r\n",oldfd); + else expDiagLog("warning: overlay: old fd == new fd (%d)\r\n",oldfd); } if (argc == 0) { exp_error(interp,"need program name"); return(TCL_ERROR); } @@ -3243,73 +2863,53 @@ (void) execvp(command,argv); exp_error(interp,"execvp(%s): %s\r\n",argv[0],Tcl_PosixError(interp)); return(TCL_ERROR); } -#if 0 -/*ARGSUSED*/ -int -cmdReady(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - char num[4]; /* can hold up to "999 " */ - char buf[1024]; /* can easily hold 256 spawn_ids! */ - int i, j; - int *masters, *masters2; - int timeout = get_timeout(); - - if (argc < 2) { - exp_error(interp,"usage: ready spawn_id1 [spawn_id2 ...]"); - return(TCL_ERROR); - } - - masters = (int *)ckalloc((argc-1)*sizeof(int)); - masters2 = (int *)ckalloc((argc-1)*sizeof(int)); - - for (i=1;i= objc) { + Tcl_WrongNumArgs(interp, 1, objv,"-eof cmd"); + return TCL_ERROR; + } + eofObj = objv[i]; + Tcl_IncrRefCount(eofObj); + break; + } + } + + /* errors and ok, are caught by exp_interpreter() and discarded */ + /* to return TCL_OK, type "return" */ + rc = exp_interpreter(interp,eofObj); + if (eofObj) Tcl_DecrRefCount(eofObj); + return rc; } /* this command supercede's Tcl's builtin CONTINUE command */ /*ARGSUSED*/ int @@ -3317,40 +2917,20 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - if (argc == 1) { - return EXP_CONTINUE; - } else if ((argc == 2) && (0 == strcmp(argv[1],"-continue_timer"))) { - return EXP_CONTINUE_TIMER; - } - - exp_error(interp,"usage: exp_continue [-continue_timer]\n"); - return(TCL_ERROR); -} - -#if TCL_MAJOR_VERSION < 8 -/* most of this is directly from Tcl's definition for return */ -/*ARGSUSED*/ -int -Exp_InterReturnCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - /* let Tcl's return command worry about args */ - /* if successful (i.e., TCL_RETURN is returned) */ - /* modify the result, so that we will handle it specially */ - - int result = Tcl_ReturnCmd(clientData,interp,argc,argv); - if (result == TCL_RETURN) - result = EXP_TCL_RETURN; - return result; -} -#else + if (argc == 1) { + return EXP_CONTINUE; + } else if ((argc == 2) && (0 == strcmp(argv[1],"-continue_timer"))) { + return EXP_CONTINUE_TIMER; + } + + exp_error(interp,"usage: exp_continue [-continue_timer]\n"); + return(TCL_ERROR); +} + /* most of this is directly from Tcl's definition for return */ /*ARGSUSED*/ int Exp_InterReturnObjCmd(clientData, interp, objc, objv) ClientData clientData; @@ -3365,77 +2945,77 @@ int result = Tcl_ReturnObjCmd(clientData,interp,objc,objv); if (result == TCL_RETURN) result = EXP_TCL_RETURN; return result; } -#endif /*ARGSUSED*/ int Exp_OpenCmd(clientData, interp, argc, argv) ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - struct exp_f *f; - int m = -1; - int m2; - int leaveopen = FALSE; - Tcl_Channel chan; - - argc--; argv++; - - for (;argc>0;argc--,argv++) { - if (streq(*argv,"-i")) { - argc--; argv++; - if (!*argv) { - exp_error(interp,"usage: -i spawn_id"); - return TCL_ERROR; - } - m = atoi(*argv); - } else if (streq(*argv,"-leaveopen")) { - leaveopen = TRUE; - argc--; argv++; - } else break; - } - - if (m == -1) { - if (exp_update_master(interp,&m,0,0) == 0) return TCL_ERROR; - } - - if (0 == (f = exp_fd2f(interp,m,1,0,"exp_open"))) return TCL_ERROR; - - /* make a new copy of file descriptor */ - if (-1 == (m2 = dup(m))) { - exp_error(interp,"fdopen: %s",Tcl_PosixError(interp)); - return TCL_ERROR; - } - - if (!leaveopen) { - /* remove from Expect's memory in anticipation of passing to Tcl */ - if (f->pid != EXP_NOPID) { -#if TCL_MAJOR_VERSION < 8 - Tcl_DetachPids(1,&f->pid); -#else - Tcl_DetachPids(1,(Tcl_Pid *)&f->pid); -#endif - f->pid = EXP_NOPID; - f->sys_waited = f->user_waited = TRUE; - } - exp_close(interp,m); - } - - chan = Tcl_MakeFileChannel( -#if TCL_MAJOR_VERSION < 8 - (ClientData)m2, -#endif - (ClientData)m2, - TCL_READABLE|TCL_WRITABLE); - Tcl_RegisterChannel(interp, chan); - Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL); - return TCL_OK; + ExpState *esPtr; + char *chanName = 0; + int newfd; + int leaveopen = FALSE; + Tcl_Channel channel; + + argc--; argv++; + + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-i")) { + argc--; argv++; + if (!*argv) { + exp_error(interp,"usage: -i spawn_id"); + return TCL_ERROR; + } + chanName = *argv; + } else if (streq(*argv,"-leaveopen")) { + leaveopen = TRUE; + argc--; argv++; + } else break; + } + + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR; + } else { + if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"exp_open"))) +return TCL_ERROR; + } + + /* make a new copy of file descriptor */ + if (-1 == (newfd = dup(esPtr->fdin))) { + exp_error(interp,"dup: %s",Tcl_PosixError(interp)); + return TCL_ERROR; + } + + if (!leaveopen) { + /* remove from Expect's memory in anticipation of passing to Tcl */ + if (esPtr->pid != EXP_NOPID) { + Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid); + esPtr->pid = EXP_NOPID; + esPtr->sys_waited = esPtr->user_waited = TRUE; + } + exp_close(interp,esPtr); + } + + /* + * Tcl's MakeFileChannel only allows us to pass a single file descriptor + * but that shouldn't be a problem in practice since all of the channels + * that Expect generates only have one fd. Of course, this code won't + * work if someone creates a pipeline, then passes it to spawn, and then + * again to exp_open. For that to work, Tcl would need a new API. + * Oh, and we're also being rather cavalier with the permissions here, + * but they're likely to be right for the same reasons. + */ + channel = Tcl_MakeFileChannel((ClientData)newfd,TCL_READABLE|TCL_WRITABLE); + Tcl_RegisterChannel(interp, channel); + Tcl_AppendResult(interp, Tcl_GetChannelName(channel), (char *) NULL); + return TCL_OK; } /* return 1 if a string is substring of a flag */ /* this version is the code used by the macro that everyone calls */ int @@ -3455,31 +3035,15 @@ void exp_create_commands(interp,c) Tcl_Interp *interp; struct exp_cmd_data *c; { -#if TCL_MAJOR_VERSION < 8 - Interp *iPtr = (Interp *) interp; -#else Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); -#endif char cmdnamebuf[80]; for (;c->name;c++) { -#if TCL_MAJOR_VERSION < 8 - int create = FALSE; - /* if already defined, don't redefine */ - if (c->flags & EXP_REDEFINE) create = TRUE; - else if (!Tcl_FindHashEntry(&iPtr->commandTable,c->name)) { - create = TRUE; - } - if (create) { - Tcl_CreateCommand(interp,c->name,c->proc, - c->data,exp_deleteProc); - } -#else /* if already defined, don't redefine */ if ((c->flags & EXP_REDEFINE) || !(Tcl_FindHashEntry(&globalNsPtr->cmdTable,c->name) || Tcl_FindHashEntry(&currNsPtr->cmdTable,c->name))) { if (c->objproc) @@ -3487,37 +3051,27 @@ c->objproc,c->data,exp_deleteObjProc); else Tcl_CreateCommand(interp,c->name,c->proc, c->data,exp_deleteProc); } -#endif if (!(c->name[0] == 'e' && c->name[1] == 'x' && c->name[2] == 'p') && !(c->flags & EXP_NOPREFIX)) { sprintf(cmdnamebuf,"exp_%s",c->name); -#if TCL_MAJOR_VERSION < 8 - Tcl_CreateCommand(interp,cmdnamebuf,c->proc, - c->data,exp_deleteProc); -#else if (c->objproc) Tcl_CreateObjCommand(interp,cmdnamebuf,c->objproc,c->data, exp_deleteObjProc); else Tcl_CreateCommand(interp,cmdnamebuf,c->proc, c->data,exp_deleteProc); -#endif } } } static struct exp_cmd_data cmd_data[] = { -#if TCL_MAJOR_VERSION < 8 -{"close", Exp_CloseCmd, 0, EXP_REDEFINE}, -#else {"close", Exp_CloseObjCmd, 0, 0, EXP_REDEFINE}, -#endif #ifdef TCL_DEBUGGER {"debug", exp_proc(Exp_DebugCmd), 0, 0}, #endif {"exp_internal",exp_proc(Exp_ExpInternalCmd), 0, 0}, {"disconnect", exp_proc(Exp_DisconnectCmd), 0, 0}, @@ -3524,25 +3078,21 @@ {"exit", exp_proc(Exp_ExitCmd), 0, EXP_REDEFINE}, {"exp_continue",exp_proc(Exp_ExpContinueCmd),0, 0}, {"fork", exp_proc(Exp_ForkCmd), 0, 0}, {"exp_pid", exp_proc(Exp_ExpPidCmd), 0, 0}, {"getpid", exp_proc(Exp_GetpidDeprecatedCmd),0, 0}, -{"interpreter", exp_proc(Exp_InterpreterCmd), 0, 0}, +{"interpreter", Exp_InterpreterObjCmd, 0, 0, 0}, {"log_file", exp_proc(Exp_LogFileCmd), 0, 0}, {"log_user", exp_proc(Exp_LogUserCmd), 0, 0}, {"exp_open", exp_proc(Exp_OpenCmd), 0, 0}, {"overlay", exp_proc(Exp_OverlayCmd), 0, 0}, -#if TCL_MAJOR_VERSION < 8 -{"inter_return",Exp_InterReturnCmd, 0, 0}, -#else {"inter_return",Exp_InterReturnObjCmd, 0, 0, 0}, -#endif -{"send", exp_proc(Exp_SendCmd), (ClientData)&sendCD_proc, 0}, -{"send_error", exp_proc(Exp_SendCmd), (ClientData)&sendCD_error, 0}, +{"send", Exp_SendObjCmd, 0, (ClientData)&sendCD_proc,0}, +{"send_error", Exp_SendObjCmd, 0, (ClientData)&sendCD_error,0}, {"send_log", exp_proc(Exp_SendLogCmd), 0, 0}, -{"send_tty", exp_proc(Exp_SendCmd), (ClientData)&sendCD_tty, 0}, -{"send_user", exp_proc(Exp_SendCmd), (ClientData)&sendCD_user, 0}, +{"send_tty", Exp_SendObjCmd, 0, (ClientData)&sendCD_tty,0}, +{"send_user", Exp_SendObjCmd, 0, (ClientData)&sendCD_user,0}, {"sleep", exp_proc(Exp_SleepCmd), 0, 0}, {"spawn", exp_proc(Exp_SpawnCmd), 0, 0}, {"strace", exp_proc(Exp_StraceCmd), 0, 0}, {"wait", exp_proc(Exp_WaitCmd), 0, 0}, {0}}; @@ -3549,13 +3099,11 @@ void exp_init_most_cmds(interp) Tcl_Interp *interp; { - exp_create_commands(interp,cmd_data); + exp_create_commands(interp,cmd_data); #ifdef HAVE_PTYTRAP - Tcl_InitHashTable(&slaveNames,TCL_STRING_KEYS); + Tcl_InitHashTable(&slaveNames,TCL_STRING_KEYS); #endif /* HAVE_PTYTRAP */ - - exp_close_in_child = exp_close_tcl_files; } Index: exp_command.h ================================================================== --- exp_command.h +++ exp_command.h @@ -5,21 +5,34 @@ 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. */ -EXTERN struct exp_f * exp_update_master - _ANSI_ARGS_((Tcl_Interp *,int *,int,int)); +#ifdef HAVE_SYS_WAIT_H + /* ISC doesn't def WNOHANG unless _POSIX_SOURCE is def'ed */ +# ifdef WNOHANG_REQUIRES_POSIX_SOURCE +# define _POSIX_SOURCE +# endif +# include +# ifdef WNOHANG_REQUIRES_POSIX_SOURCE +# undef _POSIX_SOURCE +# endif +#endif + +#include + +#define EXP_CHANNELNAMELEN (16 + TCL_INTEGER_SPACE) + EXTERN char * exp_get_var _ANSI_ARGS_((Tcl_Interp *,char *)); EXTERN int exp_default_match_max; EXTERN int exp_default_parity; EXTERN int exp_default_rm_nulls; -EXTERN int exp_one_arg_braced _ANSI_ARGS_((char *)); +EXTERN int exp_one_arg_braced _ANSI_ARGS_((Tcl_Obj *)); EXTERN int exp_eval_with_one_arg _ANSI_ARGS_((ClientData, - Tcl_Interp *,char **)); + Tcl_Interp *, struct Tcl_Obj * CONST objv[])); EXTERN void exp_lowmemcpy _ANSI_ARGS_((char *,char *,int)); EXTERN int exp_flageq_code _ANSI_ARGS_((char *,char *,int)); #define exp_flageq(flag,string,minlen) \ @@ -27,103 +40,17 @@ /* exp_flageq for single char flags */ #define exp_flageq1(flag,string) \ ((string[0] == flag) && (string[1] == '\0')) -/* - * The type of the status returned by wait varies from UNIX system - * to UNIX system. The macro below defines it: - * (stolen from tclUnix.h) - */ - -#define WAIT_STATUS_TYPE int -#if 0 -#ifdef AIX -# define WAIT_STATUS_TYPE pid_t -#else -#ifndef NO_UNION_WAIT -# define WAIT_STATUS_TYPE union wait -#else -# define WAIT_STATUS_TYPE int -#endif -#endif /* AIX */ - -/* These macros are taken from tclUnix.h */ - -#undef WIFEXITED -#ifndef WIFEXITED -# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0) -#endif - -#undef WEXITSTATUS -#ifndef WEXITSTATUS -# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) -#endif - -#undef WIFSIGNALED -#ifndef WIFSIGNALED -# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff))) -#endif - -#undef WTERMSIG -#ifndef WTERMSIG -# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) -#endif - -#undef WIFSTOPPED -#ifndef WIFSTOPPED -# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177) -#endif - -#undef WSTOPSIG -#ifndef WSTOPSIG -# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) -#endif - -#endif /* 0 */ - -/* These macros are suggested by the autoconf documentation. */ - -#undef WIFEXITED -#ifndef WIFEXITED -# define WIFEXITED(stat) (((stat) & 0xff) == 0) -#endif - -#undef WEXITSTATUS -#ifndef WEXITSTATUS -# define WEXITSTATUS(stat) (((stat) >> 8) & 0xff) -#endif - -#undef WIFSIGNALED -#ifndef WIFSIGNALED -# define WIFSIGNALED(stat) ((stat) && ((stat) == ((stat) & 0x00ff))) -#endif - -#undef WTERMSIG -#ifndef WTERMSIG -# define WTERMSIG(stat) ((stat) & 0x7f) -#endif - -#undef WIFSTOPPED -#ifndef WIFSTOPPED -# define WIFSTOPPED(stat) (((stat) & 0xff) == 0177) -#endif - -#undef WSTOPSIG -#ifndef WSTOPSIG -# define WSTOPSIG(stat) (((stat) >> 8) & 0xff) -#endif - - - -#define EXP_SPAWN_ID_ANY_VARNAME "any_spawn_id" +#define EXP_SPAWN_ID_USER 0 #define EXP_SPAWN_ID_ANY_LIT "-1" -#define EXP_SPAWN_ID_ANY -1 -#define EXP_SPAWN_ID_ERROR_LIT "2" -#define EXP_SPAWN_ID_USER_LIT "0" -#define EXP_SPAWN_ID_USER 0 +#define EXP_CHANNEL_PREFIX "exp" +#define EXP_CHANNEL_PREFIX_LENGTH 3 +#define isExpChannelName(name) \ + (0 == strncmp(name,EXP_CHANNEL_PREFIX,EXP_CHANNEL_PREFIX_LENGTH)) #define exp_is_stdinfd(x) ((x) == 0) #define exp_is_devttyfd(x) ((x) == exp_dev_tty) #define EXP_NOPID 0 /* Used when there is no associated pid to */ @@ -141,102 +68,124 @@ #define EXP_CMD_BEFORE 0 #define EXP_CMD_AFTER 1 #define EXP_CMD_BG 2 #define EXP_CMD_FG 3 -/* each process is associated with a 'struct exp_f'. An array of these */ -/* ('exp_fs') keeps track of all processes. They are indexed by the true fd */ -/* to the master side of the pty */ -struct exp_f { - int *fd_ptr; -#if 0 - struct exp_f **ptr; /* our own address to this exp_f */ - /* since address can change, provide this indirect */ - /* pointer for people (Tk) who require a fixed ptr */ -#endif - int pid; /* pid or EXP_NOPID if no pid */ - char *buffer; /* input buffer */ - char *lower; /* input buffer in lowercase */ - int size; /* current size of data */ - int msize; /* size of buffer (true size is one greater - for trailing null) */ - int umsize; /* user view of size of buffer */ - int rm_nulls; /* if nulls should be stripped before pat matching */ - int valid; /* if any of the other fields should be believed */ - int user_closed;/* if user has issued "close" command or close has */ - /* occurred implicitly */ - int sys_closed; /* if close() has been called */ - int user_waited;/* if user has issued "wait" command */ - int sys_waited; /* if wait() (or variant) has been called */ - WAIT_STATUS_TYPE wait; /* raw status from wait() */ - int parity; /* strip parity if false */ - int printed; /* # of characters written to stdout (if logging on) */ - /* but not actually returned via a match yet */ - int echoed; /* additional # of chars (beyond "printed" above) */ - /* echoed back but not actually returned via a match */ - /* yet. This supports interact -echo */ - int key; /* unique id that identifies what command instance */ - /* last touched this buffer */ - int force_read; /* force read to occur (even if buffer already has */ - /* data). This supports interact CAN_MATCH */ - int fg_armed; /* If Tk_CreateFileHandler is active for responding */ - /* to foreground events */ - - -#if TCL_MAJOR_VERSION < 8 - Tcl_File Master; /* corresponds to master fd */ - Tcl_File Slave; /* corresponds to slave_fd */ - Tcl_File MasterOutput; /* corresponds to tcl_output */ - /* - * Following comment only applies to Tcl 7.6: - * Explicit fds aren't necessary now, but since the code is already - * here from before Tcl required Tcl_File, we'll continue using - * the old fds. If we ever port this code to a non-UNIX system, - * we'll dump the fds totally. - */ -#endif /* TCL_MAJOR_VERSION < 8 */ - - int slave_fd; /* slave fd if "spawn -pty" used */ +/* + * This structure describes per-instance state of an Exp channel. + */ + +typedef struct ExpState { + Tcl_Channel channel; /* Channel associated with this file. */ + char name[EXP_CHANNELNAMELEN+1]; /* expect and interact set variables + to channel name, so for efficiency + cache it here */ + int fdin; /* input fd */ + int fdout; /* output fd - usually the same as fdin, although + may be different if channel opened by tcl::open */ + Tcl_Channel channel_orig; /* If opened by someone else, i.e. tcl::open */ + int fd_slave; /* slave fd if "spawn -pty" used */ + + /* this may go away if we find it is not needed */ + /* it might be needed by inherited channels */ + int validMask; /* OR'ed combination of TCL_READABLE, + * TCL_WRITABLE, or TCL_EXCEPTION: indicates + * which operations are valid on the file. */ + + int pid; /* pid or EXP_NOPID if no pid */ + Tcl_Obj *buffer; /* input buffer */ + + int msize; /* # of bytes that buffer can hold (max) */ + int umsize; /* # of bytes (min) that is guaranteed to match */ + /* this comes from match_max command */ + int printed; /* # of bytes written to stdout (if logging on) */ + /* but not actually returned via a match yet */ + int echoed; /* additional # of bytes (beyond "printed" above) */ + /* echoed back but not actually returned via a match */ + /* yet. This supports interact -echo */ + + int rm_nulls; /* if nulls should be stripped before pat matching */ + int open; /* if fdin/fdout open */ + int user_waited; /* if user has issued "wait" command */ + int sys_waited; /* if wait() (or variant) has been called */ + int registered; /* if channel registered */ + WAIT_STATUS_TYPE wait; /* raw status from wait() */ + int parity; /* if parity should be preserved */ + int key; /* unique id that identifies what command instance */ + /* last touched this buffer */ + int force_read; /* force read to occur (even if buffer already has */ + /* data). This supports interact CAN_MATCH */ + int notified; /* If Tcl_NotifyChannel has been called and we */ + /* have not yet read from the channel. */ + int notifiedMask; /* Mask reported when notified. */ + int fg_armed; /* If Tk_CreateFileHandler is active for responding */ + /* to foreground events */ #ifdef HAVE_PTYTRAP - char *slave_name;/* Full name of slave, i.e., /dev/ttyp0 */ + char *slave_name; /* Full name of slave, i.e., /dev/ttyp0 */ #endif /* HAVE_PTYTRAP */ - char *tcl_handle;/* If opened by someone else, i.e. Tcl's open */ - int tcl_output; /* output fd if opened by someone else */ - /* input fd is the index of this struct (see above) */ - int leaveopen; /* If we should not call Tcl's close when we close - */ - /* only relevant if Tcl does the original open */ - Tcl_Interp *bg_interp; /* interp to process the bg cases */ - int bg_ecount; /* number of background ecases */ - enum { - blocked, /* blocked because we are processing the */ - /* file handler */ - armed, /* normal state when bg handler in use */ - unarmed, /* no bg handler in use */ - disarm_req_while_blocked /* while blocked, a request */ + /* may go away */ + int leaveopen; /* If we should not call Tcl's close when we close - */ + /* only relevant if Tcl does the original open */ + + Tcl_Interp *bg_interp; /* interp to process the bg cases */ + int bg_ecount; /* number of background ecases */ + enum { + blocked, /* blocked because we are processing the */ + /* file handler */ + armed, /* normal state when bg handler in use */ + unarmed, /* no bg handler in use */ + disarm_req_while_blocked /* while blocked, a request */ /* was received to disarm it. Rather than */ /* processing the request immediately, defer */ /* it so that when we later try to unblock */ /* we will see at that time that it should */ /* instead be disarmed */ - } bg_status; -}; + } bg_status; + + /* + * If the channel is freed while in the middle of a bg event handler, + * remember that and defer freeing of the ExpState structure until + * it is safe. + */ + int freeWhenBgHandlerUnblocked; + + /* If channel is closed but not yet waited on, we tie up the fd by + * attaching it to /dev/null. We play this little game so that we + * can embed the fd in the channel name. If we didn't tie up the + * fd, we'd get channel name collisions. I'd consider naming the + * channels independently of the fd, but this makes debugging easier. + */ + int fdBusy; + + /* + * stdinout and stderr never go away so that our internal refs to them + * don't have to be invalidated. Having to worry about invalidating them + * would be a major pain. */ + int keepForever; + + /* Remember that "reserved" esPtrs are no longer in use. */ + int valid; + + struct ExpState *nextPtr; /* Pointer to next file in list of all + * file channels. */ +} ExpState; + +#define EXP_SPAWN_ID_BAD ((ExpState *)0) + +#define EXP_TIME_INFINITY -1 -extern int exp_fd_max; /* highest fd ever used */ - +extern Tcl_ChannelType expChannelType; #define EXP_TEMPORARY 1 /* expect */ #define EXP_PERMANENT 2 /* expect_after, expect_before, expect_bg */ #define EXP_DIRECT 1 #define EXP_INDIRECT 2 -EXTERN struct exp_f *exp_fs; - -EXTERN struct exp_f * exp_fd2f _ANSI_ARGS_((Tcl_Interp *,int,int,int,char *)); -EXTERN void exp_adjust _ANSI_ARGS_((struct exp_f *)); -EXTERN void exp_buffer_shuffle _ANSI_ARGS_((Tcl_Interp *,struct exp_f *,int,char *,char *)); -EXTERN int exp_close _ANSI_ARGS_((Tcl_Interp *,int)); +EXTERN void expAdjust _ANSI_ARGS_((ExpState *)); +EXTERN void exp_buffer_shuffle _ANSI_ARGS_((Tcl_Interp *,ExpState *,int,char *,char *)); +EXTERN int exp_close _ANSI_ARGS_((Tcl_Interp *,ExpState *)); EXTERN void exp_close_all _ANSI_ARGS_((Tcl_Interp *)); EXTERN void exp_ecmd_remove_fd_direct_and_indirect _ANSI_ARGS_((Tcl_Interp *,int)); EXTERN void exp_trap_on _ANSI_ARGS_((int)); EXTERN int exp_trap_off _ANSI_ARGS_((char *)); @@ -255,15 +204,18 @@ EXTERN void exp_init_pty _ANSI_ARGS_((void)); EXTERN void exp_pty_exit _ANSI_ARGS_((void)); EXTERN void exp_init_tty _ANSI_ARGS_((void)); EXTERN void exp_init_stdio _ANSI_ARGS_((void)); /*EXTERN void exp_init_expect _ANSI_ARGS_((Tcl_Interp *));*/ -EXTERN void exp_init_spawn_ids _ANSI_ARGS_((void)); +EXTERN void exp_init_spawn_ids _ANSI_ARGS_((Tcl_Interp *)); EXTERN void exp_init_spawn_id_vars _ANSI_ARGS_((Tcl_Interp *)); EXTERN void exp_init_trap _ANSI_ARGS_((void)); +EXTERN void exp_init_send _ANSI_ARGS_((void)); EXTERN void exp_init_unit_random _ANSI_ARGS_((void)); EXTERN void exp_init_sig _ANSI_ARGS_((void)); +EXTERN void expChannelInit _ANSI_ARGS_((void)); +EXTERN int expChannelCountGet _ANSI_ARGS_((void)); EXTERN int exp_tcl2_returnvalue _ANSI_ARGS_((int)); EXTERN int exp_2tcl_returnvalue _ANSI_ARGS_((int)); EXTERN void exp_rearm_sigchld _ANSI_ARGS_((Tcl_Interp *)); @@ -271,13 +223,13 @@ EXTERN char *exp_onexit_action; #define exp_new(x) (x *)malloc(sizeof(x)) -struct exp_fd_list { - int fd; - struct exp_fd_list *next; +struct exp_state_list { + ExpState *esPtr; + struct exp_state_list *next; }; /* describes a -i flag */ struct exp_i { int cmdtype; /* EXP_CMD_XXX. When an indirect update is */ @@ -297,45 +249,37 @@ /* has changed or not, and ergo whether it's */ /* necessary to reparse. */ int ecount; /* # of ecases this is used by */ - struct exp_fd_list *fd_list; + struct exp_state_list *state_list; struct exp_i *next; }; EXTERN struct exp_i * exp_new_i_complex _ANSI_ARGS_((Tcl_Interp *, char *, int, Tcl_VarTraceProc *)); -EXTERN struct exp_i * exp_new_i_simple _ANSI_ARGS_((int,int)); -EXTERN struct exp_fd_list *exp_new_fd _ANSI_ARGS_((int)); +EXTERN struct exp_i * exp_new_i_simple _ANSI_ARGS_((ExpState *,int)); +EXTERN struct exp_state_list *exp_new_state _ANSI_ARGS_((ExpState *)); EXTERN void exp_free_i _ANSI_ARGS_((Tcl_Interp *,struct exp_i *, Tcl_VarTraceProc *)); -EXTERN void exp_free_fd _ANSI_ARGS_((struct exp_fd_list *)); -EXTERN void exp_free_fd_single _ANSI_ARGS_((struct exp_fd_list *)); -EXTERN void exp_i_update _ANSI_ARGS_((Tcl_Interp *, +EXTERN void exp_free_state _ANSI_ARGS_((struct exp_state_list *)); +EXTERN void exp_free_state_single _ANSI_ARGS_((struct exp_state_list *)); +EXTERN int exp_i_update _ANSI_ARGS_((Tcl_Interp *, struct exp_i *)); /* * definitions for creating commands */ #define EXP_NOPREFIX 1 /* don't define with "exp_" prefix */ #define EXP_REDEFINE 2 /* stomp on old commands with same name */ -/* a hack for easily supporting both Tcl 7 and 8 CreateCommand/Obj split */ -/* Can be discarded with Tcl 7 is. */ -#if TCL_MAJOR_VERSION < 8 -#define exp_proc(cmdproc) cmdproc -#else #define exp_proc(cmdproc) 0, cmdproc -#endif struct exp_cmd_data { char *name; -#if TCL_MAJOR_VERSION >= 8 Tcl_ObjCmdProc *objproc; -#endif Tcl_CmdProc *proc; ClientData data; int flags; }; @@ -346,5 +290,23 @@ EXTERN void exp_init_most_cmds _ANSI_ARGS_((Tcl_Interp *)); EXTERN void exp_init_trap_cmds _ANSI_ARGS_((Tcl_Interp *)); EXTERN void exp_init_interact_cmds _ANSI_ARGS_((Tcl_Interp *)); EXTERN void exp_init_tty_cmds(); +EXTERN ExpState * expStateCheck _ANSI_ARGS_((Tcl_Interp *,ExpState *,int,int,char *)); +EXTERN ExpState * expStateCurrent _ANSI_ARGS_((Tcl_Interp *,int,int,int)); +EXTERN ExpState * expStateFromChannelName _ANSI_ARGS_((Tcl_Interp *,char *,int,int,int,char *)); +EXTERN void expStateFree _ANSI_ARGS_((ExpState *)); + +EXTERN ExpState * expCreateChannel _ANSI_ARGS_((Tcl_Interp *,int,int,int)); +EXTERN ExpState * expWaitOnAny _ANSI_ARGS_((void)); +EXTERN ExpState * expWaitOnOne _ANSI_ARGS_((void)); +EXTERN void expExpectVarsInit _ANSI_ARGS_((void)); +EXTERN int expStateAnyIs _ANSI_ARGS_((ExpState *)); +EXTERN int expDevttyIs _ANSI_ARGS_((ExpState *)); +EXTERN int expStdinOutIs _ANSI_ARGS_((ExpState *)); +EXTERN ExpState * expStdinoutGet _ANSI_ARGS_((void)); +EXTERN ExpState * expDevttyGet _ANSI_ARGS_((void)); + +/* generic functions that really should be provided by Tcl */ +EXTERN int expSizeGet _ANSI_ARGS_((ExpState *)); +EXTERN int expSizeZero _ANSI_ARGS_((ExpState *)); Index: exp_console.c ================================================================== --- exp_console.c +++ exp_console.c @@ -31,18 +31,19 @@ #endif #include "tcl.h" #include "exp_rename.h" #include "exp_prog.h" +#include "exp_command.h" #include "exp_log.h" static void exp_console_manipulation_failed(s) char *s; { - exp_errorlog("expect: spawn: cannot %s console, check permissions of /dev/console\n",s); - exit(-1); + expErrorLog("expect: spawn: cannot %s console, check permissions of /dev/console\n",s); + exit(-1); } void exp_console_set() { Index: exp_event.c ================================================================== --- exp_event.c +++ exp_event.c @@ -1,29 +1,13 @@ /* exp_event.c - event interface for Expect 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. - -*/ - -/* Notes: -I'm only a little worried because Tk does not check for errno == EBADF -after calling select. I imagine that if the user passes in a bad file -descriptor, we'll never get called back, and thus, we'll hang forever -- it would be better to at least issue a diagnostic to the user. - -Another possible problem: Tk does not do file callbacks round-robin. - -Another possible problem: Calling Create/DeleteFileHandler -before/after every Tcl_Eval... in expect/interact could be very -expensive. - -*/ - +I hereby place this software in the public domain. However, the author and +NIST would appreciate credit if this program or parts of it are used. + +*/ #include "expect_cf.h" #include #include #include @@ -36,420 +20,332 @@ # include #endif #include "tcl.h" #include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f defs */ +#include "exp_command.h" /* for ExpState defs */ #include "exp_event.h" -/* Tcl_DoOneEvent will call our filehandler which will set the following */ -/* vars enabling us to know where and what kind of I/O we can do */ -/*#define EXP_SPAWN_ID_BAD -1*/ -/*#define EXP_SPAWN_ID_TIMEOUT -2*/ /* really indicates a timeout */ - -static int ready_fd = EXP_SPAWN_ID_BAD; -static int ready_mask; -static int default_mask = TCL_READABLE | TCL_EXCEPTION; - - -void -exp_event_disarm(fd) -int fd; -{ -#if TCL_MAJOR_VERSION < 8 - Tcl_DeleteFileHandler(exp_fs[fd].Master); -#else - Tcl_DeleteFileHandler(fd); -#endif - - /* remember that filehandler has been disabled so that */ - /* it can be turned on for fg expect's as well as bg */ - exp_fs[fd].fg_armed = FALSE; -} - -void -exp_event_disarm_fast(fd,filehandler) -int fd; -Tcl_FileProc *filehandler; -{ - /* Temporarily delete the filehandler by assigning it a mask */ - /* that permits no events! */ - /* This reduces the calls to malloc/free inside Tcl_...FileHandler */ - /* Tk insists on having a valid proc here even though it isn't used */ -#if TCL_MAJOR_VERSION < 8 - Tcl_CreateFileHandler(exp_fs[fd].Master,0,filehandler,(ClientData)0); -#else - Tcl_CreateFileHandler(fd,0,filehandler,(ClientData)0); -#endif - - /* remember that filehandler has been disabled so that */ - /* it can be turned on for fg expect's as well as bg */ - exp_fs[fd].fg_armed = FALSE; +typedef struct ThreadSpecificData { + int rr; /* round robin ptr */ +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + +void +exp_event_disarm_bg(esPtr) +ExpState *esPtr; +{ + Tcl_DeleteChannelHandler(esPtr->channel,exp_background_channelhandler,(ClientData)esPtr); } static void -exp_arm_background_filehandler_force(m) -int m; -{ -#if TCL_MAJOR_VERSION < 8 - Tcl_CreateFileHandler(exp_fs[m].Master, -#else - Tcl_CreateFileHandler(m, -#endif - TCL_READABLE|TCL_EXCEPTION, - exp_background_filehandler, - (ClientData)(exp_fs[m].fd_ptr)); - - exp_fs[m].bg_status = armed; -} - -void -exp_arm_background_filehandler(m) -int m; -{ - switch (exp_fs[m].bg_status) { - case unarmed: - exp_arm_background_filehandler_force(m); - break; - case disarm_req_while_blocked: - exp_fs[m].bg_status = blocked; /* forget request */ - break; - case armed: - case blocked: - /* do nothing */ - break; - } -} - -void -exp_disarm_background_filehandler(m) -int m; -{ - switch (exp_fs[m].bg_status) { - case blocked: - exp_fs[m].bg_status = disarm_req_while_blocked; - break; - case armed: - exp_fs[m].bg_status = unarmed; - exp_event_disarm(m); - break; - case disarm_req_while_blocked: - case unarmed: - /* do nothing */ - break; - } +exp_arm_background_channelhandler_force(esPtr) +ExpState *esPtr; +{ + Tcl_CreateChannelHandler(esPtr->channel, + TCL_READABLE|TCL_EXCEPTION, + exp_background_channelhandler, + (ClientData)esPtr); + + esPtr->bg_status = armed; +} + +void +exp_arm_background_channelhandler(esPtr) +ExpState *esPtr; +{ + switch (esPtr->bg_status) { + case unarmed: + exp_arm_background_channelhandler_force(esPtr); + break; + case disarm_req_while_blocked: + esPtr->bg_status = blocked; /* forget request */ + break; + case armed: + case blocked: + /* do nothing */ + break; + } +} + +void +exp_disarm_background_channelhandler(esPtr) +ExpState *esPtr; +{ + switch (esPtr->bg_status) { + case blocked: + esPtr->bg_status = disarm_req_while_blocked; + break; + case armed: + esPtr->bg_status = unarmed; + exp_event_disarm_bg(esPtr); + break; + case disarm_req_while_blocked: + case unarmed: + /* do nothing */ + break; + } } /* ignore block status and forcibly disarm handler - called from exp_close. */ /* After exp_close returns, we will not have an opportunity to disarm */ /* because the fd will be invalid, so we force it here. */ void -exp_disarm_background_filehandler_force(m) -int m; +exp_disarm_background_channelhandler_force(esPtr) +ExpState *esPtr; { - switch (exp_fs[m].bg_status) { + switch (esPtr->bg_status) { case blocked: case disarm_req_while_blocked: case armed: - exp_fs[m].bg_status = unarmed; - exp_event_disarm(m); - break; + esPtr->bg_status = unarmed; + exp_event_disarm_bg(esPtr); + break; case unarmed: - /* do nothing */ - break; - } + /* do nothing */ + break; + } } /* this can only be called at the end of the bg handler in which */ /* case we know the status is some kind of "blocked" */ void -exp_unblock_background_filehandler(m) -int m; +exp_unblock_background_channelhandler(esPtr) + ExpState *esPtr; { - switch (exp_fs[m].bg_status) { + switch (esPtr->bg_status) { case blocked: - exp_arm_background_filehandler_force(m); - break; + exp_arm_background_channelhandler_force(esPtr); + break; case disarm_req_while_blocked: - exp_disarm_background_filehandler_force(m); - break; - } + exp_disarm_background_channelhandler_force(esPtr); + break; + } } /* this can only be called at the beginning of the bg handler in which */ /* case we know the status must be "armed" */ void -exp_block_background_filehandler(m) -int m; +exp_block_background_channelhandler(esPtr) +ExpState *esPtr; { - exp_fs[m].bg_status = blocked; - exp_event_disarm_fast(m,exp_background_filehandler); + esPtr->bg_status = blocked; + exp_event_disarm_bg(esPtr); } /*ARGSUSED*/ static void exp_timehandler(clientData) ClientData clientData; { - *(int *)clientData = TRUE; + *(int *)clientData = TRUE; } -static void exp_filehandler(clientData,mask) +static void exp_channelhandler(clientData,mask) ClientData clientData; int mask; { - /* if input appears, record the fd on which it appeared */ - - ready_fd = *(int *)clientData; - ready_mask = mask; - exp_event_disarm_fast(ready_fd,exp_filehandler); - -#if 0 - if (ready_fd == *(int *)clientData) { - /* if input appears from an fd which we've already heard */ - /* forcibly tell it to shut up. We could also shut up */ - /* every instance, but it is more efficient to leave the */ - /* fd enabled with the belief that we may rearm soon enough */ - /* anyway. */ - - exp_event_disarm_fast(ready_fd,exp_filehandler); - } else { - ready_fd = *(int *)clientData; - ready_mask = mask; - } -#endif + ExpState *esPtr = (ExpState *)clientData; + + esPtr->notified = TRUE; + esPtr->notifiedMask = mask; + + exp_event_disarm_fg(esPtr); +} + +void +exp_event_disarm_fg(esPtr) +ExpState *esPtr; +{ + /*printf("DeleteChannelHandler: %s\r\n",esPtr->name);*/ + Tcl_DeleteChannelHandler(esPtr->channel,exp_channelhandler,(ClientData)esPtr); + + /* remember that ChannelHandler has been disabled so that */ + /* it can be turned on for fg expect's as well as bg */ + esPtr->fg_armed = FALSE; } /* returns status, one of EOF, TIMEOUT, ERROR or DATA */ /* can now return RECONFIGURE, too */ /*ARGSUSED*/ -int exp_get_next_event(interp,masters, n,master_out,timeout,key) +int exp_get_next_event(interp,esPtrs,n,esPtrOut,timeout,key) Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 1st ready master, not set if none */ +ExpState *(esPtrs[]); +int n; /* # of esPtrs */ +ExpState **esPtrOut; /* 1st ready esPtr, not set if none */ int timeout; /* seconds */ int key; { - static rr = 0; /* round robin ptr */ - int i; /* index into in-array */ -#ifdef HAVE_PTYTRAP - struct request_info ioctl_info; -#endif - - int old_configure_count = exp_configure_count; - - int timer_created = FALSE; - int timer_fired = FALSE; - Tcl_TimerToken timetoken;/* handle to Tcl timehandler descriptor */ - - for (;;) { - int m; - struct exp_f *f; - - /* if anything has been touched by someone else, report that */ - /* an event has been received */ - - for (i=0;i= n) rr = 0; - - m = masters[rr]; - f = exp_fs + m; - - if (f->key != key) { - f->key = key; - f->force_read = FALSE; - *master_out = m; - return(EXP_DATA_OLD); - } else if ((!f->force_read) && (f->size != 0)) { - *master_out = m; - return(EXP_DATA_OLD); - } - } - - if (!timer_created) { - if (timeout >= 0) { - timetoken = Tcl_CreateTimerHandler(1000*timeout, - exp_timehandler, - (ClientData)&timer_fired); - timer_created = TRUE; - } - } - - for (;;) { - int j; - - /* make sure that all fds that should be armed are */ - for (j=0;jrr++; + if (tsdPtr->rr >= n) tsdPtr->rr = 0; + + esPtr = esPtrs[tsdPtr->rr]; + + if (esPtr->key != key) { + esPtr->key = key; + esPtr->force_read = FALSE; + *esPtrOut = esPtr; + RETURN(EXP_DATA_OLD); + } else if ((!esPtr->force_read) && (!expSizeZero(esPtr))) { + *esPtrOut = esPtr; + RETURN(EXP_DATA_OLD); + } else if (esPtr->notified) { + /* this test of the mask should be redundant but SunOS */ + /* raises both READABLE and EXCEPTION (for no */ + /* apparent reason) when selecting on a plain file */ + if (esPtr->notifiedMask & TCL_READABLE) { + *esPtrOut = esPtr; + esPtr->notified = FALSE; + RETURN(EXP_DATA_NEW); + } + /* + * at this point we know that the event must be TCL_EXCEPTION + * indicating either EOF or HP ptytrap. + */ +#ifndef HAVE_PTYTRAP + RETURN(EXP_EOF); +#else + if (ioctl(esPtr->fdin,TIOCREQCHECK,&ioctl_info) < 0) { + expDiagLog("ioctl error on TIOCREQCHECK: %s", Tcl_PosixError(interp)); + RETURN(EXP_TCLERROR); + } + if (ioctl_info.request == TIOCCLOSE) { + RETURN(EXP_EOF); + } + if (ioctl(esPtr->fdin, TIOCREQSET, &ioctl_info) < 0) { + expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno)); + } + /* presumably, we trapped an open here */ + /* so simply continue by falling thru */ +#endif /* !HAVE_PTYTRAP */ + } + } + + if (!timerToken) { + if (timeout >= 0) { + timerToken = Tcl_CreateTimerHandler(1000*timeout, + exp_timehandler, + (ClientData)&timerFired); + } + } + + /* make sure that all fds that should be armed are */ + for (i=0;ifg_armed) { + /*printf("CreateChannelHandler: %s\r\n",esPtr->name);*/ + Tcl_CreateChannelHandler( + esPtr->channel, + TCL_READABLE | TCL_EXCEPTION, + exp_channelhandler, + (ClientData)esPtr); + esPtr->fg_armed = TRUE; + } + } + + Tcl_DoOneEvent(0); /* do any event */ + + if (timerFired) return(EXP_TIMEOUT); + + if (old_configure_count != exp_configure_count) { + RETURN(EXP_RECONFIGURE); + } + } +} + +/* Having been told there was an event for a specific ExpState, get it */ +/* This returns status, one of EOF, TIMEOUT, ERROR or DATA */ +/*ARGSUSED*/ +int +exp_get_next_event_info(interp,esPtr) +Tcl_Interp *interp; +ExpState *esPtr; +{ +#ifdef HAVE_PTYTRAP + struct request_info ioctl_info; +#endif + + if (esPtr->notifiedMask & TCL_READABLE) return EXP_DATA_NEW; + + /* ready_mask must contain TCL_EXCEPTION */ +#ifndef HAVE_PTYTRAP + return(EXP_EOF); +#else + if (ioctl(esPtr->fdin,TIOCREQCHECK,&ioctl_info) < 0) { + expDiagLog("ioctl error on TIOCREQCHECK: %s", + Tcl_PosixError(interp)); + return(EXP_TCLERROR); + } + if (ioctl_info.request == TIOCCLOSE) { + return(EXP_EOF); + } + if (ioctl(esPtr->fdin, TIOCREQSET, &ioctl_info) < 0) { + expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno)); + } + /* presumably, we trapped an open here */ + /* call it an error for lack of anything more descriptive */ + /* it will be thrown away by caller anyway */ + return EXP_TCLERROR; #endif } /*ARGSUSED*/ int /* returns TCL_XXX */ exp_dsleep(interp,sec) Tcl_Interp *interp; double sec; { - int timer_fired = FALSE; - - Tcl_CreateTimerHandler((int)(sec*1000),exp_timehandler,(ClientData)&timer_fired); - - while (1) { - Tcl_DoOneEvent(0); - if (timer_fired) return TCL_OK; - - if (ready_fd == EXP_SPAWN_ID_BAD) continue; - - exp_event_disarm_fast(ready_fd,exp_filehandler); - ready_fd = EXP_SPAWN_ID_BAD; - } -} - -#if 0 -/*ARGSUSED*/ -int /* returns TCL_XXX */ -exp_usleep(interp,usec) -Tcl_Interp *interp; -long usec; -{ - int timer_fired = FALSE; - - Tcl_CreateTimerHandler(usec/1000,exp_timehandler,(ClientData)&timer_fired); - - while (1) { - Tcl_DoOneEvent(0); - if (timer_fired) return TCL_OK; - - if (ready_fd == EXP_SPAWN_ID_BAD) continue; - - exp_event_disarm_fast(ready_fd,exp_filehandler); - ready_fd = EXP_SPAWN_ID_BAD; - } -} -#endif + int timerFired = FALSE; + + Tcl_CreateTimerHandler((int)(sec*1000),exp_timehandler,(ClientData)&timerFired); + + while (!timerFired) { + Tcl_DoOneEvent(0); + } + return TCL_OK; +} static char destroy_cmd[] = "destroy ."; static void exp_event_exit_real(interp) Tcl_Interp *interp; { - Tcl_Eval(interp,destroy_cmd); + Tcl_Eval(interp,destroy_cmd); } /* set things up for later calls to event handler */ void exp_init_event() { - exp_event_exit = exp_event_exit_real; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->rr = 0; + + exp_event_exit = exp_event_exit_real; } Index: exp_event.h ================================================================== --- exp_event.h +++ exp_event.h @@ -1,19 +1,21 @@ /* exp_event.h - event definitions */ -int exp_get_next_event _ANSI_ARGS_((Tcl_Interp *,int *, int, int *, int, int)); -int exp_get_next_event_info _ANSI_ARGS_((Tcl_Interp *, int, int)); +int exp_get_next_event _ANSI_ARGS_((Tcl_Interp *,ExpState **, int, ExpState **, int, int)); +int exp_get_next_event_info _ANSI_ARGS_((Tcl_Interp *, ExpState *)); int exp_dsleep _ANSI_ARGS_((Tcl_Interp *, double)); void exp_init_event _ANSI_ARGS_((void)); extern void (*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *)); -void exp_event_disarm _ANSI_ARGS_((int)); - -void exp_arm_background_filehandler _ANSI_ARGS_((int)); -void exp_disarm_background_filehandler _ANSI_ARGS_((int)); -void exp_disarm_background_filehandler_force _ANSI_ARGS_((int)); -void exp_unblock_background_filehandler _ANSI_ARGS_((int)); -void exp_block_background_filehandler _ANSI_ARGS_((int)); - -void exp_background_filehandler _ANSI_ARGS_((ClientData,int)); +void exp_event_disarm _ANSI_ARGS_((ExpState *,Tcl_FileProc *)); +void exp_event_disarm_bg _ANSI_ARGS_((ExpState *)); +void exp_event_disarm_fg _ANSI_ARGS_((ExpState *)); + +void exp_arm_background_channelhandler _ANSI_ARGS_((ExpState *)); +void exp_disarm_background_channelhandler _ANSI_ARGS_((ExpState *)); +void exp_disarm_background_channelhandler_force _ANSI_ARGS_((ExpState *)); +void exp_unblock_background_channelhandler _ANSI_ARGS_((ExpState *)); +void exp_block_background_channelhandler _ANSI_ARGS_((ExpState *)); + +void exp_background_channelhandler _ANSI_ARGS_((ClientData,int)); Index: exp_glob.c ================================================================== --- exp_glob.c +++ exp_glob.c @@ -13,60 +13,22 @@ #include "expect_cf.h" #include "tcl.h" #include "exp_int.h" -#if 0 -/* The following functions implement expect's glob-style string matching */ -/* Exp_StringMatch allow's implements the unanchored front (or conversely */ -/* the '^') feature. Exp_StringMatch2 does the rest of the work. */ -int /* returns # of chars that matched */ -Exp_StringMatch(string, pattern,offset) -char *string; -char *pattern; -int *offset; /* offset from beginning of string where pattern matches */ -{ - char *s; - int sm; /* count of chars matched or -1 */ - int caret = FALSE; - - *offset = 0; - - if (pattern[0] == '^') { - caret = TRUE; - pattern++; - } - - sm = Exp_StringMatch2(string,pattern); - if (sm >= 0) return(sm); - - if (caret) return(-1); - - if (pattern[0] == '*') return(-1); - - for (s = string;*s;s++) { - sm = Exp_StringMatch2(s,pattern); - if (sm != -1) { - *offset = s-string; - return(sm); - } - } - return(-1); -} -#endif - -/* The following functions implement expect's glob-style string matching */ -/* Exp_StringMatch allow's implements the unanchored front (or conversely */ -/* the '^') feature. Exp_StringMatch2 does the rest of the work. */ -int /* returns # of chars that matched */ -Exp_StringMatch(string, pattern,offset) -char *string; -char *pattern; -int *offset; /* offset from beginning of string where pattern matches */ -{ - char *s; - int sm; /* count of chars matched or -1 */ +/* The following functions implement expect's glob-style string matching */ +/* Exp_StringMatch allow's implements the unanchored front (or conversely */ +/* the '^') feature. Exp_StringMatch2 does the rest of the work. */ +int /* returns # of BYTES that matched */ +Exp_StringCaseMatch(string, pattern, nocase, offset) /* INTL */ +char *string; +char *pattern; +int nocase; +int *offset; /* offset in bytes from beginning of string where pattern matches */ +{ + char *s; + int sm; /* count of bytes matched or -1 */ int caret = FALSE; int star = FALSE; *offset = 0; @@ -81,45 +43,49 @@ * test if pattern matches in initial position. * This handles front-anchor and 1st iteration of non-front-anchor. * Note that 1st iteration must be tried even if string is empty. */ - sm = Exp_StringMatch2(string,pattern); + sm = Exp_StringCaseMatch2(string,pattern, nocase); if (sm >= 0) return(sm); if (caret) return -1; if (star) return -1; if (*string == '\0') return -1; - for (s = string+1;*s;s++) { - sm = Exp_StringMatch2(s,pattern); + for (s = Tcl_UtfNext(string);*s;s = Tcl_UtfNext(s)) { + sm = Exp_StringCaseMatch2(s,pattern, nocase); if (sm != -1) { *offset = s-string; return(sm); } } return -1; } -/* Exp_StringMatch2 -- +/* Exp_StringCaseMatch2 -- -Like Tcl_StringMatch except that +Like Tcl_StringCaseMatch except that 1) returns number of characters matched, -1 if failed. (Can return 0 on patterns like "" or "$") 2) does not require pattern to match to end of string 3) much of code is stolen from Tcl_StringMatch 4) front-anchor is assumed (Tcl_StringMatch retries for non-front-anchor) */ -int Exp_StringMatch2(string,pattern) +int Exp_StringCaseMatch2(string,pattern, nocase) /* INTL */ register char *string; /* String. */ register char *pattern; /* Pattern, which may contain * special characters. */ + int nocase; { - char c2; - int match = 0; /* # of chars matched */ + Tcl_UniChar ch1, ch2; + int match = 0; /* # of bytes matched */ + char *oldString; + + char *pstart = pattern; while (1) { /* If at end of pattern, success! */ if (*pattern == 0) { return match; @@ -138,44 +104,33 @@ * recursively for each postfix of string, until either we * match or we reach the end of the string. */ if (*pattern == '*') { -#if 1 - int head_len; char *tail; -#endif + pattern += 1; if (*pattern == 0) { return(strlen(string)+match); /* DEL */ } -#if 1 - /* find longest match - switched to this on 12/31/93 */ - head_len = strlen(string); /* length before tail */ - tail = string + head_len; - while (head_len >= 0) { + + /* find LONGEST match */ + tail = string + strlen(string); + while (1) { int rc; - if (-1 != (rc = Exp_StringMatch2(tail, pattern))) { - return rc + match + head_len; /* DEL */ - } - tail--; - head_len--; - } -#else - /* find shortest match */ - while (*string != 0) { - int rc; /* DEL */ - - if (-1 != (rc = Exp_StringMatch2(string, pattern))) { - return rc+match; /* DEL */ - } - string += 1; - match++; /* DEL */ - } - if (*pattern == '$') return 0; /* handle *$ */ -#endif + if (-1 != (rc = Exp_StringCaseMatch2(tail, pattern, nocase))) { + return match + (tail - string) + rc; + /* match = # of bytes we've skipped before this */ + /* (...) = # of bytes we've skipped due to "*" */ + /* rc = # of bytes we've matched after "*" */ + } + + /* if we've backed up to beginning of string, give up */ + if (tail == string) break; + tail = Tcl_UtfPrev(tail,string); + } return -1; /* DEL */ } /* * after this point, all patterns must match at least one @@ -187,60 +142,70 @@ /* Check for a "?" as the next pattern character. It matches * any single character. */ if (*pattern == '?') { - goto thisCharOK; + pattern++; + oldString = string; + string = Tcl_UtfNext(string); + match += (string - oldString); /* incr by # of bytes in char */ + continue; } /* Check for a "[" as the next pattern character. It is followed * by a list of characters that are acceptable, or by a range * (two characters separated by "-"). */ if (*pattern == '[') { - pattern += 1; + Tcl_UniChar ch, startChar, endChar; + + pattern++; + oldString = string; + string += Tcl_UtfToUniChar(string, &ch); + while (1) { - if ((*pattern == ']') || (*pattern == 0)) { + if ((*pattern == ']') || (*pattern == '\0')) { return -1; /* was 0; DEL */ } - if (*pattern == *string) { - break; + pattern += Tcl_UtfToUniChar(pattern, &startChar); + if (nocase) { + startChar = Tcl_UniCharToLower(startChar); } - if (pattern[1] == '-') { - c2 = pattern[2]; - if (c2 == 0) { + if (*pattern == '-') { + pattern++; + if (*pattern == '\0') { return -1; /* DEL */ } - if ((*pattern <= *string) && (c2 >= *string)) { - break; - } - if ((*pattern >= *string) && (c2 <= *string)) { - break; - } - pattern += 2; - } - pattern += 1; - } - -/* OOPS! Found a bug in vanilla Tcl - have sent back to Ousterhout */ -/* but he hasn't integrated it yet. - DEL */ - -#if 0 - while ((*pattern != ']') && (*pattern != 0)) { -#else - while (*pattern != ']') { - if (*pattern == 0) { - pattern--; - break; - } -#endif - pattern += 1; - } - goto thisCharOK; - } - + pattern += Tcl_UtfToUniChar(pattern, &endChar); + if (nocase) { + endChar = Tcl_UniCharToLower(endChar); + } + if (((startChar <= ch) && (ch <= endChar)) + || ((endChar <= ch) && (ch <= startChar))) { + /* + * Matches ranges of form [a-z] or [z-a]. + */ + + break; + } + } else if (startChar == ch) { + break; + } + } + while (*pattern != ']') { + if (*pattern == '\0') { + pattern = Tcl_UtfPrev(pattern, pstart); + break; + } + pattern = Tcl_UtfNext(pattern); + } + pattern++; + match += (string - oldString); /* incr by # of bytes in char */ + continue; + } + /* If the next pattern character is backslash, strip it off * so we do exact matching on the character that follows. */ if (*pattern == '\\') { @@ -252,15 +217,18 @@ /* There's no special character. Just make sure that the next * characters of each string match. */ - if (*pattern != *string) { + oldString = string; + string += Tcl_UtfToUniChar(string, &ch1); + pattern += Tcl_UtfToUniChar(pattern, &ch2); + if (nocase) { + if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { + return -1; + } + } else if (ch1 != ch2) { return -1; } - - thisCharOK: pattern += 1; - string += 1; - match++; + match += (string - oldString); /* incr by # of bytes in char */ } } - Index: exp_int.h ================================================================== --- exp_int.h +++ exp_int.h @@ -19,13 +19,18 @@ #define memcpy(x,y,len) bcopy(y,x,len) #endif #include -int Exp_StringMatch(); -int Exp_StringMatch2(); -void exp_console_set _ANSI_ARGS_((void)); +void exp_console_set _ANSI_ARGS_((void)); +void expDiagLogPtrSet _ANSI_ARGS_((void (*)_ANSI_ARGS_((char *)))); +void expDiagLogPtr _ANSI_ARGS_((char *)); +void expDiagLogPtrX _ANSI_ARGS_((char *,int)); +void expDiagLogPtrStr _ANSI_ARGS_((char *,char *)); +void expDiagLogPtrStrStr _ANSI_ARGS_((char *,char *,char *)); +void expErrnoMsgSet _ANSI_ARGS_((char * (*) _ANSI_ARGS_((int)))); +char * expErrnoMsg _ANSI_ARGS_((int)); #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else # include /* for malloc */ Index: exp_inter.c ================================================================== --- exp_inter.c +++ exp_inter.c @@ -41,19 +41,24 @@ #include "exp_tty_in.h" #include "exp_rename.h" #include "exp_prog.h" #include "exp_command.h" #include "exp_log.h" -#include "exp_tstamp.h" /* remove when timestamp stuff is gone */ -#include "tclRegexp.h" -#include "exp_regexp.h" +typedef struct ThreadSpecificData { + Tcl_Obj *cmdObjReturn; + Tcl_Obj *cmdObjInterpreter; +} ThreadSpecificData; -extern char *TclGetRegError(); -extern void TclRegError(); +static Tcl_ThreadDataKey dataKey; #define INTER_OUT "interact_out" +#define out(var,val) \ + expDiagLog("interact: set %s(%s) ",INTER_OUT,var); \ + expDiagLogU(expPrintify(val)); \ + expDiagLogU("\"\r\n"); \ + Tcl_SetVar2(interp,INTER_OUT,var,val,0); /* * tests if we are running this using a real tty * * these tests are currently only used to control what gets written to the @@ -68,27 +73,26 @@ #if 0 #define real_tty_output(x) (exp_stdout_is_tty && (((x)==1) || ((x)==exp_dev_tty))) #define real_tty_input(x) (exp_stdin_is_tty && (((x)==0) || ((x)==exp_dev_tty))) #endif -#define real_tty_output(x) (((x)==1) || ((x)==exp_dev_tty)) -#define real_tty_input(x) (exp_stdin_is_tty && (((x)==0) || ((x)==exp_dev_tty))) +#define real_tty_output(x) ((x->fdout == 1) || (expDevttyIs(x))) +#define real_tty_input(x) (exp_stdin_is_tty && ((x->fdin==0) || (expDevttyIs(x)))) #define new(x) (x *)ckalloc(sizeof(x)) struct action { - char *statement; + Tcl_Obj *statement; int tty_reset; /* if true, reset tty mode upon action */ int iread; /* if true, reread indirects */ int iwrite; /* if true, write spawn_id element */ - int timestamp; /* if true, generate timestamp */ struct action *next; /* chain only for later for freeing */ }; struct keymap { - char *keys; /* original pattern provided by user */ - regexp *re; + Tcl_Obj *keys; /* original pattern provided by user */ + int re; /* true if looking to match a regexp. */ int null; /* true if looking to match 0 byte */ int case_sensitive; int echo; /* if keystrokes should be echoed */ int writethru; /* if keystrokes should go through to process */ int indices; /* true if should write indices */ @@ -110,26 +114,59 @@ struct keymap *keymap; int timeout_nominal; /* timeout nominal */ int timeout_remaining; /* timeout remaining */ struct input *next; }; + +/* + * Once we are handed an ExpState from the event handler, we can figure out + * which "struct input *" it references by using expStateToInput. This has is + * populated by expCreateStateToInput. + */ + +struct input * +expStateToInput(hash,esPtr) + ExpState *esPtr; + Tcl_HashTable *hash; +{ + Tcl_HashEntry *entry = Tcl_FindHashEntry(hash,(char *)esPtr); + + if (!entry) { + /* should never happen */ + return 0; + } + return ((struct input *)Tcl_GetHashValue(entry)); +} + +void +expCreateStateToInput(hash,esPtr,inp) + ExpState *esPtr; + Tcl_HashTable *hash; + struct input *inp; +{ + Tcl_HashEntry *entry; + int newPtr; + + entry = Tcl_CreateHashEntry(hash,(char *)esPtr,&newPtr); + Tcl_SetHashValue(entry,(ClientData)inp); +} static void free_input(); static void free_keymap(); static void free_output(); static void free_action(); static struct action *new_action(); static int inter_eval(); -/* in_keymap() accepts user keystrokes and returns one of MATCH, +/* intMatch() accepts user keystrokes and returns one of MATCH, CANMATCH, or CANTMATCH. These describe whether the keystrokes match a key sequence, and could or can't if more characters arrive. The function assigns a matching keymap if there is a match or can-match. A matching keymap is assigned on can-match so we know whether to echo or not. -in_keymap is optimized (if you can call it that) towards a small +intMatch is optimized (if you can call it that) towards a small number of key mappings, but still works well for large maps, since no function calls are made, and we stop as soon as there is a single-char mismatch, and go on to the next one. A hash table or compiled DFA probably would not buy very much here for most maps. @@ -147,148 +184,290 @@ we're ready). The other is to return can-match. */ static int -in_keymap(string,stringlen,keymap,km_match,match_length,skip,rm_nulls) -char *string; -int stringlen; -struct keymap *keymap; /* linked list of keymaps */ -struct keymap **km_match; /* keymap that matches or can match */ -int *match_length; /* # of chars that matched */ -int *skip; /* # of chars to skip */ -int rm_nulls; /* skip nulls if true */ -{ - struct keymap *km; - char *ks; /* string from a keymap */ - char *start_search; /* where in the string to start searching */ - char *string_end; - - /* assert (*km == 0) */ - - /* a shortcut that should help master output which typically */ - /* is lengthy and has no key maps. Otherwise it would mindlessly */ - /* iterate on each character anyway. */ - if (!keymap) { - *skip = stringlen; - return(EXP_CANTMATCH); - } - - string_end = string + stringlen; - - /* Mark beginning of line for ^ . */ - regbol = string; - -/* skip over nulls - Pascal Meheut, pascal@cnam.cnam.fr 18-May-1993 */ -/* for (start_search = string;*start_search;start_search++) {*/ - for (start_search = string;start_searchbuffer,&stringBytes); + + /* assert (*km == 0) */ + + /* a shortcut that should help master output which typically */ + /* is lengthy and has no key maps. Otherwise it would mindlessly */ + /* iterate on each character anyway. */ + if (!keymap) { + *skip = stringBytes; + return(EXP_CANTMATCH); + } + + rm_nulls = esPtr->rm_nulls; + + string_end = string + stringBytes; + + /* + * Maintain both a character index and a string pointer so we + * can easily index into either the UTF or the Unicode representations. + */ + + for (start_search = string, offset = 0; + start_search < string_end; + start_search += bytesThisChar, offset++) { + + bytesThisChar = Tcl_UtfToUniChar(start_search, &ch); + if (*km_match) break; /* if we've already found a CANMATCH */ /* don't bother starting search from positions */ /* further along the string */ for (km=keymap;km;km=km->next) { char *s; /* current character being examined */ if (km->null) { - if (*start_search == 0) { + if (ch == 0) { *skip = start_search-string; - *match_length = 1; /* s - start_search == 1 */ + *matchLen = 1; /* s - start_search == 1 */ *km_match = km; return(EXP_MATCH); } } else if (!km->re) { + int slen, kslen; + Tcl_UniChar sch, ksch; + /* fixed string */ - for (s = start_search,ks = km->keys ;;s++,ks++) { - /* if we hit the end of this map, must've matched! */ - if (*ks == 0) { - *skip = start_search-string; - *match_length = s-start_search; - *km_match = km; - return(EXP_MATCH); - } - - /* if we ran out of user-supplied characters, and */ - /* still haven't matched, it might match if the user */ - /* supplies more characters next time */ - - if (s == string_end) { - /* skip to next key entry, but remember */ - /* possibility that this entry might match */ - if (!*km_match) *km_match = km; - break; - } - - /* if this is a problem for you, use exp_parity command */ -/* if ((*s & 0x7f) == *ks) continue;*/ - if (*s == *ks) continue; - if ((*s == '\0') && rm_nulls) { - ks--; - continue; - } - break; + + ks = Tcl_GetString(km->keys); + for (s = start_search;; s += slen, ks += kslen) { + /* if we hit the end of this map, must've matched! */ + if (*ks == 0) { + *skip = start_search-string; + *matchLen = s-start_search; + *km_match = km; + return(EXP_MATCH); + } + + /* if we ran out of user-supplied characters, and */ + /* still haven't matched, it might match if the user */ + /* supplies more characters next time */ + + if (s == string_end) { + /* skip to next key entry, but remember */ + /* possibility that this entry might match */ + if (!*km_match) *km_match = km; + break; + } + + slen = Tcl_UtfToUniChar(s, &sch); + kslen = Tcl_UtfToUniChar(ks, &ksch); + + if (sch == ksch) continue; + if ((sch == '\0') && rm_nulls) { + kslen = 0; + continue; + } + break; } } else { /* regexp */ - int r; /* regtry status */ - regexp *prog = km->re; - - /* if anchored, but we're not at beginning, skip pattern */ - if (prog->reganch) { - if (string != start_search) continue; - } - - /* known starting char - quick test 'fore lotta work */ - if (prog->regstart) { - /* if this is a problem for you, use exp_parity command */ -/* /* if ((*start_search & 0x7f) != prog->regstart) continue; */ - if (*start_search != prog->regstart) continue; - } - r = exp_regtry(prog,start_search,match_length); - if (r == EXP_MATCH) { - *km_match = km; - *skip = start_search-string; - return(EXP_MATCH); - } - if (r == EXP_CANMATCH) { + Tcl_RegExp re; + int flags; + int result; + + re = Tcl_GetRegExpFromObj(NULL, km->keys, + TCL_REG_ADVANCED|TCL_REG_BOSONLY|TCL_REG_CANMATCH); + flags = (offset > 0) ? TCL_REG_NOTBOL : 0; + + result = Tcl_RegExpExecObj(NULL, re, esPtr->buffer, offset, + -1 /* nmatches */, flags); + if (result > 0) { + *km_match = km; + *skip = start_search-string; + Tcl_RegExpGetInfo(re, info); + *matchLen = Tcl_UtfAtIndex(start_search,info->matches[0].end) - start_search; + return EXP_MATCH; + } else if (result == 0) { + Tcl_RegExpGetInfo(re, info); + + /* + * Check to see if there was a partial match starting + * at the current character. + */ + if (info->extendStart == 0) { if (!*km_match) *km_match = km; - } - } - } - } - - if (*km_match) { - /* report a can-match */ - - char *p; - - *skip = (start_search-string)-1; -#if 0 - *match_length = stringlen - *skip; -#else - /* - * there may be nulls in the string in which case - * the pattern matchers can report CANMATCH when - * the null is hit. So find the null and compute - * the length of the possible match. - * - * Later, after we squeeze out the nulls, we will - * retry the match, but for now, go along with - * calling it a CANMATCH - */ - p = start_search; - while (*p) { - p++; - } - *match_length = (p - start_search) + 1; - /*printf(" match_length = %d\n",*match_length);*/ + } + } + } + } + } + + if (*km_match) { + /* report CANMATCH for -re and -ex */ + + /* + * since canmatch is only detected after we've advanced too far, + * adjust start_search back to make other computations simpler + */ + start_search--; + + *skip = start_search - string; + *matchLen = string_end - start_search; + return(EXP_CANMATCH); + } + + *skip = start_search-string; + return(EXP_CANTMATCH); +} + +/* put regexp result in variables */ +static void +intRegExpMatchProcess(interp,esPtr,km,info,offset) + Tcl_Interp *interp; + ExpState *esPtr; + struct keymap *km; /* ptr for above while parsing */ + Tcl_RegExpInfo *info; + int offset; +{ + char name[20], value[20]; + int i; + + for (i=0;i<=info->nsubs;i++) { + int start, end; + Tcl_Obj *val; + + start = info->matches[i].start + offset; + if (start == -1) continue; + end = (info->matches[i].end-1) + offset; + + if (km->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(esPtr->buffer, start, end); + expDiagLog("expect_background: set %s(%s) \"",INTER_OUT,name); + expDiagLogU(expPrintifyObj(val)); + expDiagLogU("\"\r\n"); + Tcl_SetVar2Ex(interp,INTER_OUT,name,val,0); + } +} + +/* + * echo chars + */ +static void +intEcho(esPtr,skipBytes,matchBytes) + ExpState *esPtr; + int skipBytes; + int matchBytes; +{ + int seenBytes; /* either printed or echoed */ + int echoBytes; + int offsetBytes; + + /* write is unlikely to fail, since we just read from same descriptor */ + seenBytes = esPtr->printed + esPtr->echoed; + if (skipBytes >= seenBytes) { + echoBytes = matchBytes; + offsetBytes = skipBytes; + } else if ((matchBytes + skipBytes - seenBytes) > 0) { + echoBytes = matchBytes + skipBytes - seenBytes; + offsetBytes = seenBytes; + } + + Tcl_WriteChars(esPtr->channel, + Tcl_GetString(esPtr->buffer) + offsetBytes, + echoBytes); + + esPtr->echoed = matchBytes + skipBytes - esPtr->printed; +} + +/* + * intRead() does the logical equivalent of a read() for the interact command. + * Returns # of bytes read or negative number (EXP_XXX) indicating unusual event. + */ +static int +intRead(interp,esPtr,warnOnBufferFull,interruptible,key) + Tcl_Interp *interp; + ExpState *esPtr; + int warnOnBufferFull; + int interruptible; + int key; +{ + char *eobOld; /* old end of buffer */ + int cc; + int size; + char *str; + + str = Tcl_GetStringFromObj(esPtr->buffer,&size); + eobOld = str+size; + + if (size + TCL_UTF_MAX >= esPtr->msize) { + /* + * In theory, interact could be invoked when this situation + * already exists, hence the "probably" in the warning below + */ + if (warnOnBufferFull) { + expDiagLogU("WARNING: interact buffer is full, probably because your\r\n"); + expDiagLogU("patterns have matched all of it but require more chars\r\n"); + expDiagLogU("in order to complete the match.\r\n"); + expDiagLogU("Dumping first half of buffer in order to continue\r\n"); + expDiagLogU("Recommend you enlarge the buffer or fix your patterns.\r\n"); + } + exp_buffer_shuffle(interp,esPtr,0,INTER_OUT,"interact"); + } + if (!interruptible) { + cc = Tcl_ReadChars(esPtr->channel, + esPtr->buffer, + esPtr->msize - (size / TCL_UTF_MAX), + 1 /* append */); + } else { +#ifdef SIMPLE_EVENT + cc = intIRead(esPtr->channel, + esPtr->buffer, + esPtr->msize - (size / TCL_UTF_MAX), + 1 /* append */); #endif - return(EXP_CANMATCH); - } + } - *skip = start_search-string; - return(EXP_CANTMATCH); + if (cc > 0) { + expDiagLog("spawn id %s sent <",esPtr->name); + expDiagLogU(expPrintify(eobOld)); + expDiagLogU(">\r\n"); + + esPtr->key = key; + } + return cc; } + + #ifdef SIMPLE_EVENT /* @@ -317,95 +496,100 @@ #define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) #endif #include +#ifdef HAVE_SIGLONGJMP +static sigjmp_buf env; /* for interruptable read() */ +#else static jmp_buf env; /* for interruptable read() */ +#endif /* HAVE_SIGLONGJMP */ + static int reading; /* while we are reading */ /* really, while "env" is valid */ static int deferred_interrupt = FALSE; /* if signal is received, but not */ - /* in i_read record this here, so it will */ - /* be handled next time through i_read */ - -void sigchld_handler() -{ - if (reading) longjmp(env,1); - - deferred_interrupt = TRUE; + /* in expIRead record this here, so it will */ + /* be handled next time through expIRead */ + +static void +sigchld_handler() +{ + if (reading) { +#ifdef HAVE_SIGLONGJMP + siglongjmp(env,1); +#else + longjmp(env,1); +#endif /* HAVE_SIGLONGJMP */ + } + deferred_interrupt = TRUE; } #define EXP_CHILD_EOF -100 -/* interruptable read */ +/* + * Name: expIRead, do an interruptable read + * + * intIRead() reads from chars from the user. + * + * It returns early if it detects the death of a proc (either the spawned + * process or the child (surrogate). + */ static int -i_read(fd,buffer,length) -int fd; -char *buffer; -int length; -{ - int cc = EXP_CHILD_EOF; - - if (deferred_interrupt) return(cc); - - if (0 == setjmp(env)) { - reading = TRUE; - cc = read(fd,buffer,length); - } - reading = FALSE; - return(cc); +intIRead(channel,obj,size,flags); +Tcl_Channel channel; +Tcl_Obj *obj; +int size; +int flags; +{ + int cc = EXP_CHILD_EOF; + + if (deferred_interrupt) return(cc); + +#ifdef HAVE_SIGLONGJMP + if (0 == sigsetjmp(env,1)) { +#else + if (0 == setjmp(env)) { +#endif /* HAVE_SIGLONGJMP */ + reading = TRUE; + cc = Tcl_ReadChars(channel,obj,size,flags); + } + reading = FALSE; + return(cc); } /* exit status for the child process created by cmdInteract */ #define CHILD_DIED -2 #define SPAWNED_PROCESS_DIED -3 static void -clean_up_after_child(interp,master) -Tcl_Interp *interp; -int master; -{ -/* should really be recoded using the common wait code in command.c */ - int status; - int pid; - int i; - - pid = wait(&status); /* for slave */ - for (i=0;i<=exp_fd_max;i++) { - if (exp_fs[i].pid == pid) { - exp_fs[i].sys_waited = TRUE; - exp_fs[i].wait = status; - } - } - pid = wait(&status); /* for child */ - for (i=0;i<=exp_fd_max;i++) { - if (exp_fs[i].pid == pid) { - exp_fs[i].sys_waited = TRUE; - exp_fs[i].wait = status; - } - } - - deferred_interrupt = FALSE; - exp_close(interp,master); - master = -1; +clean_up_after_child(interp,esPtr) +Tcl_Interp *interp; +ExpState *esPtr; +{ + expWaitOnOne(); /* wait for slave */ + expWaitOnOne(); /* wait for child */ + + deferred_interrupt = FALSE; + exp_close(interp,esPtr); } #endif /*SIMPLE_EVENT*/ static int -update_interact_fds(interp,fd_count,fd_to_input,fd_list,input_base, +update_interact_fds(interp,esPtrCount,esPtrToInput,esPtrs,input_base, do_indirect,config_count,real_tty_caller) Tcl_Interp *interp; -int *fd_count; -struct input ***fd_to_input; /* map from fd's to "struct input"s */ -int **fd_list; +int *esPtrCount; +Tcl_HashTable **esPtrToInput; /* map from ExpStates to "struct inputs" */ +ExpState ***esPtrs; struct input *input_base; int do_indirect; /* if true do indirects */ int *config_count; int *real_tty_caller; { struct input *inp; struct output *outp; - struct exp_fd_list *fdp; + struct exp_state_list *fdp; int count; int real_tty = FALSE; *config_count = exp_configure_count; @@ -425,58 +609,57 @@ } } } /* revalidate all input descriptors */ - for (fdp = inp->i_list->fd_list;fdp;fdp=fdp->next) { - count++; - /* have to "adjust" just in case spawn id hasn't had */ - /* a buffer sized yet */ - if (!exp_fd2f(interp,fdp->fd,1,1,"interact")) - return(TCL_ERROR); + for (fdp = inp->i_list->state_list;fdp;fdp=fdp->next) { + count++; + /* have to "adjust" just in case spawn id hasn't had */ + /* a buffer sized yet */ + if (!expStateCheck(interp,fdp->esPtr,1,1,"interact")) { + return(TCL_ERROR); + } } /* revalidate all output descriptors */ for (outp = inp->output;outp;outp=outp->next) { - for (fdp = outp->i_list->fd_list;fdp;fdp=fdp->next) { + for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) { /* make user_spawn_id point to stdout */ - if (fdp->fd == 0) { - fdp->fd = 1; - } else if (fdp->fd == 1) { - /* do nothing */ - } else if (!exp_fd2f(interp,fdp->fd,1,0,"interact")) - return(TCL_ERROR); + if (!expStdinoutIs(fdp->esPtr)) { + if (!expStateCheck(interp,fdp->esPtr,1,0,"interact")) + return(TCL_ERROR); + } } } } if (!do_indirect) return TCL_OK; - if (*fd_to_input == 0) { - *fd_to_input = (struct input **)ckalloc( - (exp_fd_max+1) * sizeof(struct input *)); - *fd_list = (int *)ckalloc(count * sizeof(int)); + if (*esPtrToInput == 0) { + *esPtrToInput = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); + *esPtrs = (ExpState **)ckalloc(count * sizeof(ExpState *)); } else { - *fd_to_input = (struct input **)ckrealloc((char *)*fd_to_input, - (exp_fd_max+1) * sizeof(struct input *)); - *fd_list = (int *)ckrealloc((char *)*fd_list,count * sizeof(int)); + /* if hash table already exists, delete it and start over */ + Tcl_DeleteHashTable(*esPtrToInput); + *esPtrs = (ExpState **)ckrealloc((char *)*esPtrs,count * sizeof(ExpState *)); } + Tcl_InitHashTable(*esPtrToInput,TCL_ONE_WORD_KEYS); count = 0; for (inp = input_base;inp;inp=inp->next) { - for (fdp = inp->i_list->fd_list;fdp;fdp=fdp->next) { - /* build map to translate from spawn_id to struct input */ - (*fd_to_input)[fdp->fd] = inp; - - /* build input to ready() */ - (*fd_list)[count] = fdp->fd; - - if (real_tty_input(fdp->fd)) real_tty = TRUE; - - count++; - } - } - *fd_count = count; + for (fdp = inp->i_list->state_list;fdp;fdp=fdp->next) { + /* build map to translate from spawn_id to struct input */ + expCreateStateToInput(*esPtrToInput,fdp->esPtr,inp); + + /* build input to ready() */ + (*esPtrs)[count] = fdp->esPtr; + + if (real_tty_input(fdp->esPtr)) real_tty = TRUE; + + count++; + } + } + *esPtrCount = count; *real_tty_caller = real_tty; /* tell caller if we have found that */ /* we are using real tty */ return TCL_OK; @@ -500,982 +683,890 @@ static char return_cmd[] = "return"; static char interpreter_cmd[] = "interpreter"; /*ARGSUSED*/ int -Exp_InteractCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - char *arg; /* shorthand for current argv */ -#ifdef SIMPLE_EVENT - int pid; -#endif /*SIMPLE_EVENT*/ - - /*declarations*/ - int input_count; /* count of struct input descriptors */ - struct input **fd_to_input; /* map from fd's to "struct input"s */ - int *fd_list; - struct keymap *km; /* ptr for above while parsing */ -/* extern char *tclRegexpError; /* declared in tclInt.h */ - int master = EXP_SPAWN_ID_BAD; - char *master_string = 0;/* string representation of master */ - int need_to_close_master = FALSE; /* if an eof is received */ - /* we use this to defer close until later */ - - int next_tty_reset = FALSE; /* if we've seen a single -reset */ - int next_iread = FALSE;/* if we've seen a single -iread */ - int next_iwrite = FALSE;/* if we've seen a single -iread */ - int next_re = FALSE; /* if we've seen a single -re */ - int next_null = FALSE; /* if we've seen the null keyword */ - int next_writethru = FALSE;/*if macros should also go to proc output */ - int next_indices = FALSE;/* if we should write indices */ - int next_echo = FALSE; /* if macros should be echoed */ - int next_timestamp = FALSE; /* if we should generate a timestamp */ -/* int next_case_sensitive = TRUE;*/ - char **oldargv = 0; /* save original argv here if we split it */ - int status = TCL_OK; /* final return value */ - int i; /* trusty temp */ - - int timeout_simple = TRUE; /* if no or global timeout */ - - int real_tty; /* TRUE if we are interacting with real tty */ - int tty_changed = FALSE;/* true if we had to change tty modes for */ - /* interact to work (i.e., to raw, noecho) */ - int was_raw; - int was_echo; - exp_tty tty_old; - - char *replace_user_by_process = 0; /* for -u flag */ - - struct input *input_base; -#define input_user input_base - struct input *input_default; - struct input *inp; /* overused ptr to struct input */ - struct output *outp; /* overused ptr to struct output */ - - int dash_input_count = 0; /* # of "-input"s seen */ - int arbitrary_timeout; - int default_timeout; - struct action action_timeout; /* common to all */ - struct action action_eof; /* common to all */ - struct action **action_eof_ptr; /* allow -input/ouput to */ - /* leave their eof-action assignable by a later */ - /* -eof */ - struct action *action_base = 0; - struct keymap **end_km; - - int key; - int configure_count; /* monitor reconfigure events */ - - if ((argc == 2) && exp_one_arg_braced(argv[1])) { - return(exp_eval_with_one_arg(clientData,interp,argv)); - } else if ((argc == 3) && streq(argv[1],"-brace")) { - char *new_argv[2]; - new_argv[0] = argv[0]; - new_argv[1] = argv[2]; - return(exp_eval_with_one_arg(clientData,interp,new_argv)); - } - - argv++; - argc--; - - default_timeout = EXP_TIME_INFINITY; - arbitrary_timeout = EXP_TIME_INFINITY; /* if user specifies */ - /* a bunch of timeouts with EXP_TIME_INFINITY, this will be */ - /* left around for us to find. */ - - input_user = new(struct input); - input_user->i_list = exp_new_i_simple(0,EXP_TEMPORARY); /* stdin by default */ - input_user->output = 0; - input_user->action_eof = &action_eof; - input_user->timeout_nominal = EXP_TIME_INFINITY; - input_user->action_timeout = 0; - input_user->keymap = 0; - - end_km = &input_user->keymap; - inp = input_user; - action_eof_ptr = &input_user->action_eof; - - input_default = new(struct input); - input_default->i_list = exp_new_i_simple(EXP_SPAWN_ID_BAD,EXP_TEMPORARY); /* fix up later */ - input_default->output = 0; - input_default->action_eof = &action_eof; - input_default->timeout_nominal = EXP_TIME_INFINITY; - input_default->action_timeout = 0; - input_default->keymap = 0; - input_default->next = 0; /* no one else */ - input_user->next = input_default; - - /* default and common -eof action */ - action_eof.statement = return_cmd; - action_eof.tty_reset = FALSE; - action_eof.iread = FALSE; - action_eof.iwrite = FALSE; - action_eof.timestamp = FALSE; - - for (;argc>0;argc--,argv++) { - arg = *argv; - if (exp_flageq("eof",arg,3)) { - struct action *action; - - argc--;argv++; - *action_eof_ptr = action = new_action(&action_base); - - action->statement = *argv; - - action->tty_reset = next_tty_reset; - next_tty_reset = FALSE; - action->iwrite = next_iwrite; - next_iwrite = FALSE; - action->iread = next_iread; - next_iread = FALSE; - action->timestamp = next_timestamp; - next_timestamp = FALSE; - continue; - } else if (exp_flageq("timeout",arg,7)) { - int t; - struct action *action; - - argc--;argv++; - if (argc < 1) { - exp_error(interp,"timeout needs time"); - return(TCL_ERROR); - } - t = atoi(*argv); - argc--;argv++; - - /* we need an arbitrary timeout to start */ - /* search for lowest one later */ - if (t != -1) arbitrary_timeout = t; - - timeout_simple = FALSE; - action = inp->action_timeout = new_action(&action_base); - inp->timeout_nominal = t; - - action->statement = *argv; - - action->tty_reset = next_tty_reset; - next_tty_reset = FALSE; - action->iwrite = next_iwrite; - next_iwrite = FALSE; - action->iread = next_iread; - next_iread = FALSE; - action->timestamp = next_timestamp; - next_timestamp = FALSE; - continue; - } else if (exp_flageq("null",arg,4)) { - next_null = TRUE; - } else if (arg[0] == '-') { - arg++; - if (exp_flageq1('-',arg) /* "--" */ - || (exp_flageq("exact",arg,3))) { - argc--;argv++; - } else if (exp_flageq("regexp",arg,2)) { - if (argc < 1) { - exp_error(interp,"-re needs pattern"); - return(TCL_ERROR); - } - next_re = TRUE; - argc--; - argv++; - } else if (exp_flageq("input",arg,2)) { - dash_input_count++; - if (dash_input_count == 2) { - inp = input_default; - input_user->next = input_default; - } else if (dash_input_count > 2) { - struct input *previous_input = inp; - inp = new(struct input); - previous_input->next = inp; - } - inp->output = 0; - inp->action_eof = &action_eof; - action_eof_ptr = &inp->action_eof; - inp->timeout_nominal = default_timeout; - inp->action_timeout = &action_timeout; - inp->keymap = 0; - end_km = &inp->keymap; - inp->next = 0; - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-input needs argument"); - return(TCL_ERROR); - } -/* inp->spawn_id = atoi(*argv);*/ - inp->i_list = exp_new_i_complex(interp,*argv, - EXP_TEMPORARY,inter_updateproc); - continue; - } else if (exp_flageq("output",arg,3)) { - struct output *tmp; - - /* imply a "-input" */ - if (dash_input_count == 0) dash_input_count = 1; - - outp = new(struct output); - - /* link new output in front of others */ - tmp = inp->output; - inp->output = outp; - outp->next = tmp; - - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-output needs argument"); - return(TCL_ERROR); - } - outp->i_list = exp_new_i_complex(interp,*argv, - EXP_TEMPORARY,inter_updateproc); - - outp->action_eof = &action_eof; - action_eof_ptr = &outp->action_eof; - continue; - } else if (exp_flageq1('u',arg)) { /* treat process as user */ - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-u needs argument"); - return(TCL_ERROR); - } - replace_user_by_process = *argv; - - /* imply a "-input" */ - if (dash_input_count == 0) dash_input_count = 1; - - continue; - } else if (exp_flageq1('o',arg)) { - /* apply following patterns to opposite side */ - /* of interaction */ - - end_km = &input_default->keymap; - - /* imply two "-input" */ - if (dash_input_count < 2) { - dash_input_count = 2; - inp = input_default; - action_eof_ptr = &inp->action_eof; - } - continue; - } else if (exp_flageq1('i',arg)) { - /* substitute master */ - - argc--;argv++; -/* master = atoi(*argv);*/ - master_string = *argv; - /* will be used later on */ - - end_km = &input_default->keymap; - - /* imply two "-input" */ - if (dash_input_count < 2) { - dash_input_count = 2; - inp = input_default; - action_eof_ptr = &inp->action_eof; - } - continue; -/* } else if (exp_flageq("nocase",arg,3)) {*/ -/* next_case_sensitive = FALSE;*/ -/* continue;*/ - } else if (exp_flageq("echo",arg,4)) { - next_echo = TRUE; - continue; - } else if (exp_flageq("nobuffer",arg,3)) { - next_writethru = TRUE; - continue; - } else if (exp_flageq("indices",arg,3)) { - next_indices = TRUE; - continue; - } else if (exp_flageq1('f',arg)) { - /* leftover from "fast" days */ - continue; - } else if (exp_flageq("reset",arg,5)) { - next_tty_reset = TRUE; - continue; - } else if (exp_flageq1('F',arg)) { - /* leftover from "fast" days */ - continue; - } else if (exp_flageq("iread",arg,2)) { - next_iread = TRUE; - continue; - } else if (exp_flageq("iwrite",arg,2)) { - next_iwrite = TRUE; - continue; - } else if (exp_flageq("eof",arg,3)) { - struct action *action; - - argc--;argv++; - debuglog("-eof is deprecated, use eof\r\n"); - *action_eof_ptr = action = new_action(&action_base); - action->statement = *argv; - action->tty_reset = next_tty_reset; - next_tty_reset = FALSE; - action->iwrite = next_iwrite; - next_iwrite = FALSE; - action->iread = next_iread; - next_iread = FALSE; - action->timestamp = next_timestamp; - next_timestamp = FALSE; - - continue; - } else if (exp_flageq("timeout",arg,7)) { - int t; - struct action *action; - debuglog("-timeout is deprecated, use timeout\r\n"); - - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-timeout needs time"); - return(TCL_ERROR); - } - - t = atoi(*argv); - argc--;argv++; - if (t != -1) - arbitrary_timeout = t; - /* we need an arbitrary timeout to start */ - /* search for lowest one later */ - -#if 0 - /* if -timeout comes before "-input", then applies */ - /* to all descriptors, else just the current one */ - if (dash_input_count > 0) { - timeout_simple = FALSE; - action = inp->action_timeout = - new_action(&action_base); - inp->timeout_nominal = t; - } else { - action = &action_timeout; - default_timeout = t; - } -#endif - timeout_simple = FALSE; - action = inp->action_timeout = new_action(&action_base); - inp->timeout_nominal = t; - - action->statement = *argv; - action->tty_reset = next_tty_reset; - next_tty_reset = FALSE; - action->iwrite = next_iwrite; - next_iwrite = FALSE; - action->iread = next_iread; - next_iread = FALSE; - action->timestamp = next_timestamp; - next_timestamp = FALSE; - continue; - } else if (exp_flageq("timestamp",arg,2)) { - debuglog("-timestamp is deprecated, use exp_timestamp command\r\n"); - next_timestamp = TRUE; - continue; - } else if (exp_flageq("nobrace",arg,7)) { - /* 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. */ - continue; - } - } - - /* - * pick up the pattern - */ - - km = new(struct keymap); - - /* so that we can match in order user specified */ - /* link to end of keymap list */ - *end_km = km; - km->next = 0; - end_km = &km->next; - - km->echo = next_echo; - km->writethru = next_writethru; - km->indices = next_indices; - km->action.tty_reset = next_tty_reset; - km->action.iwrite = next_iwrite; - km->action.iread = next_iread; - km->action.timestamp = next_timestamp; -/* km->case_sensitive = next_case_sensitive;*/ - - next_indices = next_echo = next_writethru = FALSE; - next_tty_reset = FALSE; - next_iwrite = next_iread = FALSE; -/* next_case_sensitive = TRUE;*/ - - km->keys = *argv; - - km->null = FALSE; - km->re = 0; - if (next_re) { - TclRegError((char *)0); - if (0 == (km->re = TclRegComp(*argv))) { - exp_error(interp,"bad regular expression: %s", - TclGetRegError()); - return(TCL_ERROR); - } - next_re = FALSE; - } if (next_null) { - km->null = TRUE; - next_null = FALSE; - } - - argc--;argv++; - - km->action.statement = *argv; - debuglog("defining key %s, action %s\r\n", - km->keys, - km->action.statement?(dprintify(km->action.statement)) - :interpreter_cmd); - - /* imply a "-input" */ - if (dash_input_count == 0) dash_input_count = 1; - } - - /* if the user has not supplied either "-output" for the */ - /* default two "-input"s, fix them up here */ - - if (!input_user->output) { - struct output *o = new(struct output); - if (master_string == 0) { - if (0 == exp_update_master(interp,&master,1,1)) { - return(TCL_ERROR); - } - o->i_list = exp_new_i_simple(master,EXP_TEMPORARY); - } else { - o->i_list = exp_new_i_complex(interp,master_string, - EXP_TEMPORARY,inter_updateproc); - } -#if 0 - if (master == EXP_SPAWN_ID_BAD) { - if (0 == exp_update_master(interp,&master,1,1)) { - return(TCL_ERROR); - } - } - o->i_list = exp_new_i_simple(master,EXP_TEMPORARY); -#endif - o->next = 0; /* no one else */ - o->action_eof = &action_eof; - input_user->output = o; - } - - if (!input_default->output) { - struct output *o = new(struct output); - o->i_list = exp_new_i_simple(1,EXP_TEMPORARY);/* stdout by default */ - o->next = 0; /* no one else */ - o->action_eof = &action_eof; - input_default->output = o; - } - - /* if user has given "-u" flag, substitute process for user */ - /* in first two -inputs */ - if (replace_user_by_process) { - /* through away old ones */ - exp_free_i(interp,input_user->i_list, inter_updateproc); - exp_free_i(interp,input_default->output->i_list,inter_updateproc); - - /* replace with arg to -u */ - input_user->i_list = exp_new_i_complex(interp, - replace_user_by_process, - EXP_TEMPORARY,inter_updateproc); - input_default->output->i_list = exp_new_i_complex(interp, - replace_user_by_process, - EXP_TEMPORARY,inter_updateproc); - } - - /* - * now fix up for default spawn id - */ - - /* user could have replaced it with an indirect, so force update */ - if (input_default->i_list->direct == EXP_INDIRECT) { - exp_i_update(interp,input_default->i_list); - } - - if (input_default->i_list->fd_list - && (input_default->i_list->fd_list->fd == EXP_SPAWN_ID_BAD)) { - if (master_string == 0) { - if (0 == exp_update_master(interp,&master,1,1)) { - return(TCL_ERROR); - } - input_default->i_list->fd_list->fd = master; - } else { - /* discard old one and install new one */ - exp_free_i(interp,input_default->i_list,inter_updateproc); - input_default->i_list = exp_new_i_complex(interp,master_string, - EXP_TEMPORARY,inter_updateproc); - } -#if 0 - if (master == EXP_SPAWN_ID_BAD) { - if (0 == exp_update_master(interp,&master,1,1)) { - return(TCL_ERROR); - } - } - input_default->i_list->fd_list->fd = master; -#endif - } - - /* - * check for user attempting to interact with self - * they're almost certainly just fooling around - */ - - /* user could have replaced it with an indirect, so force update */ - if (input_user->i_list->direct == EXP_INDIRECT) { - exp_i_update(interp,input_user->i_list); - } - - if (input_user->i_list->fd_list && input_default->i_list->fd_list - && (input_user->i_list->fd_list->fd == input_default->i_list->fd_list->fd)) { - exp_error(interp,"cannot interact with self - set spawn_id to a spawned process"); - return(TCL_ERROR); - } - - fd_list = 0; - fd_to_input = 0; - - /***************************************************************/ - /* all data structures are sufficiently set up that we can now */ - /* "finish()" to terminate this procedure */ - /***************************************************************/ - - status = update_interact_fds(interp,&input_count,&fd_to_input,&fd_list,input_base,1,&configure_count,&real_tty); - if (status == TCL_ERROR) finish(TCL_ERROR); - - if (real_tty) { - tty_changed = exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); - } - - for (inp = input_base,i=0;inp;inp=inp->next,i++) { - /* start timers */ - inp->timeout_remaining = inp->timeout_nominal; - } - - key = expect_key++; - - /* declare ourselves "in sync" with external view of close/indirect */ - configure_count = exp_configure_count; - -#ifndef SIMPLE_EVENT - /* loop waiting (in event handler) for input */ - for (;;) { - int te; /* result of Tcl_Eval */ - struct exp_f *u; - int rc; /* return code from ready. This is further */ - /* refined by matcher. */ - int cc; /* chars count from read() */ - int m; /* master */ - int m_out; /* where master echoes to */ - struct action *action = 0; - time_t previous_time; - time_t current_time; - int match_length, skip; - int change; /* if action requires cooked mode */ - int attempt_match = TRUE; - struct input *soonest_input; - int print; /* # of chars to print */ - int oldprinted; /* old version of u->printed */ - - int timeout; /* current as opposed to default_timeout */ - - /* calculate how long to wait */ - /* by finding shortest remaining timeout */ - if (timeout_simple) { - timeout = default_timeout; - } else { - timeout = arbitrary_timeout; - - for (inp=input_base;inp;inp=inp->next) { - if ((inp->timeout_remaining != EXP_TIME_INFINITY) && - (inp->timeout_remaining <= timeout)) { - soonest_input = inp; - timeout = inp->timeout_remaining; - } - } - - time(&previous_time); - /* timestamp here rather than simply saving old */ - /* current time (after ready()) to account for */ - /* possibility of slow actions */ - - /* timeout can actually be EXP_TIME_INFINITY here if user */ - /* explicitly supplied it in a few cases (or */ - /* the count-down code is broken) */ - } - - /* update the world, if necessary */ - if (configure_count != exp_configure_count) { - status = update_interact_fds(interp,&input_count, - &fd_to_input,&fd_list,input_base,1, - &configure_count,&real_tty); - if (status) finish(status); - } - - rc = exp_get_next_event(interp,fd_list,input_count,&m,timeout,key); - if (rc == EXP_TCLERROR) return(TCL_ERROR); - - if (rc == EXP_RECONFIGURE) continue; - - if (rc == EXP_TIMEOUT) { - if (timeout_simple) { - action = &action_timeout; - goto got_action; - } else { - action = soonest_input->action_timeout; - /* arbitrarily pick first fd out of list */ - m = soonest_input->i_list->fd_list->fd; - } - } - if (!timeout_simple) { - int time_diff; - - time(¤t_time); - time_diff = current_time - previous_time; - - /* update all timers */ - for (inp=input_base;inp;inp=inp->next) { - if (inp->timeout_remaining != EXP_TIME_INFINITY) { - inp->timeout_remaining -= time_diff; - if (inp->timeout_remaining < 0) - inp->timeout_remaining = 0; - } - } - } - - /* at this point, we have some kind of event which can be */ - /* immediately processed - i.e. something that doesn't block */ - - /* figure out who we are */ - inp = fd_to_input[m]; -/* u = inp->f;*/ - u = exp_fs+m; - - /* reset timer */ - inp->timeout_remaining = inp->timeout_nominal; - - switch (rc) { - case EXP_DATA_NEW: - if (u->size == u->msize) { - /* In theory, interact could be invoked when this situation */ - /* already exists, hence the "probably" in the warning below */ - - debuglog("WARNING: interact buffer is full, probably because your\r\n"); - debuglog("patterns have matched all of it but require more chars\r\n"); - debuglog("in order to complete the match.\r\n"); - debuglog("Dumping first half of buffer in order to continue\r\n"); - debuglog("Recommend you enlarge the buffer or fix your patterns.\r\n"); - exp_buffer_shuffle(interp,u,0,INTER_OUT,"interact"); - } - cc = read(m, u->buffer + u->size, - u->msize - u->size); - if (cc > 0) { - u->key = key; - u->size += cc; - u->buffer[u->size] = '\0'; - - /* strip parity if requested */ - if (u->parity == 0) { - /* do it from end backwards */ - char *p = u->buffer + u->size - 1; - int count = cc; - while (count--) { - *p-- &= 0x7f; - } - } - - /* avoid another function call if possible */ - if (debugfile || is_debugging) { - debuglog("spawn id %d sent <%s>\r\n",m, - exp_printify(u->buffer + u->size - cc)); - } - break; - } - - rc = EXP_EOF; - /* Most systems have read() return 0, allowing */ - /* control to fall thru and into this code. On some */ - /* systems (currently HP and new SGI), read() does */ - /* see eof, and it must be detected earlier. Then */ - /* control jumps directly to this EXP_EOF label. */ - - /*FALLTHRU*/ - case EXP_EOF: - action = inp->action_eof; - attempt_match = FALSE; - skip = u->size; - debuglog("interact: received eof from spawn_id %d\r\n",m); - /* actual close is done later so that we have a */ - /* chance to flush out any remaining characters */ - need_to_close_master = TRUE; - -#if EOF_SO - /* should really check for remaining chars and */ - /* flush them but this will only happen in the */ - /* unlikely scenario that there are partially */ - /* matched buffered chars. */ - /* So for now, indicate no chars to skip. */ - skip = 0; - exp_close(interp,m); -#endif - break; - case EXP_DATA_OLD: - cc = 0; - break; - case EXP_TIMEOUT: - action = inp->action_timeout; - attempt_match = FALSE; - skip = u->size; - break; - } - - km = 0; - - if (attempt_match) { - rc = in_keymap(u->buffer,u->size,inp->keymap, - &km,&match_length,&skip,u->rm_nulls); - } else { - attempt_match = TRUE; - } - - /* put regexp result in variables */ - if (km && km->re) { -#define out(var,val) debuglog("expect: set %s(%s) \"%s\"\r\n",INTER_OUT,var, \ - dprintify(val)); \ - Tcl_SetVar2(interp,INTER_OUT,var,val,0); - - char name[20], value[20]; - regexp *re = km->re; - char match_char;/* place to hold char temporarily */ - /* uprooted by a NULL */ - - for (i=0;istartp[i] == 0) continue; - - if (km->indices) { - /* start index */ - sprintf(name,"%d,start",i); - offset = re->startp[i]-u->buffer; - sprintf(value,"%d",offset); - out(name,value); - - /* end index */ - sprintf(name,"%d,end",i); - sprintf(value,"%d",re->endp[i]-u->buffer-1); - out(name,value); - } - - /* string itself */ - sprintf(name,"%d,string",i); - /* temporarily null-terminate in */ - /* middle */ - match_char = *re->endp[i]; - *re->endp[i] = 0; - out(name,re->startp[i]); - *re->endp[i] = match_char; - } - } - - /* - * dispose of chars that should be skipped - * i.e., chars that cannot possibly be part of a match. - */ - - /* "skip" is count of chars not involved in match */ - /* "print" is count with chars involved in match */ - - if (km && km->writethru) { - print = skip + match_length; - } else print = skip; - - /* - * echo chars if appropriate - */ - if (km && km->echo) { - int seen; /* either printed or echoed */ - - /* echo to stdout rather than stdin */ - m_out = (m == 0)?1:m; - - /* write is unlikely to fail, since we just read */ - /* from same descriptor */ - seen = u->printed + u->echoed; - if (skip >= seen) { - write(m_out,u->buffer+skip,match_length); - } else if ((match_length + skip - seen) > 0) { - write(m_out,u->buffer+seen,match_length+skip-seen); - } - u->echoed = match_length + skip - u->printed; - } - - oldprinted = u->printed; - - /* If expect has left characters in buffer, it has */ - /* already echoed them to the screen, thus we must */ - /* prevent them being rewritten. Unfortunately this */ - /* gives the possibility of matching chars that have */ - /* already been output, but we do so since the user */ - /* could have avoided it by flushing the output */ - /* buffers directly. */ - if (print > u->printed) { /* usual case */ - int wc; /* return code from write() */ - for (outp = inp->output;outp;outp=outp->next) { - struct exp_fd_list *fdp; - for (fdp = outp->i_list->fd_list;fdp;fdp=fdp->next) { - int od; /* output descriptor */ - - /* send to logfile if open */ - /* and user is seeing it */ - if (logfile && real_tty_output(fdp->fd)) { - fwrite(u->buffer+u->printed,1, - print - u->printed,logfile); - } - - /* send to each output descriptor */ - od = fdp->fd; - /* if opened by Tcl, it may use a different */ - /* output descriptor */ - od = (exp_fs[od].tcl_handle?exp_fs[od].tcl_output:od); - - wc = write(od,u->buffer+u->printed, - print - u->printed); - if (wc <= 0) { - debuglog("interact: write on spawn id %d failed (%s)\r\n",fdp->fd,Tcl_PosixError(interp)); - action = outp->action_eof; - change = (action && action->tty_reset); - - if (change && tty_changed) - exp_tty_set(interp,&tty_old,was_raw,was_echo); - te = inter_eval(interp,action,m); - - if (change && real_tty) tty_changed = - exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); - switch (te) { - case TCL_BREAK: - case TCL_CONTINUE: - finish(te); - case EXP_TCL_RETURN: - finish(TCL_RETURN); - case TCL_RETURN: - finish(TCL_OK); - case TCL_OK: - /* god knows what the user might */ - /* have done to us in the way of */ - /* closed fds, so .... */ - action = 0; /* reset action */ - continue; - default: - finish(te); - } - } - } - } - u->printed = print; - } - - /* u->printed is now accurate with respect to the buffer */ - /* However, we're about to shift the old data out of the */ - /* buffer. Thus, u->size, printed, and echoed must be */ - /* updated */ - - /* first update size based on skip information */ - /* then set skip to the total amount skipped */ - - if (rc == EXP_MATCH) { - action = &km->action; - - skip += match_length; - u->size -= skip; - - if (u->size) { - memcpy(u->buffer, u->buffer + skip, u->size); - exp_lowmemcpy(u->lower,u->buffer+ skip, u->size); - } - } else { - if (skip) { - u->size -= skip; - memcpy(u->buffer, u->buffer + skip, u->size); - exp_lowmemcpy(u->lower,u->buffer+ skip, u->size); - } - } - -#if EOF_SO - /* as long as buffer is still around, null terminate it */ - if (rc != EXP_EOF) { - u->buffer[u->size] = '\0'; - u->lower [u->size] = '\0'; - } -#else - u->buffer[u->size] = '\0'; - u->lower [u->size] = '\0'; -#endif - - /* now update printed based on total amount skipped */ - - u->printed -= skip; - /* if more skipped than printed (i.e., keymap encountered) */ - /* for printed positive */ - if (u->printed < 0) u->printed = 0; - - /* if we are in the middle of a match, force the next event */ - /* to wait for more data to arrive */ - u->force_read = (rc == EXP_CANMATCH); - - /* finally reset echoed if necessary */ - if (rc != EXP_CANMATCH) { - if (skip >= oldprinted + u->echoed) u->echoed = 0; - } - - if (rc == EXP_EOF) { - exp_close(interp,m); - need_to_close_master = FALSE; - } - - if (action) { -got_action: - change = (action && action->tty_reset); - if (change && tty_changed) - exp_tty_set(interp,&tty_old,was_raw,was_echo); - - te = inter_eval(interp,action,m); - - if (change && real_tty) tty_changed = - exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); - switch (te) { - case TCL_BREAK: - case TCL_CONTINUE: - finish(te); - case EXP_TCL_RETURN: - finish(TCL_RETURN); - case TCL_RETURN: - finish(TCL_OK); - case TCL_OK: - /* god knows what the user might */ - /* have done to us in the way of */ - /* closed fds, so .... */ - action = 0; /* reset action */ - continue; - default: - finish(te); - } - } - } +Exp_InteractObjCmd(clientData, interp, objc, objv) +ClientData clientData; +Tcl_Interp *interp; +int objc; +Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_Obj *CONST *objv_copy; /* original, for error messages */ + char *string; +#ifdef SIMPLE_EVENT + int pid; +#endif /*SIMPLE_EVENT*/ + + /*declarations*/ + int input_count; /* count of struct input descriptors */ + + Tcl_HashTable *esPtrToInput = 0; /* map from ExpState to "struct inputs" */ + ExpState **esPtrs; + struct keymap *km; /* ptr for above while parsing */ + Tcl_RegExpInfo reInfo; + ExpState *u = 0; + ExpState *esPtr = 0; + Tcl_Obj *chanName = 0; + int need_to_close_master = FALSE; /* if an eof is received */ + /* we use this to defer close until later */ + + int next_tty_reset = FALSE; /* if we've seen a single -reset */ + int next_iread = FALSE;/* if we've seen a single -iread */ + int next_iwrite = FALSE;/* if we've seen a single -iread */ + int next_re = FALSE; /* if we've seen a single -re */ + int next_null = FALSE; /* if we've seen the null keyword */ + int next_writethru = FALSE;/*if macros should also go to proc output */ + int next_indices = FALSE;/* if we should write indices */ + int next_echo = FALSE; /* if macros should be echoed */ + int status = TCL_OK; /* final return value */ + int i; /* misc temp */ + int size; /* size temp */ + + int timeout_simple = TRUE; /* if no or global timeout */ + + int real_tty; /* TRUE if we are interacting with real tty */ + int tty_changed = FALSE;/* true if we had to change tty modes for */ + /* interact to work (i.e., to raw, noecho) */ + int was_raw; + int was_echo; + exp_tty tty_old; + + Tcl_Obj *replace_user_by_process = 0; /* for -u flag */ + + struct input *input_base; +#define input_user input_base + struct input *input_default; + struct input *inp; /* overused ptr to struct input */ + struct output *outp; /* overused ptr to struct output */ + + int dash_input_count = 0; /* # of "-input"s seen */ + int arbitrary_timeout; + int default_timeout; + struct action action_timeout; /* common to all */ + struct action action_eof; /* common to all */ + struct action **action_eof_ptr; /* allow -input/ouput to */ + /* leave their eof-action assignable by a later */ + /* -eof */ + struct action *action_base = 0; + struct keymap **end_km; + + int key; + int configure_count; /* monitor reconfigure events */ + + if ((objc == 2) && exp_one_arg_braced(objv[1])) { + return(exp_eval_with_one_arg(clientData,interp,objv)); + } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { + Tcl_Obj *new_objv[2]; + new_objv[0] = objv[0]; + new_objv[1] = objv[2]; + return(exp_eval_with_one_arg(clientData,interp,new_objv)); + } + + objv_copy = objv; + + objv++; + objc--; + + default_timeout = EXP_TIME_INFINITY; + arbitrary_timeout = EXP_TIME_INFINITY; /* if user specifies */ + /* a bunch of timeouts with EXP_TIME_INFINITY, this will be */ + /* left around for us to find. */ + + input_user = new(struct input); + input_user->i_list = exp_new_i_simple(expStdinoutGet(),EXP_TEMPORARY); /* stdin by default */ + input_user->output = 0; + input_user->action_eof = &action_eof; + input_user->timeout_nominal = EXP_TIME_INFINITY; + input_user->action_timeout = 0; + input_user->keymap = 0; + + end_km = &input_user->keymap; + inp = input_user; + action_eof_ptr = &input_user->action_eof; + + input_default = new(struct input); + input_default->i_list = exp_new_i_simple((ExpState *)0,EXP_TEMPORARY); /* fix up later */ + input_default->output = 0; + input_default->action_eof = &action_eof; + input_default->timeout_nominal = EXP_TIME_INFINITY; + input_default->action_timeout = 0; + input_default->keymap = 0; + input_default->next = 0; /* no one else */ + input_user->next = input_default; + + /* default and common -eof action */ + action_eof.statement = tsdPtr->cmdObjReturn; + action_eof.tty_reset = FALSE; + action_eof.iread = FALSE; + action_eof.iwrite = FALSE; + + /* + * Parse the command arguments. + */ + for (;objc>0;objc--,objv++) { + string = Tcl_GetString(*objv); + if (string[0] == '-') { + static char *switches[] = { + "--", "-exact", "-re", "-input", + "-output", "-u", "-o", "-i", + "-echo", "-nobuffer", "-indices", "-f", + "-reset", "-F", "-iread", "-iwrite", + "-eof", "-timeout", "-nobrace", (char *)0 + }; + enum switches { + EXP_SWITCH_DASH, EXP_SWITCH_EXACT, + EXP_SWITCH_REGEXP, EXP_SWITCH_INPUT, + EXP_SWITCH_OUTPUT, EXP_SWITCH_USER, + EXP_SWITCH_OPPOSITE, EXP_SWITCH_SPAWN_ID, + EXP_SWITCH_ECHO, EXP_SWITCH_NOBUFFER, + EXP_SWITCH_INDICES, EXP_SWITCH_FAST, + EXP_SWITCH_RESET, EXP_SWITCH_CAPFAST, + EXP_SWITCH_IREAD, EXP_SWITCH_IWRITE, + EXP_SWITCH_EOF, EXP_SWITCH_TIMEOUT, + EXP_SWITCH_NOBRACE + }; + int index; + + /* + * Allow abbreviations of switches and report an error if we + * get an invalid switch. + */ + + if (Tcl_GetIndexFromObj(interp, *objv, switches, "switch", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum switches) index) { + case EXP_SWITCH_DASH: + case EXP_SWITCH_EXACT: + objc--; + objv++; + goto pattern; + case EXP_SWITCH_REGEXP: + if (objc < 1) { + Tcl_WrongNumArgs(interp,1,objv_copy,"-re pattern"); + return(TCL_ERROR); + } + next_re = TRUE; + objc--; + objv++; + + /* + * 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, + TCL_REG_ADVANCED|TCL_REG_BOSONLY))) { + return TCL_ERROR; + } + goto pattern; + case EXP_SWITCH_INPUT: + dash_input_count++; + if (dash_input_count == 2) { + inp = input_default; + input_user->next = input_default; + } else if (dash_input_count > 2) { + struct input *previous_input = inp; + inp = new(struct input); + previous_input->next = inp; + } + inp->output = 0; + inp->action_eof = &action_eof; + action_eof_ptr = &inp->action_eof; + inp->timeout_nominal = default_timeout; + inp->action_timeout = &action_timeout; + inp->keymap = 0; + end_km = &inp->keymap; + inp->next = 0; + objc--;objv++; + if (objc < 1) { + Tcl_WrongNumArgs(interp,1,objv_copy,"-input spawn_id"); + return(TCL_ERROR); + } + inp->i_list = exp_new_i_complex(interp,Tcl_GetString(*objv), + EXP_TEMPORARY,inter_updateproc); + if (!inp->i_list) return TCL_ERROR; + break; + case EXP_SWITCH_OUTPUT: { + struct output *tmp; + + /* imply a "-input" */ + if (dash_input_count == 0) dash_input_count = 1; + + outp = new(struct output); + + /* link new output in front of others */ + tmp = inp->output; + inp->output = outp; + outp->next = tmp; + + objc--;objv++; + if (objc < 1) { + Tcl_WrongNumArgs(interp,1,objv_copy,"-output spawn_id"); + return(TCL_ERROR); + } + outp->i_list = exp_new_i_complex(interp,Tcl_GetString(*objv), + EXP_TEMPORARY,inter_updateproc); + if (!outp->i_list) return TCL_ERROR; + outp->action_eof = &action_eof; + action_eof_ptr = &outp->action_eof; + break; + } + case EXP_SWITCH_USER: + objc--;objv++; + if (objc < 1) { + Tcl_WrongNumArgs(interp,1,objv_copy,"-u spawn_id"); + return(TCL_ERROR); + } + replace_user_by_process = *objv; + + /* imply a "-input" */ + if (dash_input_count == 0) dash_input_count = 1; + break; + case EXP_SWITCH_OPPOSITE: + /* apply following patterns to opposite side */ + /* of interaction */ + + end_km = &input_default->keymap; + + /* imply two "-input" */ + if (dash_input_count < 2) { + dash_input_count = 2; + inp = input_default; + action_eof_ptr = &inp->action_eof; + } + break; + case EXP_SWITCH_SPAWN_ID: + /* substitute master */ + + objc--;objv++; + chanName = *objv; + /* will be used later on */ + + end_km = &input_default->keymap; + + /* imply two "-input" */ + if (dash_input_count < 2) { + dash_input_count = 2; + inp = input_default; + action_eof_ptr = &inp->action_eof; + } + break; + case EXP_SWITCH_ECHO: + next_echo = TRUE; + break; + case EXP_SWITCH_NOBUFFER: + next_writethru = TRUE; + break; + case EXP_SWITCH_INDICES: + next_indices = TRUE; + break; + case EXP_SWITCH_RESET: + next_tty_reset = TRUE; + break; + case EXP_SWITCH_IREAD: + next_iread = TRUE; + break; + case EXP_SWITCH_IWRITE: + next_iwrite= TRUE; + break; + case EXP_SWITCH_EOF: { + struct action *action; + + objc--;objv++; + expDiagLogU("-eof is deprecated, use eof\r\n"); + *action_eof_ptr = action = new_action(&action_base); + action->statement = *objv; + action->tty_reset = next_tty_reset; + next_tty_reset = FALSE; + action->iwrite = next_iwrite; + next_iwrite = FALSE; + action->iread = next_iread; + next_iread = FALSE; + break; + } + case EXP_SWITCH_TIMEOUT: { + int t; + struct action *action; + expDiagLogU("-timeout is deprecated, use timeout\r\n"); + + objc--;objv++; + if (objc < 1) { + Tcl_WrongNumArgs(interp,1,objv_copy,"-timeout time"); + return(TCL_ERROR); + } + + if (Tcl_GetIntFromObj(interp, *objv, &t) != TCL_OK) { + return TCL_ERROR; + } + objc--;objv++; + if (t != -1) + arbitrary_timeout = t; + /* we need an arbitrary timeout to start */ + /* search for lowest one later */ + + timeout_simple = FALSE; + action = inp->action_timeout = new_action(&action_base); + inp->timeout_nominal = t; + + action->statement = *objv; + action->tty_reset = next_tty_reset; + next_tty_reset = FALSE; + action->iwrite = next_iwrite; + next_iwrite = FALSE; + action->iread = next_iread; + next_iread = FALSE; + break; + } + case EXP_SWITCH_FAST: + case EXP_SWITCH_CAPFAST: + /* noop compatibility switches for fast mode */ + break; + case EXP_SWITCH_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; + } + continue; + } else { + static char *options[] = { + "eof", "timeout", "null", (char *)0 + }; + enum options { + EXP_OPTION_EOF, EXP_OPTION_TIMEOUT, EXP_OPTION_NULL + }; + int index; + + /* + * Match keywords exactly, otherwise they are patterns. + */ + + if (Tcl_GetIndexFromObj(interp, *objv, options, "option", + 1 /* exact */, &index) != TCL_OK) { + Tcl_ResetResult(interp); + goto pattern; + } + switch ((enum options) index) { + case EXP_OPTION_EOF: { + struct action *action; + + objc--;objv++; + *action_eof_ptr = action = new_action(&action_base); + + action->statement = *objv; + + action->tty_reset = next_tty_reset; + next_tty_reset = FALSE; + action->iwrite = next_iwrite; + next_iwrite = FALSE; + action->iread = next_iread; + next_iread = FALSE; + break; + } + case EXP_OPTION_TIMEOUT: { + int t; + struct action *action; + + objc--;objv++; + if (objc < 1) { + Tcl_WrongNumArgs(interp,1,objv_copy,"timeout time"); + return(TCL_ERROR); + } + if (Tcl_GetIntFromObj(interp, *objv, &t) != TCL_OK) { + return TCL_ERROR; + } + objc--;objv++; + + /* we need an arbitrary timeout to start */ + /* search for lowest one later */ + if (t != -1) arbitrary_timeout = t; + + timeout_simple = FALSE; + action = inp->action_timeout = new_action(&action_base); + inp->timeout_nominal = t; + + action->statement = *objv; + + action->tty_reset = next_tty_reset; + next_tty_reset = FALSE; + action->iwrite = next_iwrite; + next_iwrite = FALSE; + action->iread = next_iread; + next_iread = FALSE; + break; + } + case EXP_OPTION_NULL: + next_null = TRUE; + goto pattern; + } + continue; + } + + /* + * pick up the pattern + */ + + pattern: + km = new(struct keymap); + + /* so that we can match in order user specified */ + /* link to end of keymap list */ + *end_km = km; + km->next = 0; + end_km = &km->next; + + km->echo = next_echo; + km->writethru = next_writethru; + km->indices = next_indices; + km->action.tty_reset = next_tty_reset; + km->action.iwrite = next_iwrite; + km->action.iread = next_iread; + + next_indices = next_echo = next_writethru = FALSE; + next_tty_reset = FALSE; + next_iwrite = next_iread = FALSE; + + km->keys = *objv; + + km->null = FALSE; + km->re = 0; + if (next_re) { + km->re = TRUE; + next_re = FALSE; + } + if (next_null) { + km->null = TRUE; + next_null = FALSE; + } + + objc--;objv++; + if (objc >= 1) { + km->action.statement = *objv; + } else { + km->action.statement = 0; + } + + expDiagLogU("defining key "); + expDiagLogU(Tcl_GetString(km->keys)); + expDiagLogU(", action "); + expDiagLogU(km->action.statement?expPrintify(Tcl_GetString(km->action.statement)):"interpreter"); + expDiagLogU("\r\n"); + + /* imply a "-input" */ + if (dash_input_count == 0) dash_input_count = 1; + } + + /* if the user has not supplied either "-output" for the */ + /* default two "-input"s, fix them up here */ + + if (!input_user->output) { + struct output *o = new(struct output); + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,1,1,0))) { + return(TCL_ERROR); + } + o->i_list = exp_new_i_simple(esPtr,EXP_TEMPORARY); + } else { + o->i_list = exp_new_i_complex(interp,Tcl_GetString(chanName), + EXP_TEMPORARY,inter_updateproc); + if (!o->i_list) return TCL_ERROR; + } + o->next = 0; /* no one else */ + o->action_eof = &action_eof; + input_user->output = o; + } + + if (!input_default->output) { + struct output *o = new(struct output); + o->i_list = exp_new_i_simple(expStdinoutGet(),EXP_TEMPORARY);/* stdout by default */ + o->next = 0; /* no one else */ + o->action_eof = &action_eof; + input_default->output = o; + } + + /* if user has given "-u" flag, substitute process for user */ + /* in first two -inputs */ + if (replace_user_by_process) { + /* through away old ones */ + exp_free_i(interp,input_user->i_list, inter_updateproc); + exp_free_i(interp,input_default->output->i_list,inter_updateproc); + + /* replace with arg to -u */ + input_user->i_list = exp_new_i_complex(interp, + Tcl_GetString(replace_user_by_process), + EXP_TEMPORARY,inter_updateproc); + if (!input_user->i_list) return TCL_ERROR; + input_default->output->i_list = exp_new_i_complex(interp, + Tcl_GetString(replace_user_by_process), + EXP_TEMPORARY,inter_updateproc); + if (!input_default->output->i_list) return TCL_ERROR; + } + + /* + * now fix up for default spawn id + */ + + /* user could have replaced it with an indirect, so force update */ + if (input_default->i_list->direct == EXP_INDIRECT) { + exp_i_update(interp,input_default->i_list); + } + + if (input_default->i_list->state_list + && (input_default->i_list->state_list->esPtr == EXP_SPAWN_ID_BAD)) { + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,1,1,0))) { + return(TCL_ERROR); + } + input_default->i_list->state_list->esPtr = esPtr; + } else { + /* discard old one and install new one */ + exp_free_i(interp,input_default->i_list,inter_updateproc); + input_default->i_list = exp_new_i_complex(interp,Tcl_GetString(chanName), + EXP_TEMPORARY,inter_updateproc); + if (!input_default->i_list) return TCL_ERROR; + } + } + + /* + * check for user attempting to interact with self + * they're almost certainly just fooling around + */ + + /* user could have replaced it with an indirect, so force update */ + if (input_user->i_list->direct == EXP_INDIRECT) { + exp_i_update(interp,input_user->i_list); + } + + if (input_user->i_list->state_list && input_default->i_list->state_list + && (input_user->i_list->state_list->esPtr == input_default->i_list->state_list->esPtr)) { + exp_error(interp,"cannot interact with self - set spawn_id to a spawned process"); + return(TCL_ERROR); + } + + esPtrs = 0; + + /* + * all data structures are sufficiently set up that we can now + * "finish()" to terminate this procedure + */ + + status = update_interact_fds(interp,&input_count,&esPtrToInput,&esPtrs,input_base,1,&configure_count,&real_tty); + if (status == TCL_ERROR) finish(TCL_ERROR); + + if (real_tty) { + tty_changed = exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); + } + + for (inp = input_base,i=0;inp;inp=inp->next,i++) { + /* start timers */ + inp->timeout_remaining = inp->timeout_nominal; + } + + key = expect_key++; + + /* declare ourselves "in sync" with external view of close/indirect */ + configure_count = exp_configure_count; + +#ifndef SIMPLE_EVENT + /* loop waiting (in event handler) for input */ + for (;;) { + int te; /* result of Tcl_Eval */ + int rc; /* return code from ready. This is further refined by matcher. */ + int cc; /* # of chars from read() */ + struct action *action = 0; + time_t previous_time; + time_t current_time; + int matchLen; /* # of chars matched */ + int skip; /* # of chars not involved in match */ + int print; /* # of chars to print */ + int oldprinted; /* old version of u->printed */ + int change; /* if action requires cooked mode */ + int attempt_match = TRUE; + struct input *soonest_input; + int timeout; /* current as opposed to default_timeout */ + + /* calculate how long to wait */ + /* by finding shortest remaining timeout */ + if (timeout_simple) { + timeout = default_timeout; + } else { + timeout = arbitrary_timeout; + + for (inp=input_base;inp;inp=inp->next) { + if ((inp->timeout_remaining != EXP_TIME_INFINITY) && + (inp->timeout_remaining <= timeout)) { + soonest_input = inp; + timeout = inp->timeout_remaining; + } + } + + time(&previous_time); + /* timestamp here rather than simply saving old */ + /* current time (after ready()) to account for */ + /* possibility of slow actions */ + + /* timeout can actually be EXP_TIME_INFINITY here if user */ + /* explicitly supplied it in a few cases (or */ + /* the count-down code is broken) */ + } + + /* update the world, if necessary */ + if (configure_count != exp_configure_count) { + status = update_interact_fds(interp,&input_count, + &esPtrToInput,&esPtrs,input_base,1, + &configure_count,&real_tty); + if (status) finish(status); + } + + rc = exp_get_next_event(interp,esPtrs,input_count,&u,timeout,key); + if (rc == EXP_TCLERROR) return(TCL_ERROR); + if (rc == EXP_RECONFIGURE) continue; + if (rc == EXP_TIMEOUT) { + if (timeout_simple) { + action = &action_timeout; + goto got_action; + } else { + action = soonest_input->action_timeout; + /* arbitrarily pick first fd out of list */ + u = soonest_input->i_list->state_list->esPtr; + } + } + if (!timeout_simple) { + int time_diff; + + time(¤t_time); + time_diff = current_time - previous_time; + + /* update all timers */ + for (inp=input_base;inp;inp=inp->next) { + if (inp->timeout_remaining != EXP_TIME_INFINITY) { + inp->timeout_remaining -= time_diff; + if (inp->timeout_remaining < 0) + inp->timeout_remaining = 0; + } + } + } + + /* at this point, we have some kind of event which can be */ + /* immediately processed - i.e. something that doesn't block */ + + /* figure out who we are */ + inp = expStateToInput(esPtrToInput,u); + + /* reset timer */ + inp->timeout_remaining = inp->timeout_nominal; + + switch (rc) { + case EXP_DATA_NEW: + cc = intRead(interp,u,1,0,key); + if (cc > 0) break; + + rc = EXP_EOF; + /* + * FALLTHRU + * + * Most systems have read() return 0, allowing + * control to fall thru and into this code. On some + * systems (currently HP and new SGI), read() does + * see eof, and it must be detected earlier. Then + * control jumps directly to this EXP_EOF label. + */ + case EXP_EOF: + action = inp->action_eof; + attempt_match = FALSE; + skip = expSizeGet(u); + expDiagLog("interact: received eof from spawn_id %s\r\n",u->name); + /* actual close is done later so that we have a */ + /* chance to flush out any remaining characters */ + need_to_close_master = TRUE; + break; + case EXP_DATA_OLD: + cc = 0; + break; + case EXP_TIMEOUT: + action = inp->action_timeout; + attempt_match = FALSE; + skip = expSizeGet(u); + break; + } + + km = 0; + + if (attempt_match) { + rc = intMatch(u,inp->keymap,&km,&matchLen,&skip,&reInfo); + if ((rc == EXP_MATCH) && km && km->re) { + intRegExpMatchProcess(interp,u,km,&reInfo,skip); + } + } else { + attempt_match = TRUE; + } + + /* + * dispose of chars that should be skipped + * i.e., chars that cannot possibly be part of a match. + */ + if (km && km->writethru) { + print = skip + matchLen; + } else print = skip; + + if (km && km->echo) { + intEcho(u,skip,matchLen); + } + oldprinted = u->printed; + + /* + * If expect has left characters in buffer, it has + * already echoed them to the screen, thus we must + * prevent them being rewritten. Unfortunately this + * gives the possibility of matching chars that have + * already been output, but we do so since the user + * could have avoided it by flushing the output + * buffers directly. + */ + if (print > u->printed) { /* usual case */ + for (outp = inp->output;outp;outp=outp->next) { + struct exp_state_list *fdp; + for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) { + /* send to channel (and log if chan is stdout or devtty) */ + /* + * Following should eventually be rewritten to ...WriteCharsAnd... + */ + int wc = expWriteBytesAndLogIfTtyU(fdp->esPtr, + Tcl_GetString(u->buffer) + u->printed, + print - u->printed); + if (wc <= 0) { + expDiagLog("interact: write on spawn id %s failed (%s)\r\n",fdp->esPtr->name,Tcl_PosixError(interp)); + action = outp->action_eof; + change = (action && action->tty_reset); + + if (change && tty_changed) + exp_tty_set(interp,&tty_old,was_raw,was_echo); + te = inter_eval(interp,action,u); + + if (change && real_tty) tty_changed = + exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); + switch (te) { + case TCL_BREAK: + case TCL_CONTINUE: + finish(te); + case EXP_TCL_RETURN: + finish(TCL_RETURN); + case TCL_RETURN: + finish(TCL_OK); + case TCL_OK: + /* god knows what the user might */ + /* have done to us in the way of */ + /* closed fds, so .... */ + action = 0; /* reset action */ + continue; + default: + finish(te); + } + } + } + } + u->printed = print; + } + + /* u->printed is now accurate with respect to the buffer */ + /* However, we're about to shift the old data out of the */ + /* buffer. Thus size, printed, and echoed must be */ + /* updated */ + + /* first update size based on skip information */ + /* then set skip to the total amount skipped */ + + size = expSizeGet(u); + if (rc == EXP_MATCH) { + action = &km->action; + + skip += matchLen; + size -= skip; + if (size) { + string = Tcl_GetString(u->buffer); + memmove(string, string + skip, size); + } + } else { + string = Tcl_GetString(u->buffer); + if (skip) { + size -= skip; + memcpy(string, string + skip, size); + } + } + Tcl_SetObjLength(u->buffer,size); + + /* now update printed based on total amount skipped */ + + u->printed -= skip; + /* if more skipped than printed (i.e., keymap encountered) */ + /* for printed positive */ + if (u->printed < 0) u->printed = 0; + + /* if we are in the middle of a match, force the next event */ + /* to wait for more data to arrive */ + u->force_read = (rc == EXP_CANMATCH); + + /* finally reset echoed if necessary */ + if (rc != EXP_CANMATCH) { + if (skip >= oldprinted + u->echoed) u->echoed = 0; + } + + if (rc == EXP_EOF) { + exp_close(interp,u); + need_to_close_master = FALSE; + } + + if (action) { +got_action: + change = (action && action->tty_reset); + if (change && tty_changed) + exp_tty_set(interp,&tty_old,was_raw,was_echo); + + te = inter_eval(interp,action,u); + + if (change && real_tty) tty_changed = + exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); + switch (te) { + case TCL_BREAK: + case TCL_CONTINUE: + finish(te); + case EXP_TCL_RETURN: + finish(TCL_RETURN); + case TCL_RETURN: + finish(TCL_OK); + case TCL_OK: + /* god knows what the user might */ + /* have done to us in the way of */ + /* closed fds, so .... */ + action = 0; /* reset action */ + continue; + default: + finish(te); + } + } + } #else /* SIMPLE_EVENT */ /* deferred_interrupt = FALSE;*/ { int te; /* result of Tcl_Eval */ - struct exp_f *u; + ExpState *u; /*master*/ int rc; /* return code from ready. This is further */ /* refined by matcher. */ int cc; /* chars count from read() */ - int m; /* master */ struct action *action = 0; time_t previous_time; time_t current_time; - int match_length, skip; + int matchLen, skip; int change; /* if action requires cooked mode */ int attempt_match = TRUE; struct input *soonest_input; int print; /* # of chars to print */ int oldprinted; /* old version of u->printed */ @@ -1484,14 +1575,24 @@ if (-1 == (pid = fork())) { exp_error(interp,"fork: %s",Tcl_PosixError(interp)); finish(TCL_ERROR); } - if (pid == 0) { /* child - send process output to user */ - exp_close(interp,0); + if (pid == 0) { + /* + * This is a new child process. + * It exists only for this interact command and will go away when + * the interact returns. + * + * The purpose of this child process is to read output from the + * spawned process and send it to the user tty. + * (See diagram above.) + */ - m = fd_list[1]; /* get 2nd fd */ + exp_close(interp,expStdinoutGet()); + + u = esPtrs[1]; /* get 2nd ExpState */ input_count = 1; while (1) { /* calculate how long to wait */ @@ -1517,11 +1618,11 @@ /* explicitly supplied it in a few cases (or */ /* the count-down code is broken) */ } /* +1 so we can look at the "other" file descriptor */ - rc = exp_get_next_event(interp,fd_list+1,input_count,&m,timeout,key); + rc = exp_get_next_event(interp,esPtrs+1,input_count,&u,timeout,key); if (!timeout_simple) { int time_diff; time(¤t_time); time_diff = current_time - previous_time; @@ -1538,137 +1639,61 @@ /* at this point, we have some kind of event which can be */ /* immediately processed - i.e. something that doesn't block */ /* figure out who we are */ - inp = fd_to_input[m]; -/* u = inp->f;*/ - u = exp_fs+m; + inp = expStateToInput(esPtrToInput,u); switch (rc) { case EXP_DATA_NEW: - cc = read(m, u->buffer + u->size, - u->msize - u->size); - if (cc > 0) { - u->key = key; - u->size += cc; - u->buffer[u->size] = '\0'; - - /* strip parity if requested */ - if (u->parity == 0) { - /* do it from end backwards */ - char *p = u->buffer + u->size - 1; - int count = cc; - while (count--) { - *p-- &= 0x7f; - } - } - - /* avoid another function call if possible */ - if (debugfile || is_debugging) { - debuglog("spawn id %d sent <%s>\r\n",m, - exp_printify(u->buffer + u->size - cc)); - } - break; - } - /*FALLTHRU*/ - - /* Most systems have read() return 0, allowing */ - /* control to fall thru and into this code. On some */ - /* systems (currently HP and new SGI), read() does */ - /* see eof, and it must be detected earlier. Then */ - /* control jumps directly to this EXP_EOF label. */ + cc = intRead(interp,u,0,0,key); + if (cc > 0) break; + /* + * FALLTHRU + * + * Most systems have read() return 0, allowing + * control to fall thru and into this code. On some + * systems (currently HP and new SGI), read() does + * see eof, and it must be detected earlier. Then + * control jumps directly to this EXP_EOF label. + */ case EXP_EOF: action = inp->action_eof; attempt_match = FALSE; - skip = u->size; + skip = expSizeGet(u); rc = EXP_EOF; - debuglog("interact: child received eof from spawn_id %d\r\n",m); - exp_close(interp,m); + expDiagLog("interact: child received eof from spawn_id %s\r\n",u->name); + exp_close(interp,u); break; case EXP_DATA_OLD: cc = 0; break; } km = 0; if (attempt_match) { - rc = in_keymap(u->buffer,u->size,inp->keymap, - &km,&match_length,&skip); + rc = intMatch(u,inp->keymap,&km,&matchLen,&skip,&reInfo); + if ((rc == EXP_MATCH) && km && km->re) { + intRegExpMatchProcess(interp,u,km,&reInfo,skip); + } } else { - attempt_match = TRUE; - } - - /* put regexp result in variables */ - if (km && km->re) { -#define INTER_OUT "interact_out" -#define out(i,val) debuglog("expect: set %s(%s) \"%s\"\r\n",INTER_OUT,i, \ - dprintify(val)); \ - Tcl_SetVar2(interp,INTER_OUT,i,val,0); - - char name[20], value[20]; - regexp *re = km->re; - char match_char;/* place to hold char temporarily */ - /* uprooted by a NULL */ - - for (i=0;istartp[i] == 0) continue; - - if (km->indices) { - /* start index */ - sprintf(name,"%d,start",i); - offset = re->startp[i]-u->buffer; - sprintf(value,"%d",offset); - out(name,value); - - /* end index */ - sprintf(name,"%d,end",i); - sprintf(value,"%d",re->endp[i]-u->buffer-1); - out(name,value); - } - - /* string itself */ - sprintf(name,"%d,string",i); - /* temporarily null-terminate in */ - /* middle */ - match_char = *re->endp[i]; - *re->endp[i] = 0; - out(name,re->startp[i]); - *re->endp[i] = match_char; - } + attempt_match = TRUE; } /* dispose of chars that should be skipped */ /* skip is chars not involved in match */ /* print is with chars involved in match */ if (km && km->writethru) { - print = skip + match_length; + print = skip + matchLen; } else print = skip; - /* figure out if we should echo any chars */ if (km && km->echo) { - int seen; /* either printed or echoed */ - - /* echo to stdout rather than stdin */ - if (m == 0) m = 1; - - /* write is unlikely to fail, since we just read */ - /* from same descriptor */ - seen = u->printed + u->echoed; - if (skip >= seen) { - write(m,u->buffer+skip,match_length); - } else if ((match_length + skip - seen) > 0) { - write(m,u->buffer+seen,match_length+skip-seen); - } - u->echoed = match_length + skip - u->printed; - } - + intEcho(u,skip,matchLen); + } oldprinted = u->printed; /* If expect has left characters in buffer, it has */ /* already echoed them to the screen, thus we must */ /* prevent them being rewritten. Unfortunately this */ @@ -1675,90 +1700,71 @@ /* gives the possibility of matching chars that have */ /* already been output, but we do so since the user */ /* could have avoided it by flushing the output */ /* buffers directly. */ if (print > u->printed) { /* usual case */ - int wc; /* return code from write() */ - for (outp = inp->output;outp;outp=outp->next) { - struct exp_fd_list *fdp; - for (fdp = outp->i_list->fd_list;fdp;fdp=fdp->next) { - int od; /* output descriptor */ - - /* send to logfile if open */ - /* and user is seeing it */ - if (logfile && real_tty_output(fdp->fd)) { - fwrite(u->buffer+u->printed,1, - print - u->printed,logfile); - } - - /* send to each output descriptor */ - od = fdp->fd; - /* if opened by Tcl, it may use a different */ - /* output descriptor */ - od = (exp_fs[od].tcl_handle?exp_fs[od].tcl_output:od); - - wc = write(od,u->buffer+u->printed, - print - u->printed); - if (wc <= 0) { - debuglog("interact: write on spawn id %d failed (%s)\r\n",fdp->fd,Tcl_PosixError(interp)); - action = outp->action_eof; - - te = inter_eval(interp,action,m); - - switch (te) { - case TCL_BREAK: - case TCL_CONTINUE: - finish(te); - case EXP_TCL_RETURN: - finish(TCL_RETURN); - case TCL_RETURN: - finish(TCL_OK); - case TCL_OK: - /* god knows what the user might */ - /* have done to us in the way of */ - /* closed fds, so .... */ - action = 0; /* reset action */ - continue; - default: - finish(te); - } - } - } - } - u->printed = print; + for (outp = inp->output;outp;outp=outp->next) { + struct exp_state_list *fdp; + for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) { + /* send to channel (and log if chan is stdout or devtty) */ + int wc = expWriteBytesAndLogIfTtyU(fdp->esPtr, + Tcl_GetString(u->buffer) + u->printed, + print - u->printed); + if (wc <= 0) { + expDiagLog("interact: write on spawn id %s failed (%s)\r\n",fdp->esPtr->name,Tcl_PosixError(interp)); + action = outp->action_eof; + + te = inter_eval(interp,action,u); + + switch (te) { + case TCL_BREAK: + case TCL_CONTINUE: + finish(te); + case EXP_TCL_RETURN: + finish(TCL_RETURN); + case TCL_RETURN: + finish(TCL_OK); + case TCL_OK: + /* god knows what the user might */ + /* have done to us in the way of */ + /* closed fds, so .... */ + action = 0; /* reset action */ + continue; + default: + finish(te); + } + } + } + } + u->printed = print; } /* u->printed is now accurate with respect to the buffer */ /* However, we're about to shift the old data out of the */ - /* buffer. Thus, u->size, printed, and echoed must be */ + /* buffer. Thus size, printed, and echoed must be */ /* updated */ /* first update size based on skip information */ /* then set skip to the total amount skipped */ - if (rc == EXP_MATCH) { - action = &km->action; - - skip += match_length; - u->size -= skip; - - if (u->size) - memcpy(u->buffer, u->buffer + skip, u->size); - exp_lowmemcpy(u->lower,u->buffer+ skip, u->size); + size = expSizeGet(u); + if (rc =n= EXP_MATCH) { + action = &km->action; + + skip += matchLen; + size -= skip; + if (size) { + memcpy(u->buffer, u->buffer + skip, size); + } } else { - if (skip) { - u->size -= skip; - memcpy(u->buffer, u->buffer + skip, u->size); - exp_lowmemcpy(u->lower,u->buffer+ skip, u->size); - } - } - - /* as long as buffer is still around, null terminate it */ - if (rc != EXP_EOF) { - u->buffer[u->size] = '\0'; - u->lower [u->size] = '\0'; - } + if (skip) { + size -= skip; + memcpy(u->buffer, u->buffer + skip, size); + } + } + Tcl_SetObjLength(size); + /* now update printed based on total amount skipped */ u->printed -= skip; /* if more skipped than printed (i.e., keymap encountered) */ /* for printed positive */ @@ -1772,11 +1778,11 @@ if (rc != EXP_CANMATCH) { if (skip >= oldprinted + u->echoed) u->echoed = 0; } if (action) { - te = inter_eval(interp,action,m); + te = inter_eval(interp,action,u); switch (te) { case TCL_BREAK: case TCL_CONTINUE: finish(te); case EXP_TCL_RETURN: @@ -1792,22 +1798,30 @@ default: finish(te); } } } - } else { /* parent - send user keystrokes to process */ + } else { + /* + * This is the original Expect process. + * + * It now loops, reading keystrokes from the user tty + * and sending them to the spawned process. + * (See diagram above.) + */ + #include #if defined(SIGCLD) && !defined(SIGCHLD) #define SIGCHLD SIGCLD #endif - debuglog("fork = %d\r\n",pid); + expDiagLog("fork = %d\r\n",pid); signal(SIGCHLD,sigchld_handler); /* restart:*/ /* tty_changed = exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);*/ - m = fd_list[0]; /* get 1st fd */ + u = esPtrs[0]; /* get 1st ExpState */ input_count = 1; while (1) { /* calculate how long to wait */ /* by finding shortest remaining timeout */ @@ -1831,11 +1845,11 @@ /* timeout can actually be EXP_TIME_INFINITY here if user */ /* explicitly supplied it in a few cases (or */ /* the count-down code is broken) */ } - rc = exp_get_next_event(interp,fd_list,input_count,&m,timeout,key); + rc = exp_get_next_event(interp,esPtrs,input_count,&u,timeout,key); if (!timeout_simple) { int time_diff; time(¤t_time); time_diff = current_time - previous_time; @@ -1852,142 +1866,73 @@ /* at this point, we have some kind of event which can be */ /* immediately processed - i.e. something that doesn't block */ /* figure out who we are */ - inp = fd_to_input[m]; -/* u = inp->f;*/ - u = exp_fs+m; + inp = expStateToInput(esPtrToInput,u); switch (rc) { case EXP_DATA_NEW: - cc = i_read(m, u->buffer + u->size, - u->msize - u->size); - if (cc > 0) { - u->key = key; - u->size += cc; - u->buffer[u->size] = '\0'; - - /* strip parity if requested */ - if (u->parity == 0) { - /* do it from end backwards */ - char *p = u->buffer + u->size - 1; - int count = cc; - while (count--) { - *p-- &= 0x7f; - } - } - - /* avoid another function call if possible */ - if (debugfile || is_debugging) { - debuglog("spawn id %d sent <%s>\r\n",m, - exp_printify(u->buffer + u->size - cc)); - } + cc = intRead(interp,u,0,1,key); + if (cc > 0) { break; } else if (cc == EXP_CHILD_EOF) { /* user could potentially have two outputs in which */ /* case we might be looking at the wrong one, but */ /* the likelihood of this is nil */ action = inp->output->action_eof; attempt_match = FALSE; - skip = u->size; + skip = expSizeGet(u); rc = EXP_EOF; - debuglog("interact: process died/eof\r\n"); - clean_up_after_child(interp,fd_list[1]); + expDiagLogU("interact: process died/eof\r\n"); + clean_up_after_child(interp,esPtrs[1]); break; } - /*FALLTHRU*/ - - /* Most systems have read() return 0, allowing */ - /* control to fall thru and into this code. On some */ - /* systems (currently HP and new SGI), read() does */ - /* see eof, and it must be detected earlier. Then */ - /* control jumps directly to this EXP_EOF label. */ + /* + * FALLTHRU + * + * Most systems have read() return 0, allowing + * control to fall thru and into this code. On some + * systems (currently HP and new SGI), read() does + * see eof, and it must be detected earlier. Then + * control jumps directly to this EXP_EOF label. + */ case EXP_EOF: action = inp->action_eof; attempt_match = FALSE; - skip = u->size; + skip = expSizeGet(u); rc = EXP_EOF; - debuglog("user sent EOF or disappeared\n\n"); + expDiagLogU("user sent EOF or disappeared\n\n"); break; case EXP_DATA_OLD: cc = 0; break; } km = 0; if (attempt_match) { - rc = in_keymap(u->buffer,u->size,inp->keymap, - &km,&match_length,&skip); + rc = intMatch(u,inp->keymap,&km,&matchLen,&skip,&reInfo); + if ((rc == EXP_MATCH) && km && km->re) { + intRegExpMatchProcess(interp,u,km,&reInfo,skip); + } } else { - attempt_match = TRUE; - } - - /* put regexp result in variables */ - if (km && km->re) { - char name[20], value[20]; - regexp *re = km->re; - char match_char;/* place to hold char temporarily */ - /* uprooted by a NULL */ - - for (i=0;istartp[i] == 0) continue; - - if (km->indices) { - /* start index */ - sprintf(name,"%d,start",i); - offset = re->startp[i]-u->buffer; - sprintf(value,"%d",offset); - out(name,value); - - /* end index */ - sprintf(name,"%d,end",i); - sprintf(value,"%d",re->endp[i]-u->buffer-1); - out(name,value); - } - - /* string itself */ - sprintf(name,"%d,string",i); - /* temporarily null-terminate in */ - /* middle */ - match_char = *re->endp[i]; - *re->endp[i] = 0; - out(name,re->startp[i]); - *re->endp[i] = match_char; - } + attempt_match = TRUE; } /* dispose of chars that should be skipped */ /* skip is chars not involved in match */ /* print is with chars involved in match */ if (km && km->writethru) { - print = skip + match_length; + print = skip + matchLen; } else print = skip; - /* figure out if we should echo any chars */ if (km && km->echo) { - int seen; /* either printed or echoed */ - - /* echo to stdout rather than stdin */ - if (m == 0) m = 1; - - /* write is unlikely to fail, since we just read */ - /* from same descriptor */ - seen = u->printed + u->echoed; - if (skip >= seen) { - write(m,u->buffer+skip,match_length); - } else if ((match_length + skip - seen) > 0) { - write(m,u->buffer+seen,match_length+skip-seen); - } - u->echoed = match_length + skip - u->printed; - } - + intEcho(u,skip,matchLen); + } oldprinted = u->printed; /* If expect has left characters in buffer, it has */ /* already echoed them to the screen, thus we must */ /* prevent them being rewritten. Unfortunately this */ @@ -1994,95 +1939,76 @@ /* gives the possibility of matching chars that have */ /* already been output, but we do so since the user */ /* could have avoided it by flushing the output */ /* buffers directly. */ if (print > u->printed) { /* usual case */ - int wc; /* return code from write() */ - for (outp = inp->output;outp;outp=outp->next) { - struct exp_fd_list *fdp; - for (fdp = outp->i_list->fd_list;fdp;fdp=fdp->next) { - int od; /* output descriptor */ - - /* send to logfile if open */ - /* and user is seeing it */ - if (logfile && real_tty_output(fdp->fd)) { - fwrite(u->buffer+u->printed,1, - print - u->printed,logfile); - } - - /* send to each output descriptor */ - od = fdp->fd; - /* if opened by Tcl, it may use a different */ - /* output descriptor */ - od = (exp_fs[od].tcl_handle?exp_fs[od].tcl_output:od); - - wc = write(od,u->buffer+u->printed, - print - u->printed); - if (wc <= 0) { - debuglog("interact: write on spawn id %d failed (%s)\r\n",fdp->fd,Tcl_PosixError(interp)); - clean_up_after_child(interp,fdp->fd); - action = outp->action_eof; - change = (action && action->tty_reset); - if (change && tty_changed) - exp_tty_set(interp,&tty_old,was_raw,was_echo); - te = inter_eval(interp,action,m); - - if (change && real_tty) tty_changed = - exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); - switch (te) { - case TCL_BREAK: - case TCL_CONTINUE: - finish(te); - case EXP_TCL_RETURN: - finish(TCL_RETURN); - case TCL_RETURN: - finish(TCL_OK); - case TCL_OK: - /* god knows what the user might */ - /* have done to us in the way of */ - /* closed fds, so .... */ - action = 0; /* reset action */ - continue; - default: - finish(te); - } - } - } - } - u->printed = print; + for (outp = inp->output;outp;outp=outp->next) { + struct exp_state_list *fdp; + for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) { + /* send to channel (and log if chan is stdout or devtty) */ + int wc = expWriteBytesAndLogIfTtyU(fdp->esPtr, + Tcl_GetString(u->buffer) + u->printed, + print - u->printed); + if (wc <= 0) { + expDiagLog("interact: write on spawn id %s failed (%s)\r\n",fdp->esPtr->name,Tcl_PosixError(interp)); + clean_up_after_child(interp,fdp->esPtr); + action = outp->action_eof; + change = (action && action->tty_reset); + if (change && tty_changed) + exp_tty_set(interp,&tty_old,was_raw,was_echo); + te = inter_eval(interp,action,u); + + if (change && real_tty) tty_changed = + exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); + switch (te) { + case TCL_BREAK: + case TCL_CONTINUE: + finish(te); + case EXP_TCL_RETURN: + finish(TCL_RETURN); + case TCL_RETURN: + finish(TCL_OK); + case TCL_OK: + /* god knows what the user might */ + /* have done to us in the way of */ + /* closed fds, so .... */ + action = 0; /* reset action */ + continue; + default: + finish(te); + } + } + } + } + u->printed = print; } /* u->printed is now accurate with respect to the buffer */ /* However, we're about to shift the old data out of the */ - /* buffer. Thus, u->size, printed, and echoed must be */ + /* buffer. Thus size, printed, and echoed must be */ /* updated */ /* first update size based on skip information */ /* then set skip to the total amount skipped */ + size = expSizeGet(u); if (rc == EXP_MATCH) { - action = &km->action; - - skip += match_length; - u->size -= skip; - - if (u->size) - memcpy(u->buffer, u->buffer + skip, u->size); - exp_lowmemcpy(u->lower,u->buffer+ skip, u->size); + action = &km->action; + + skip += matchLen; + size -= skip; + if (size) { + memcpy(u->buffer, u->buffer + skip, size); + } } else { - if (skip) { - u->size -= skip; - memcpy(u->buffer, u->buffer + skip, u->size); - exp_lowmemcpy(u->lower,u->buffer+ skip, u->size); - } - } - - /* as long as buffer is still around, null terminate it */ - if (rc != EXP_EOF) { - u->buffer[u->size] = '\0'; - u->lower [u->size] = '\0'; - } + if (skip) { + size -= skip; + memcpy(u->buffer, u->buffer + skip, size); + } + } + Tcl_SetObjLength(size); + /* now update printed based on total amount skipped */ u->printed -= skip; /* if more skipped than printed (i.e., keymap encountered) */ /* for printed positive */ @@ -2100,11 +2026,11 @@ if (action) { change = (action && action->tty_reset); if (change && tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); - te = inter_eval(interp,action,m); + te = inter_eval(interp,action,u); if (change && real_tty) tty_changed = exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo); switch (te) { case TCL_BREAK: @@ -2129,59 +2055,48 @@ } #endif /* SIMPLE_EVENT */ done: #ifdef SIMPLE_EVENT - /* force child to exit upon eof from master */ - if (pid == 0) { - exit(SPAWNED_PROCESS_DIED); - } + /* force child to exit upon eof from master */ + if (pid == 0) { + exit(SPAWNED_PROCESS_DIED); + } #endif /* SIMPLE_EVENT */ - if (need_to_close_master) exp_close(interp,master); - - if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); - if (oldargv) ckfree((char *)argv); - if (fd_list) ckfree((char *)fd_list); - if (fd_to_input) ckfree((char *)fd_to_input); - free_input(interp,input_base); - free_action(action_base); - - return(status); + if (need_to_close_master) exp_close(interp,u); + + if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); + if (esPtrs) ckfree((char *)esPtrs); + if (esPtrToInput) Tcl_DeleteHashTable(esPtrToInput); + free_input(interp,input_base); + free_action(action_base); + + return(status); } /* version of Tcl_Eval for interact */ static int -inter_eval(interp,action,spawn_id) +inter_eval(interp,action,esPtr) Tcl_Interp *interp; struct action *action; -int spawn_id; -{ - int status; - char value[20]; - - /* deprecated */ - if (action->timestamp) { - time_t current_time; - time(¤t_time); - exp_timestamp(interp,¤t_time,INTER_OUT); - } - /* deprecated */ - - if (action->iwrite) { - sprintf(value,"%d",spawn_id); - out("spawn_id",value); - } - - if (action->statement) { - status = Tcl_Eval(interp,action->statement); - } else { - exp_nflog("\r\n",1); - status = exp_interpreter(interp); - } - - return status; +ExpState *esPtr; +{ + int status; + + if (action->iwrite) { + out("spawn_id",esPtr->name); + } + + if (action->statement) { + status = Tcl_EvalObjEx(interp,action->statement,0); + } else { + expStdoutLogU("\r\n",1); + status = exp_interpreter(interp,(Tcl_Obj *)0); + } + + return status; } static void free_keymap(km) struct keymap *km; @@ -2241,16 +2156,26 @@ free_output(interp,o->next); exp_free_i(interp,o->i_list,inter_updateproc); ckfree((char *)o); } + static struct exp_cmd_data cmd_data[] = { -{"interact", exp_proc(Exp_InteractCmd), 0, 0}, +{"interact", Exp_InteractObjCmd, 0, 0, 0}, {0}}; void exp_init_interact_cmds(interp) Tcl_Interp *interp; { - exp_create_commands(interp,cmd_data); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + exp_create_commands(interp,cmd_data); + + tsdPtr->cmdObjReturn = Tcl_NewStringObj("return",6); + Tcl_IncrRefCount(tsdPtr->cmdObjReturn); +#if 0 + tsdPtr->cmdObjInterpreter = Tcl_NewStringObj("interpreter",11); + Tcl_IncrRefCount(tsdPtr->cmdObjInterpreter); +#endif } Index: exp_log.c ================================================================== --- exp_log.c +++ exp_log.c @@ -7,255 +7,655 @@ #include /*#include tclInt.h drags in varargs.h. Since Pyramid */ /* objects to including varargs.h twice, just */ /* omit this one. */ #include "tclInt.h" +#ifdef NO_STDLIB_H +#include "../compat/stdlib.h" +#else +#include /* for malloc */ +#endif +#include + #include "expect_comm.h" #include "exp_int.h" #include "exp_rename.h" +#include "exp_command.h" #include "exp_log.h" -int loguser = TRUE; /* if TRUE, expect/spawn may write to stdout */ -int logfile_all = FALSE; /* if TRUE, write log of all interactions */ - /* despite value of loguser. */ -FILE *logfile = 0; -FILE *debugfile = 0; -int exp_is_debugging = FALSE; - -/* Following this are several functions that log the conversation. */ +typedef struct ThreadSpecificData { + Tcl_Channel diagChannel; + Tcl_DString diagFilename; + int diagToStderr; + + Tcl_Channel logChannel; + Tcl_DString logFilename; /* if no name, then it came from -open or -leaveopen */ + int logAppend; + int logLeaveOpen; + int logAll; /* if TRUE, write log of all interactions + * despite value of logUser - i.e., even if + * user is not seeing it (via stdout) + */ + int logUser; /* TRUE if user sees interactions on stdout */ +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + +/* + * create a reasonably large buffer for the bulk of the output routines + * that are not too large + */ +static char bigbuf[2000]; + +/* + * Following this are several functions that log the conversation. Some + * general notes on all of them: + */ + +/* + * ignore sprintf return value ("character count") because it's not + * defined in terms of UTF so it would be misinterpreted if we passed + * it on. + */ + +/* + * if necessary, they could be made more efficient by skipping vsprintf based + * on booleans + */ + /* Most of them have multiple calls to printf-style functions. */ /* At first glance, it seems stupid to reformat the same arguments again */ /* but we have no way of telling how long the formatted output will be */ /* and hence cannot allocate a buffer to do so. */ /* Fortunately, in production code, most of the duplicate reformatting */ /* will be skipped, since it is due to handling errors and debugging. */ + +/* + * Name: expWriteBytesAndLogIfTtyU + * + * Output to channel (and log if channel is stdout or devtty) + * + * Returns: TCL_OK or TCL_ERROR; + */ + +int +expWriteBytesAndLogIfTtyU(esPtr,buf,lenBytes) + ExpState *esPtr; + char *buf; + int lenBytes; +{ + int wc; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (esPtr->valid) + wc = Tcl_WriteChars(esPtr->channel,buf,lenBytes); + + if (tsdPtr->logChannel && ((esPtr->fdout == 1) || expDevttyIs(esPtr))) { + Tcl_WriteChars(tsdPtr->logChannel,buf,lenBytes); + } + return wc; +} + +/* + * Name: expLogDiagU + * + * Send to the Log (and Diag if open). This is for writing to the log. + * (In contrast, expDiagLog... is for writing diagnostics.) + */ + +void +expLogDiagU(buf) +char *buf; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + expDiagWriteChars(buf,-1); + if (tsdPtr->logChannel) { + Tcl_WriteChars(tsdPtr->logChannel, buf, -1); + } +} + +/* + * Name: expLogInteractionU + * + * 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. + */ +void +expLogInteractionU(esPtr,buf) + ExpState *esPtr; + char *buf; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->logAll || (tsdPtr->logUser && tsdPtr->logChannel)) { + Tcl_WriteChars(tsdPtr->logChannel,buf,-1); + } + + /* hmm.... if stdout is closed such as by disconnect, loguser + should be forced FALSE */ + + /* don't write to user if they're seeing it already, i.e., typing it! */ + if (tsdPtr->logUser && (!expStdinoutIs(esPtr)) && (!expDevttyIs(esPtr))) { + ExpState *stdinout = expStdinoutGet(); + if (stdinout->valid) { + Tcl_WriteChars(stdinout->channel,buf,-1); + } + } + expDiagWriteChars(buf,-1); +} /* send to log if open */ /* send to stderr if debugging enabled */ /* use this for logging everything but the parent/child conversation */ /* (this turns out to be almost nothing) */ /* uppercase L differentiates if from math function of same name */ -#define LOGUSER (loguser || force_stdout) +#define LOGUSER (tsdPtr->logUser || force_stdout) /*VARARGS*/ void -exp_log TCL_VARARGS_DEF(int,arg1) -/*exp_log(va_alist)*/ -/*va_dcl*/ -{ - int force_stdout; - char *fmt; - va_list args; - - force_stdout = TCL_VARARGS_START(int,arg1,args); - /*va_start(args);*/ - /*force_stdout = va_arg(args,int);*/ - fmt = va_arg(args,char *); - if (debugfile) vfprintf(debugfile,fmt,args); - if (logfile_all || (LOGUSER && logfile)) vfprintf(logfile,fmt,args); - if (LOGUSER) vfprintf(stdout,fmt,args); - va_end(args); +expStdoutLog TCL_VARARGS_DEF(int,arg1) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int force_stdout; + char *fmt; + va_list args; + + force_stdout = TCL_VARARGS_START(int,arg1,args); + fmt = va_arg(args,char *); + + if ((!tsdPtr->logUser) && (!force_stdout) && (!tsdPtr->logAll)) return; + + (void) vsprintf(bigbuf,fmt,args); + expDiagWriteBytes(bigbuf,-1); + if (tsdPtr->logAll || (LOGUSER && tsdPtr->logChannel)) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1); + if (LOGUSER) fprintf(stdout,"%s",bigbuf); + va_end(args); } /* just like log but does no formatting */ /* send to log if open */ /* use this function for logging the parent/child conversation */ void -exp_nflog(buf,force_stdout) +expStdoutLogU(buf,force_stdout) char *buf; -int force_stdout; /* override value of loguser */ -{ - int length = strlen(buf); - - if (debugfile) fwrite(buf,1,length,debugfile); - if (logfile_all || (LOGUSER && logfile)) fwrite(buf,1,length,logfile); - if (LOGUSER) fwrite(buf,1,length,stdout); -#if 0 - if (logfile_all || (LOGUSER && logfile)) { - int newlength = exp_copy_out(length); - fwrite(exp_out_buffer,1,newlength,logfile); - } +int force_stdout; /* override value of logUser */ +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int length; + + if ((!tsdPtr->logUser) && (!force_stdout) && (!tsdPtr->logAll)) return; + + length = strlen(buf); + expDiagWriteBytes(buf,length); + if (tsdPtr->logAll || (LOGUSER && tsdPtr->logChannel)) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1); + if (LOGUSER) { +#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)) + Tcl_WriteChars (Tcl_GetStdChannel (TCL_STDOUT), buf, length); + Tcl_Flush (Tcl_GetStdChannel (TCL_STDOUT)); +#else + fwrite(buf,1,length,stdout); #endif -} -#undef LOGUSER - -/* send to log if open and debugging enabled */ -/* send to stderr if debugging enabled */ -/* use this function for recording unusual things in the log */ -/*VARARGS*/ -void -debuglog TCL_VARARGS_DEF(char *,arg1) -/*debuglog(va_alist)*/ -/*va_dcl*/ -{ - char *fmt; - va_list args; - - fmt = TCL_VARARGS_START(char *,arg1,args); - /*va_start(args);*/ - /*fmt = va_arg(args,char *);*/ - if (debugfile) vfprintf(debugfile,fmt,args); - if (is_debugging) { - vfprintf(stderr,fmt,args); - if (logfile) vfprintf(logfile,fmt,args); - } - - va_end(args); + } } /* send to log if open */ /* send to stderr */ /* use this function for error conditions */ /*VARARGS*/ void -exp_errorlog TCL_VARARGS_DEF(char *,arg1) -/*exp_errorlog(va_alist)*/ -/*va_dcl*/ -{ - char *fmt; - va_list args; - - fmt = TCL_VARARGS_START(char *,arg1,args); - /*va_start(args);*/ - /*fmt = va_arg(args,char *);*/ - vfprintf(stderr,fmt,args); - if (debugfile) vfprintf(debugfile,fmt,args); - if (logfile) vfprintf(logfile,fmt,args); - va_end(args); +expErrorLog TCL_VARARGS_DEF(char *,arg1) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + char *fmt; + va_list args; + + fmt = TCL_VARARGS_START(char *,arg1,args); + (void) vsprintf(bigbuf,fmt,args); + + expDiagWriteChars(bigbuf,-1); + fprintf(stderr,"%s",bigbuf); + if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1); + + va_end(args); } /* just like errorlog but does no formatting */ /* send to log if open */ /* use this function for logging the parent/child conversation */ /*ARGSUSED*/ void -exp_nferrorlog(buf,force_stdout) +expErrorLogU(buf) char *buf; -int force_stdout; /* not used, only declared here for compat with */ - /* exp_nflog() */ -{ - int length = strlen(buf); - fwrite(buf,1,length,stderr); - if (debugfile) fwrite(buf,1,length,debugfile); - if (logfile) fwrite(buf,1,length,logfile); -} - -#if 0 -static int out_buffer_size; -static char *outp_last; -static char *out_buffer; -static char *outp; /* pointer into out_buffer - static in order */ - /* to update whenever out_buffer is enlarged */ - +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + int length = strlen(buf); + fwrite(buf,1,length,stderr); + expDiagWriteChars(buf,-1); + if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,buf,-1); +} + + + +/* send diagnostics to Diag, Log, and stderr */ +/* use this function for recording unusual things in the log */ +/*VARARGS*/ +void +expDiagLog TCL_VARARGS_DEF(char *,arg1) +{ + char *fmt; + va_list args; + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if ((tsdPtr->diagToStderr == 0) && (tsdPtr->diagChannel == 0)) return; + + fmt = TCL_VARARGS_START(char *,arg1,args); + + (void) vsprintf(bigbuf,fmt,args); + + expDiagWriteBytes(bigbuf,-1); + if (tsdPtr->diagToStderr) { + fprintf(stderr,"%s",bigbuf); + if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1); + } + + va_end(args); +} + + +/* expDiagLog for unformatted strings + this also takes care of arbitrary large strings */ +void +expDiagLogU(str) + char *str; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if ((tsdPtr->diagToStderr == 0) && (tsdPtr->diagChannel == 0)) return; + + expDiagWriteBytes(str,-1); + + if (tsdPtr->diagToStderr) { + fprintf(stderr,"%s",str); + if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,str,-1); + } +} + +void +expDiagToStderrSet(val) + int val; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->diagToStderr = val; +} + + +int +expDiagToStderrGet() { + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->diagToStderr; +} + +Tcl_Channel +expDiagChannelGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->diagChannel; +} + +void +expDiagChannelClose(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->diagChannel) return; + Tcl_UnregisterChannel(interp,tsdPtr->diagChannel); + Tcl_DStringFree(&tsdPtr->diagFilename); + tsdPtr->diagChannel = 0; +} + +/* currently this registers the channel, however the exp_internal + command doesn't currently give the channel name to the user so + this is kind of useless - but we might change this someday */ +int +expDiagChannelOpen(interp,filename) + Tcl_Interp *interp; + char *filename; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + char *newfilename; + + Tcl_ResetResult(interp); + newfilename = Tcl_TranslateFileName(interp,filename,&tsdPtr->diagFilename); + if (!newfilename) return TCL_ERROR; + + /* Tcl_TildeSubst doesn't store into dstring */ + /* if no ~, so force string into dstring */ + /* this is only needed so that next time around */ + /* we can get dstring for -info if necessary */ + if (Tcl_DStringValue(&tsdPtr->diagFilename)[0] == '\0') { + Tcl_DStringAppend(&tsdPtr->diagFilename,filename,-1); + } + + tsdPtr->diagChannel = Tcl_OpenFileChannel(interp,newfilename,"a",0777); + if (!tsdPtr->diagChannel) { + Tcl_DStringFree(&tsdPtr->diagFilename); + return TCL_ERROR; + } + Tcl_RegisterChannel(interp,tsdPtr->diagChannel); + Tcl_SetChannelOption(interp,tsdPtr->diagChannel,"-buffering","none"); + return TCL_OK; +} + +void +expDiagWriteObj(obj) + Tcl_Obj *obj; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->diagChannel) return; + + Tcl_WriteObj(tsdPtr->diagChannel,obj); +} + +/* write 8-bit bytes */ +void +expDiagWriteBytes(str,len) + char *str; + int len; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->diagChannel) return; + + Tcl_Write(tsdPtr->diagChannel,str,len); +} + +/* write UTF chars */ +void +expDiagWriteChars(str,len) + char *str; + int len; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->diagChannel) return; + + Tcl_WriteChars(tsdPtr->diagChannel,str,len); +} + +char * +expDiagFilename() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return Tcl_DStringValue(&tsdPtr->diagFilename); +} + +void +expLogChannelClose(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->logChannel) return; + + if (Tcl_DStringLength(&tsdPtr->logFilename)) { + /* it's a channel that we created */ + Tcl_UnregisterChannel(interp,tsdPtr->logChannel); + Tcl_DStringFree(&tsdPtr->logFilename); + } else { + /* it's a channel that tcl::open created */ + if (!tsdPtr->logLeaveOpen) { + Tcl_UnregisterChannel(interp,tsdPtr->logChannel); + } + } + tsdPtr->logChannel = 0; + tsdPtr->logAll = 0; /* can't write to log if none open! */ +} + +/* currently this registers the channel, however the exp_log_file + command doesn't currently give the channel name to the user so + this is kind of useless - but we might change this someday */ +int +expLogChannelOpen(interp,filename,append) + Tcl_Interp *interp; + char *filename; + int append; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + char *newfilename; + char mode[2]; + + if (append) { + strcpy(mode,"a"); + } else { + strcpy(mode,"w"); + } + + Tcl_ResetResult(interp); + newfilename = Tcl_TranslateFileName(interp,filename,&tsdPtr->logFilename); + if (!newfilename) return TCL_ERROR; + + /* Tcl_TildeSubst doesn't store into dstring */ + /* if no ~, so force string into dstring */ + /* this is only needed so that next time around */ + /* we can get dstring for -info if necessary */ + if (Tcl_DStringValue(&tsdPtr->logFilename)[0] == '\0') { + Tcl_DStringAppend(&tsdPtr->logFilename,filename,-1); + } + + tsdPtr->logChannel = Tcl_OpenFileChannel(interp,newfilename,mode,0777); + if (!tsdPtr->logChannel) { + Tcl_DStringFree(&tsdPtr->logFilename); + return TCL_ERROR; + } + Tcl_RegisterChannel(interp,tsdPtr->logChannel); + Tcl_SetChannelOption(interp,tsdPtr->logChannel,"-buffering","none"); + return TCL_OK; +} + +int +expLogAppendGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->logAppend; +} + +void +expLogAppendSet(app) + int app; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->logAppend = app; +} + +int +expLogAllGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->logAll; +} + +void +expLogAllSet(app) + int app; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->logAll = app; + /* should probably confirm logChannel != 0 */ +} + +int +expLogToStdoutGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->logUser; +} + +void +expLogToStdoutSet(app) + int app; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->logUser = app; +} + +int +expLogLeaveOpenGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->logLeaveOpen; +} + +void +expLogLeaveOpenSet(app) + int app; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + tsdPtr->logLeaveOpen = app; +} + +Tcl_Channel +expLogChannelGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + return tsdPtr->logChannel; +} + +/* to set to a pre-opened channel (presumably by tcl::open) */ +int +expLogChannelSet(interp,name) + Tcl_Interp *interp; + char *name; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + int mode; + + if (0 == (tsdPtr->logChannel = Tcl_GetChannel(interp,name,&mode))) { + return TCL_ERROR; + } + if (!(mode & TCL_WRITABLE)) { + tsdPtr->logChannel = 0; + Tcl_SetResult(interp,"channel is not writable",TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +char * +expLogFilenameGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return Tcl_DStringValue(&tsdPtr->logFilename); +} + +int +expLogUserGet() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + return tsdPtr->logUser; +} void -exp_init_log() +expLogUserSet(logUser) + int logUser; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->logUser = logUser; +} + + + +/* generate printable versions of random ASCII strings. Primarily used */ +/* in diagnostic mode, "expect -d" */ +static char * +expPrintifyReal(s) +char *s; +{ + static int destlen = 0; + static char *dest = 0; + char *d; /* ptr into dest */ + unsigned int need; + Tcl_UniChar ch; + + if (s == 0) return(""); + + /* worst case is every character takes 4 to printify */ + need = strlen(s)*6 + 1; + if (need > destlen) { + if (dest) ckfree(dest); + dest = ckalloc(need); + destlen = need; + } + + for (d = dest;*s;) { + s += Tcl_UtfToUniChar(s, &ch); + if (ch == '\r') { + strcpy(d,"\\r"); d += 2; + } else if (ch == '\n') { + strcpy(d,"\\n"); d += 2; + } else if (ch == '\t') { + strcpy(d,"\\t"); d += 2; + } else if ((ch < 0x80) && isprint(UCHAR(ch))) { + *d = (char)ch; d += 1; + } else { + sprintf(d,"\\u%04x",ch); d += 6; + } + } + *d = '\0'; + return(dest); +} + +char * +expPrintifyObj(obj) + Tcl_Obj *obj; { - out_buffer = ckalloc(BUFSIZ); - out_buffer_size = BUFSIZ; - outp_last = out_buffer + BUFSIZ - 1; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + /* don't bother writing into bigbuf if we're not going to ever use it */ + if ((!tsdPtr->diagToStderr) && (!tsdPtr->diagChannel)) return((char *)0); + + return expPrintifyReal(Tcl_GetString(obj)); } char * -enlarge_out_buffer() -{ - int offset = outp - out_buffer; - - int new_out_buffer_size = out_buffer_size = BUFSIZ; - realloc(out_buffer,new_out_buffer_size); - - out_buffer_size = new_out_buffer_size; - outp = out_buffer + offset; - - outp_last = out_buffer + out_buffer_size - 1; - - return(out_buffer); -} - -/* like sprintf, but uses a static buffer enlarged as necessary */ -/* currently supported are %s, %d, and %#d where # is a single-digit */ -void -exp_sprintf TCL_VARARGS_DEF(char *,arg1) -/* exp_sprintf(va_alist)*/ -/*va_dcl*/ -{ - char *fmt; - va_list args; - char int_literal[20]; /* big enough for an int literal? */ - char *int_litp; /* pointer into int_literal */ - char *width; - char *string_arg; - int int_arg; - char *int_fmt; - - fmt = TCL_VARARGS_START(char *,arg1,args); - /*va_start(args);*/ - /*fmt = va_arg(args,char *);*/ - - while (*fmt != '\0') { - if (*fmt != '%') { - *outp++ = *fmt++; - continue; - } - - /* currently, only single-digit widths are used */ - if (isdigit(*fmt)) { - width = fmt++; - } else width = 0; - - switch (*fmt) { - case 's': /* interpolate string */ - string_arg = va_arg(args,char *); - - while (*string_arg) { - if (outp == outp_last) { - if (enlarge_out_buffer() == 0) { - /* FAIL */ - return; - } - } - *outp++ = *string_arg++; - } - fmt++; - break; - case 'd': /* interpolate int */ - int_arg = va_arg(args,int); - - if (width) int_fmt = width; - else int_fmt = fmt; - - sprintf(int_literal,int_fmt,int_arg); - - int_litp = int_literal; - for (int_litp;*int_litp;) { - if (enlarge_out_buffer() == 0) return; - *outp++ = *int_litp++; - } - fmt++; - break; - default: /* anything else is literal */ - if (enlarge_out_buffer() == 0) return; /* FAIL */ - *outp++ = *fmt++; - break; - } - } -} - -/* copy input string to exp_output, replacing \r\n sequences by \n */ -/* return length of new string */ -int -exp_copy_out(char *s) -{ - outp = out_buffer; - int count = 0; - - while (*s) { - if ((*s == '\r') && (*(s+1) =='\n')) s++; - if (enlarge_out_buffer() == 0) { - /* FAIL */ - break; - } - *outp = *s; - count++; - } - return count; -} -#endif +expPrintify(s) /* INTL */ +char *s; +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + /* don't bother writing into bigbuf if we're not going to ever use it */ + if ((!tsdPtr->diagToStderr) && (!tsdPtr->diagChannel)) return((char *)0); + + return expPrintifyReal(s); +} + +void +expDiagInit() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_DStringInit(&tsdPtr->diagFilename); + tsdPtr->diagChannel = 0; + tsdPtr->diagToStderr = 0; +} + +void +expLogInit() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + Tcl_DStringInit(&tsdPtr->logFilename); + tsdPtr->logChannel = 0; + tsdPtr->logAll = FALSE; + tsdPtr->logUser = TRUE; +} Index: exp_log.h ================================================================== --- exp_log.h +++ exp_log.h @@ -1,28 +1,45 @@ /* exp_log.h */ -#include "exp_printify.h" - -/* special version of log for non-null-terminated strings which */ -/* never need printf-style formatting. */ -#define logn(buf,length) { \ - if (logfile) fwrite(buf,1,length,logfile); \ - if (debugfile) fwrite(buf,1,length,debugfile); \ - } - -#define dprintify(x) ((is_debugging || debugfile)?exp_printify(x):0) -/* in circumstances where "debuglog(printify(...))" is written, call */ -/* dprintify instead. This will avoid doing any formatting that would */ -/* occur before debuglog got control and decided not to do anything */ -/* because (is_debugging || debugfile) was false. */ - -extern void exp_errorlog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); -extern void exp_log _ANSI_ARGS_(TCL_VARARGS(int,force_stdout)); -extern void exp_debuglog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); -extern void exp_nflog _ANSI_ARGS_((char *buf, int force_stdout)); -extern void exp_nferrorlog _ANSI_ARGS_((char *buf, int force_stdout)); - -extern FILE *debugfile; -extern FILE *logfile; -extern int logfile_all; - -extern int is_debugging; /* useful to know for avoid debug calls */ +extern void expErrorLog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); +extern void expErrorLogU _ANSI_ARGS_((char *)); + +extern void expStdoutLog _ANSI_ARGS_(TCL_VARARGS(int,force_stdout)); +extern void expStdoutLogU _ANSI_ARGS_((char *buf, int force_stdout)); + +EXTERN void expDiagInit _ANSI_ARGS_((void)); +EXTERN int expDiagChannelOpen _ANSI_ARGS_((Tcl_Interp *,char *)); +EXTERN Tcl_Channel expDiagChannelGet _ANSI_ARGS_((void)); +EXTERN void expDiagChannelClose _ANSI_ARGS_((Tcl_Interp *)); +EXTERN char * expDiagFilename _ANSI_ARGS_((void)); +EXTERN int expDiagToStderrGet _ANSI_ARGS_((void)); +EXTERN void expDiagToStderrSet _ANSI_ARGS_((int)); +EXTERN void expDiagWriteBytes _ANSI_ARGS_((char *,int)); +EXTERN void expDiagWriteChars _ANSI_ARGS_((char *,int)); +EXTERN void expDiagWriteObj _ANSI_ARGS_((Tcl_Obj *)); +EXTERN void expDiagLog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); +EXTERN void expDiagLogU _ANSI_ARGS_((char *)); + +EXTERN char * expPrintify _ANSI_ARGS_((char *)); +EXTERN char * expPrintifyObj _ANSI_ARGS_((Tcl_Obj *)); + +EXTERN void expLogInit _ANSI_ARGS_((void)); +EXTERN int expLogChannelOpen _ANSI_ARGS_((Tcl_Interp *,char *,int)); +EXTERN Tcl_Channel expLogChannelGet _ANSI_ARGS_((void)); +EXTERN int expLogChannelSet _ANSI_ARGS_((Tcl_Interp *,char *)); +EXTERN void expLogChannelClose _ANSI_ARGS_((Tcl_Interp *)); +EXTERN char * expLogFilenameGet _ANSI_ARGS_((void)); +EXTERN void expLogAppendSet _ANSI_ARGS_((int)); +EXTERN int expLogAppendGet _ANSI_ARGS_((void)); +EXTERN void expLogLeaveOpenSet _ANSI_ARGS_((int)); +EXTERN int expLogLeaveOpenGet _ANSI_ARGS_((void)); +EXTERN void expLogAllSet _ANSI_ARGS_((int)); +EXTERN int expLogAllGet _ANSI_ARGS_((void)); +EXTERN void expLogToStdoutSet _ANSI_ARGS_((int)); +EXTERN int expLogToStdoutGet _ANSI_ARGS_((void)); +EXTERN void expLogDiagU _ANSI_ARGS_((char *)); +EXTERN int expWriteBytesAndLogIfTtyU _ANSI_ARGS_((ExpState *,char *,int)); + +EXTERN int expLogUserGet _ANSI_ARGS_((void)); +EXTERN void expLogUserSet _ANSI_ARGS_((int)); + +EXTERN void expLogInteractionU _ANSI_ARGS_((ExpState *,char *)); Index: exp_main_exp.c ================================================================== --- exp_main_exp.c +++ exp_main_exp.c @@ -16,34 +16,41 @@ main(argc, argv) int argc; char *argv[]; { int rc = 0; + char buffer [30]; + Tcl_Interp *interp = Tcl_CreateInterp(); + Tcl_FindExecutable(argv[0]); if (Tcl_Init(interp) == TCL_ERROR) { - fprintf(stderr,"Tcl_Init failed: %s\n",interp->result); - exit(1); + fprintf(stderr,"Tcl_Init failed: %s\n",interp->result); + (void) exit(1); } if (Expect_Init(interp) == TCL_ERROR) { - fprintf(stderr,"Expect_Init failed: %s\n",interp->result); - exit(1); + fprintf(stderr,"Expect_Init failed: %s\n",interp->result); + (void) exit(1); } exp_parse_argv(interp,argc,argv); /* become interactive if requested or "nothing to do" */ if (exp_interactive) - (void) exp_interpreter(interp); + (void) exp_interpreter(interp,(Tcl_Obj *)0); else if (exp_cmdfile) rc = exp_interpret_cmdfile(interp,exp_cmdfile); else if (exp_cmdfilename) rc = exp_interpret_cmdfilename(interp,exp_cmdfilename); /* assert(exp_cmdlinecmds != 0) */ - exp_exit(interp,rc); + /* SF #439042 -- Allow overide of "exit" by user / script + */ + + sprintf(buffer, "exit %d", rc); + Tcl_Eval(interp, buffer); /*NOTREACHED*/ return 0; /* Needed only to prevent compiler warning. */ } Index: exp_main_sub.c ================================================================== --- exp_main_sub.c +++ exp_main_sub.c @@ -63,37 +63,33 @@ static void usage(interp) Tcl_Interp *interp; { - errorlog("usage: expect [-div] [-c cmds] [[-f] cmdfile] [args]\r\n"); - exp_exit(interp,1); -} - -/*ARGSUSED*/ -void -exp_exit(interp,status) -Tcl_Interp *interp; /* historic */ -int status; -{ - Tcl_Exit(status); + char buffer [] = "exit 1"; + expErrorLog("usage: expect [-div] [-c cmds] [[-f] cmdfile] [args]\r\n"); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + Tcl_Eval(interp, buffer); } /* this clumsiness because pty routines don't know Tcl definitions */ +/*ARGSUSED*/ static void exp_pty_exit_for_tcl(clientData) ClientData clientData; { - exp_pty_exit(); + exp_pty_exit(); } static void exp_init_pty_exit() { - Tcl_CreateExitHandler(exp_pty_exit_for_tcl,(ClientData)0); + Tcl_CreateExitHandler(exp_pty_exit_for_tcl,(ClientData)0); } /* This can be called twice or even recursively - it's safe. */ void exp_exit_handlers(clientData) @@ -108,35 +104,27 @@ /* become interp-specific */ static int did_app_exit = FALSE; static int did_expect_exit = FALSE; - /* don't think this code is relevant any longer, but not positive! */ - if (!interp) { - /* if no interp handy (i.e., called from interrupt handler) */ - /* use last one created - it's a hack but we're exiting */ - /* ungracefully to begin with */ - interp = exp_interp; - } - if (!did_expect_exit) { did_expect_exit = TRUE; /* called user-defined exit routine if one exists */ if (exp_onexit_action) { int result = Tcl_GlobalEval(interp,exp_onexit_action); if (result != TCL_OK) Tcl_BackgroundError(interp); } } else { - debuglog("onexit handler called recursively - forcing exit\r\n"); + expDiagLogU("onexit handler called recursively - forcing exit\r\n"); } if (exp_app_exit) { if (!did_app_exit) { did_app_exit = TRUE; (*exp_app_exit)(interp); } else { - debuglog("application exit handler called recursively - forcing exit\r\n"); + expDiagLogU("application exit handler called recursively - forcing exit\r\n"); } } if (!exp_disconnected && !exp_forked @@ -157,26 +145,20 @@ static int history_nextid(interp) Tcl_Interp *interp; { - Interp *iPtr = (Interp *)interp; - -#if TCL_MAJOR_VERSION < 8 - return iPtr->curEventNum+1; -#else - /* unncessarily tricky coding - if nextid isn't defined, - maintain our own static version */ - - static int nextid = 0; - char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0); - if (nextidstr) { - /* intentionally ignore failure */ - (void) sscanf(nextidstr,"%d",&nextid); - } - return ++nextid; -#endif + /* unncessarily tricky coding - if nextid isn't defined, + maintain our own static version */ + + static int nextid = 0; + char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0); + if (nextidstr) { + /* intentionally ignore failure */ + (void) sscanf(nextidstr,"%d",&nextid); + } + return ++nextid; } /* this stupidity because Tcl needs commands in writable space */ static char prompt1[] = "prompt1"; static char prompt2[] = "prompt2"; @@ -184,33 +166,35 @@ static char *prompt2_default = "+> "; static char prompt1_default[] = "expect%d.%d> "; /*ARGSUSED*/ int -Exp_Prompt1Cmd(clientData, interp, argc, argv) +Exp_Prompt1Cmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; -int argc; -char **argv; -{ - Interp *iPtr = (Interp *)interp; - - sprintf(interp->result,prompt1_default, - iPtr->numLevels,history_nextid(interp)); - return(TCL_OK); +int objc; +Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + static char buffer[200]; + + Interp *iPtr = (Interp *)interp; + + sprintf(buffer,prompt1_default,iPtr->numLevels,history_nextid(interp)); + Tcl_SetResult(interp,buffer,TCL_STATIC); + return(TCL_OK); } /*ARGSUSED*/ int -Exp_Prompt2Cmd(clientData, interp, argc, argv) +Exp_Prompt2Cmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; -int argc; -char **argv; +int objc; +Tcl_Obj *CONST objv[]; { - strcpy(interp->result,prompt2_default); - return(TCL_OK); + Tcl_SetResult(interp,prompt2_default,TCL_STATIC); + return(TCL_OK); } /*ARGSUSED*/ static int ignore_procs(interp,s) @@ -259,11 +243,12 @@ } /* no \n at end, since ccmd will already have one. */ /* Actually, this is not true if command is last in */ /* file and has no newline after it, oh well */ - errorlog("%s\r\n",exp_cook(msg,(int *)0)); + expErrorLogU(exp_cook(msg,(int *)0)); + expErrorLogU("\r\n"); } /* user has pressed escape char from interact or somehow requested expect. If a user-supplied command returns: @@ -272,125 +257,157 @@ TCL_RETURN, return TCL_OK (assume user just wants to escape() to return) EXP_TCL_RETURN, return TCL_RETURN anything else return it */ int -exp_interpreter(interp) -Tcl_Interp *interp; -{ - int rc; - char *ccmd; /* pointer to complete command */ - char line[BUFSIZ+1]; /* space for partial command */ - int newcmd = TRUE; - Tcl_DString dstring; - Interp *iPtr = (Interp *)interp; - int tty_changed = FALSE; - - exp_tty tty_old; - int was_raw, was_echo; - - int dummy; - Tcl_Channel outChannel; - int fd = fileno(stdin); - - expect_key++; - - Tcl_DStringInit(&dstring); - - newcmd = TRUE; - while (TRUE) { - outChannel = Tcl_GetStdChannel(TCL_STDOUT); - if (outChannel) { - Tcl_Flush(outChannel); - } - - /* force terminal state */ - tty_changed = exp_tty_cooked_echo(interp,&tty_old,&was_raw,&was_echo); - - if (newcmd) { - rc = Tcl_Eval(interp,prompt1); - if (rc == TCL_OK) exp_log(1,"%s",interp->result); - else exp_log(1,prompt1_default,iPtr->numLevels, - history_nextid(interp)); - } else { - rc = Tcl_Eval(interp,prompt2); - if (rc == TCL_OK) exp_log(1,"%s",interp->result); - else exp_log(1,prompt2_default,1); - } - - exp_fs[fd].force_read = 1; - rc = exp_get_next_event(interp,&fd,1,&dummy,EXP_TIME_INFINITY, - exp_fs[fd].key); - /* check for rc == EXP_TCLERROR? */ - - if (rc != EXP_EOF) { - rc = read(0,line,BUFSIZ); -#ifdef SIMPLE_EVENT - if (rc == -1 && errno == EINTR) { - if (Tcl_AsyncReady()) { - (void) Tcl_AsyncInvoke(interp,TCL_OK); - } - continue; - } -#endif - if (rc <= 0) { - if (!newcmd) line[0] = 0; - else rc = EXP_EOF; - } else line[rc] = '\0'; - } - - if (rc == EXP_EOF) exp_exit(interp,0); - - if (debugfile) fwrite(line,1,strlen(line),debugfile); - /* intentionally always write to logfile */ - if (logfile) fwrite(line,1,strlen(line),logfile); - /* no need to write to stdout, since they will see */ - /* it just from it having been echoed as they are */ - /* typing it */ - - ccmd = Tcl_DStringAppend(&dstring,line,rc); - if (!Tcl_CommandComplete(ccmd)) { - newcmd = FALSE; - continue; /* continue collecting command */ - } - newcmd = TRUE; - - if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); - - rc = Tcl_RecordAndEval(interp,ccmd,0); - Tcl_DStringFree(&dstring); - switch (rc) { - case TCL_OK: - if (*interp->result != 0) - exp_log(1,"%s\r\n",exp_cook(interp->result,(int *)0)); - continue; - case TCL_ERROR: - handle_eval_error(interp,1); - /* since user is typing by hand, we expect lots */ - /* of errors, and want to give another chance */ - continue; -#define finish(x) {rc = x; goto done;} - case TCL_BREAK: - case TCL_CONTINUE: - finish(rc); - case EXP_TCL_RETURN: - finish(TCL_RETURN); - case TCL_RETURN: - finish(TCL_OK); - default: - /* note that ccmd has trailing newline */ - errorlog("error %d: %s\r\n",rc,ccmd); - continue; - } - } - /* cannot fall thru here, must jump to label */ - done: - if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); - - Tcl_DStringFree(&dstring); - - return(rc); +exp_interpreter(interp,eofObj) +Tcl_Interp *interp; +Tcl_Obj *eofObj; +{ + Tcl_Obj *commandPtr = NULL; + int code; + int gotPartial; + Interp *iPtr = (Interp *)interp; + int tty_changed = FALSE; + exp_tty tty_old; + int was_raw, was_echo; + + Tcl_Channel inChannel, outChannel; + ExpState *esPtr = expStdinoutGet(); + /* int fd = fileno(stdin);*/ + + expect_key++; + + commandPtr = Tcl_NewObj(); + Tcl_IncrRefCount(commandPtr); + + gotPartial = 0; + while (TRUE) { + outChannel = expStdinoutGet()->channel; + if (outChannel) { + Tcl_Flush(outChannel); + } + if (!esPtr->open) { + code = EXP_EOF; + goto eof; + } + + /* force terminal state */ + tty_changed = exp_tty_cooked_echo(interp,&tty_old,&was_raw,&was_echo); + + if (!gotPartial) { + code = Tcl_Eval(interp,prompt1); + if (code == TCL_OK) { + expStdoutLogU(Tcl_GetStringResult(interp),1); + } + else expStdoutLog(1,prompt1_default,iPtr->numLevels,history_nextid(interp)); + } else { + code = Tcl_Eval(interp,prompt2); + if (code == TCL_OK) { + expStdoutLogU(Tcl_GetStringResult(interp),1); + } + else expStdoutLogU(prompt2_default,1); + } + + esPtr->force_read = 1; + code = exp_get_next_event(interp,&esPtr,1,&esPtr,EXP_TIME_INFINITY, + esPtr->key); + /* check for code == EXP_TCLERROR? */ + + if (code != EXP_EOF) { + inChannel = expStdinoutGet()->channel; + code = Tcl_GetsObj(inChannel, commandPtr); +#ifdef SIMPLE_EVENT + if (code == -1 && errno == EINTR) { + if (Tcl_AsyncReady()) { + (void) Tcl_AsyncInvoke(interp,TCL_OK); + } + continue; + } +#endif + if (code < 0) code = EXP_EOF; + if ((code == 0) && Tcl_Eof(inChannel) && !gotPartial) code = EXP_EOF; + } + + eof: + if (code == EXP_EOF) { + if (eofObj) { + code = Tcl_EvalObjEx(interp,eofObj,0); + } else { + code = TCL_OK; + } + goto done; + } + + expDiagWriteObj(commandPtr); + /* intentionally always write to logfile */ + if (expLogChannelGet()) { + Tcl_WriteObj(expLogChannelGet(),commandPtr); + } + /* no need to write to stdout, since they will see */ + /* it just from it having been echoed as they are */ + /* typing it */ + + /* + * Add the newline removed by Tcl_GetsObj back to the string. + */ + + Tcl_AppendToObj(commandPtr, "\n", 1); + if (!TclObjCommandComplete(commandPtr)) { + gotPartial = 1; + continue; + } + + Tcl_AppendToObj(commandPtr, "\n", 1); + if (!TclObjCommandComplete(commandPtr)) { + gotPartial = 1; + continue; + } + + gotPartial = 0; + + if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); + + code = Tcl_RecordAndEvalObj(interp, commandPtr, 0); + Tcl_SetObjLength(commandPtr, 0); + switch (code) { + char *str; + + case TCL_OK: + str = Tcl_GetStringResult(interp); + if (*str != 0) { + expStdoutLogU(exp_cook(str,(int *)0),1); + expStdoutLogU("\r\n",1); + } + continue; + case TCL_ERROR: + handle_eval_error(interp,1); + /* since user is typing by hand, we expect lots */ + /* of errors, and want to give another chance */ + continue; +#define finish(x) {code = x; goto done;} + case TCL_BREAK: + case TCL_CONTINUE: + finish(code); + case EXP_TCL_RETURN: + finish(TCL_RETURN); + case TCL_RETURN: + finish(TCL_OK); + default: + /* note that ccmd has trailing newline */ + expErrorLog("error %d: ",code); + expErrorLogU(Tcl_GetString(Tcl_GetObjResult(interp))); + expErrorLogU("\r\n"); + continue; + } + } + /* cannot fall thru here, must jump to label */ + done: + if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo); + + Tcl_DecrRefCount(commandPtr); + return(code); } /*ARGSUSED*/ int Exp_ExpVersionCmd(clientData, interp, argc, argv) @@ -435,86 +452,125 @@ if (argc == 2) { exp_error(interp,"%s requires Expect version %s (but using %s)", exp_argv0,user_version,exp_version); return(TCL_ERROR); } - errorlog("%s: requires Expect version %s (but using %s)\r\n", + expErrorLog("%s: requires Expect version %s (but using %s)\r\n", exp_argv0,user_version,exp_version); - exp_exit(interp,1); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } /*NOTREACHED*/ } -static char init_auto_path[] = "lappend auto_path $exp_library $exp_exec_library"; +static char init_auto_path[] = "\ +if {$exp_library != \"\"} {\n\ + lappend auto_path $exp_library\n\ +}\n\ +if {$exp_exec_library != \"\"} {\n\ + lappend auto_path $exp_exec_library\n\ +}"; int Expect_Init(interp) Tcl_Interp *interp; { - static int first_time = TRUE; - - if (first_time) { - int tcl_major = atoi(TCL_VERSION); - char *dot = strchr(TCL_VERSION,'.'); - int tcl_minor = atoi(dot+1); - - if (tcl_major < NEED_TCL_MAJOR || - (tcl_major == NEED_TCL_MAJOR && tcl_minor < NEED_TCL_MINOR)) { - sprintf(interp->result, - "%s compiled with Tcl %d.%d but needs at least Tcl %d.%d\n", - exp_argv0,tcl_major,tcl_minor, - NEED_TCL_MAJOR,NEED_TCL_MINOR); - return TCL_ERROR; - } - - if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { - return TCL_ERROR; - } - if (Tcl_PkgProvide(interp, "Expect", EXP_VERSION) != TCL_OK) { - return TCL_ERROR; - } - - exp_getpid = getpid(); - exp_init_pty(); - exp_init_pty_exit(); - exp_init_tty(); /* do this only now that we have looked at */ - /* original tty state */ - exp_init_stdio(); - exp_init_sig(); - exp_init_event(); - exp_init_trap(); - exp_init_unit_random(); - exp_init_spawn_ids(); - - Tcl_CreateExitHandler(exp_exit_handlers,(ClientData)interp); - - first_time = FALSE; - } - - /* save last known interp for emergencies */ - exp_interp = interp; - - /* initialize commands */ - exp_init_most_cmds(interp); /* add misc cmds to interpreter */ - exp_init_expect_cmds(interp); /* add expect cmds to interpreter */ - exp_init_main_cmds(interp); /* add main cmds to interpreter */ - exp_init_trap_cmds(interp); /* add trap cmds to interpreter */ - exp_init_tty_cmds(interp); /* add tty cmds to interpreter */ - exp_init_interact_cmds(interp); /* add interact cmds to interpreter */ - - exp_init_spawn_id_vars(interp); - + static int first_time = TRUE; + + if (first_time) { + int tcl_major = atoi(TCL_VERSION); + char *dot = strchr(TCL_VERSION,'.'); + int tcl_minor = atoi(dot+1); + + if (tcl_major < NEED_TCL_MAJOR || + (tcl_major == NEED_TCL_MAJOR && tcl_minor < NEED_TCL_MINOR)) { + sprintf(interp->result, + "%s compiled with Tcl %d.%d but needs at least Tcl %d.%d\n", + exp_argv0,tcl_major,tcl_minor, + NEED_TCL_MAJOR,NEED_TCL_MINOR); + return TCL_ERROR; + } + } + + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { + return TCL_ERROR; + } + if (Tcl_PkgProvide(interp, "Expect", EXP_VERSION) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_Preserve(interp); + Tcl_CreateExitHandler(Tcl_Release,(ClientData)interp); + + if (first_time) { + exp_getpid = getpid(); + exp_init_pty(); + exp_init_pty_exit(); + exp_init_tty(); /* do this only now that we have looked at */ + /* original tty state */ + exp_init_stdio(); + exp_init_sig(); + exp_init_event(); + exp_init_trap(); + exp_init_unit_random(); + exp_init_spawn_ids(interp); + expChannelInit(); + expDiagInit(); + expLogInit(); + expDiagLogPtrSet(expDiagLogU); + expErrnoMsgSet(Tcl_ErrnoMsg); + + Tcl_CreateExitHandler(exp_exit_handlers,(ClientData)interp); + + first_time = FALSE; + } + + /* save last known interp for emergencies */ + exp_interp = interp; + + /* initialize commands */ + exp_init_most_cmds(interp); /* add misc cmds to interpreter */ + exp_init_expect_cmds(interp); /* add expect cmds to interpreter */ + exp_init_main_cmds(interp); /* add main cmds to interpreter */ + exp_init_trap_cmds(interp); /* add trap cmds to interpreter */ + exp_init_tty_cmds(interp); /* add tty cmds to interpreter */ + exp_init_interact_cmds(interp); /* add interact cmds to interpreter */ + + /* initialize variables */ + exp_init_spawn_id_vars(interp); + expExpectVarsInit(); + + /* + * For each of the the Tcl variables, "expect_library", + *"exp_library", and "exp_exec_library", set the variable + * if it does not already exist. This mechanism allows the + * application calling "Expect_Init()" to set these varaibles + * to alternate locations from where Expect was built. + */ + + if (Tcl_GetVar(interp, "expect_library", TCL_GLOBAL_ONLY) == NULL) { Tcl_SetVar(interp,"expect_library",SCRIPTDIR,0);/* deprecated */ + } + if (Tcl_GetVar(interp, "exp_library", TCL_GLOBAL_ONLY) == NULL) { Tcl_SetVar(interp,"exp_library",SCRIPTDIR,0); + } + if (Tcl_GetVar(interp, "exp_exec_library", TCL_GLOBAL_ONLY) == NULL) { Tcl_SetVar(interp,"exp_exec_library",EXECSCRIPTDIR,0); - Tcl_Eval(interp,init_auto_path); - Tcl_ResetResult(interp); + } + + Tcl_Eval(interp,init_auto_path); + Tcl_ResetResult(interp); #ifdef TCL_DEBUGGER - Dbg_IgnoreFuncs(interp,ignore_procs); + Dbg_IgnoreFuncs(interp,ignore_procs); #endif - return TCL_OK; + return TCL_OK; } static char sigexit_init_default[] = "trap exit {SIGINT SIGTERM}"; static char debug_init_default[] = "trap {exp_debug 1} SIGINT"; @@ -548,11 +604,20 @@ /* after handling args, we can change our mind */ Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY); Tcl_Eval(interp,sigexit_init_default); - while ((c = getopt(argc, argv, "b:c:dD:f:inN-v")) != EOF) { + /* + * [#418892]. The '+' character in front of every other option + * declaration causes 'GNU getopt' to deactivate its + * non-standard behaviour and switch to POSIX. Other + * implementations of 'getopt' might recognize the option '-+' + * because of this, but the following switch will catch this + * and generate a usage message. + */ + + while ((c = getopt(argc, argv, "+b:c:dD:f:inN-v")) != EOF) { switch(c) { case '-': /* getopt already handles -- internally, however */ /* this allows us to abort getopt when dash is at */ /* the end of another option which is required */ @@ -560,23 +625,29 @@ goto abort_getopt; case 'c': /* command */ exp_cmdlinecmds = TRUE; rc = Tcl_Eval(interp,optarg); if (rc != TCL_OK) { - errorlog("%s\r\n",exp_cook(Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY),(int *)0)); + expErrorLogU(exp_cook(Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY),(int *)0)); + expErrorLogU("\r\n"); } break; - case 'd': exp_is_debugging = TRUE; - debuglog("expect version %s\r\n",exp_version); + case 'd': expDiagToStderrSet(TRUE); + expDiagLog("expect version %s\r\n",exp_version); break; #ifdef TCL_DEBUGGER case 'D': exp_tcl_debugger_available = TRUE; if (Tcl_GetInt(interp,optarg,&rc) != TCL_OK) { - errorlog("%s: -D argument must be 0 or 1\r\n", - exp_argv0); - exp_exit(interp,1); + expErrorLog("%s: -D argument must be 0 or 1\r\n",exp_argv0); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } } /* set up trap handler before Dbg_On so user does */ /* not have to see it at first debugger prompt */ if (0 == (debug_init = getenv("EXPECT_DEBUG_INIT"))) { @@ -602,30 +673,52 @@ case 'N': /* don't read system-wide rc file */ sys_rc = FALSE; break; case 'v': printf("expect version %s\n", exp_version); - exp_exit (interp, 0); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 0"; + Tcl_Eval(interp, buffer); + } break; default: usage(interp); } } abort_getopt: for (c = 0;cresult != 0) - errorlog("%s\r\n",interp->result); - exp_exit(interp,1); + expErrorLog("Tcl_Eval = %d\r\n",rc); + if (*interp->result != 0) { + expErrorLogU(interp->result); + expErrorLogU("\r\n"); + } + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } } close(fd); } } if (my_rc) { @@ -719,16 +827,23 @@ if ((NULL != (home = getenv("DOTDIR"))) || (NULL != (home = getenv("HOME")))) { sprintf(file,"%s/.expect.rc",home); if (-1 != (fd = open(file,0))) { if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) { - errorlog("error executing file: %s\r\n",file); + expErrorLog("error executing file: %s\r\n",file); if (rc != TCL_ERROR) - errorlog("Tcl_Eval = %d\r\n",rc); - if (*interp->result != 0) - errorlog("%s\r\n",interp->result); - exp_exit(interp,1); + expErrorLog("Tcl_Eval = %d\r\n",rc); + if (*interp->result != 0) { + expErrorLogU(interp->result); + expErrorLogU("\r\n"); + } + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } } close(fd); } } } @@ -739,11 +854,11 @@ Tcl_Interp *interp; char *filename; { int rc; - debuglog("executing commands from command file %s\r\n",filename); + expDiagLog("executing commands from command file %s\r\n",filename); Tcl_ResetResult(interp); if (TCL_OK != (rc = Tcl_EvalFile(interp,filename))) { /* EvalFile doesn't bother to copy error to errorInfo */ /* so force it */ @@ -757,34 +872,34 @@ exp_interpret_cmdfile(interp,fp) Tcl_Interp *interp; FILE *fp; { int rc = 0; - int newcmd; + int gotPartial; int eof; Tcl_DString dstring; Tcl_DStringInit(&dstring); - debuglog("executing commands from command file\r\n"); + expDiagLogU("executing commands from command file\r\n"); - newcmd = TRUE; + gotPartial = 0; eof = FALSE; while (1) { char line[BUFSIZ];/* buffer for partial Tcl command */ char *ccmd; /* pointer to complete Tcl command */ if (fgets(line,BUFSIZ,fp) == NULL) { - if (newcmd) break; + if (!gotPartial) break; eof = TRUE; } ccmd = Tcl_DStringAppend(&dstring,line,-1); if (!Tcl_CommandComplete(ccmd) && !eof) { - newcmd = FALSE; + gotPartial = 1; continue; /* continue collecting command */ } - newcmd = TRUE; + gotPartial = 0; rc = Tcl_Eval(interp,ccmd); Tcl_DStringFree(&dstring); if (rc != TCL_OK) { handle_eval_error(interp,0); @@ -794,99 +909,17 @@ } Tcl_DStringFree(&dstring); return rc; } -#ifdef SHARE_CMD_BUFFER -/* fgets that shared input buffer with expect_user */ -int -exp_fgets(interp,buf,max) -Tcl_Interp *interp; -char *buf; -int max; -{ - char *nl; /* position of newline which signifies end of line */ - int write_count;/* length of first line of incoming data */ - - int m = fileno(stdin); - struct exp_f *f; - int cc; - - int dummy; - - /* avoid returning no data, just because someone else read it in by */ - /* passing most recent key */ - cc = exp_get_next_event(interp,&m,1,&dummy,EXP_TIME_INFINITY,exp_fs[m].key); - - if (cc == EXP_DATA_NEW) { - /* try to read it */ - - cc = exp_i_read(m,EXP_TIME_INFINITY); - - /* 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) { - f = exp_fs + m; - f->buffer[f->size += cc] = '\0'; - } - } else if (cc == EXP_DATA_OLD) { - f = exp_fs + m; - cc = 0; - } - - /* EOF and TIMEOUT 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); - - /* copy up to end of first line */ - - /* calculate end of first line */ - nl = strchr(f->buffer,'\n'); - if (nl) write_count = 1+nl-f->buffer; - else write_count = f->size; - - /* make sure line fits in buffer area */ - if (write_count > max) write_count = max; - - /* copy it */ - memcpy(buf,f->buffer,write_count); - buf[write_count] = '\0'; - - /* update display and f */ - - f->printed = 0; - /* for simplicity force f->printed = 0. This way, the user gets */ - /* to see the commands that are about to be executed. Not seeing */ - /* commands you are supposedly typing sounds very uncomfortable! */ - - if (logfile_all || (loguser && logfile)) { - fwrite(f->buffer,1,write_count,logfile); - } - if (debugfile) fwrite(f->buffer,1,write_count,debugfile); - - f->size -= write_count; - memcpy(f->buffer,f->buffer+write_count,1+f->size); - /* copy to lowercase buffer */ - exp_lowmemcpy(f->lower,f->buffer,1+f->size); - - return(write_count); -} -#endif /*SHARE_CMD_BUFFER*/ - static struct exp_cmd_data cmd_data[] = { -{"expect_version",exp_proc(Exp_ExpVersionCmd), 0, 0}, /* deprecated */ {"exp_version", exp_proc(Exp_ExpVersionCmd), 0, 0}, -{"prompt1", exp_proc(Exp_Prompt1Cmd), 0, EXP_NOPREFIX}, -{"prompt2", exp_proc(Exp_Prompt2Cmd), 0, EXP_NOPREFIX}, +{"prompt1", exp_proc(Exp_Prompt1Cmd), 0, EXP_NOPREFIX}, +{"prompt2", exp_proc(Exp_Prompt2Cmd), 0, EXP_NOPREFIX}, {0}}; void exp_init_main_cmds(interp) Tcl_Interp *interp; { exp_create_commands(interp,cmd_data); } Index: exp_main_tk.c ================================================================== --- exp_main_tk.c +++ exp_main_tk.c @@ -166,13 +166,14 @@ static int rest = 0; /* for Expect */ int my_rc = 1; int sys_rc = 1; -int optcmd_eval(); +static int optcmd_eval(); +static int optcmd_diagToStderr(); #ifdef TCL_DEBUGGER -int optcmd_debug(); +static int optcmd_debug(); #endif int print_version = 0; static Tk_ArgvInfo argTable[] = { {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap, @@ -190,11 +191,11 @@ {"--", TK_ARGV_REST, (char *) 1, (char *) &rest, "Pass all remaining arguments through to script"}, /* for Expect */ {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0, "Command(s) to execute immediately"}, - {"-diag", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_is_debugging, + {"-diag", TK_ARGV_CONSTANT, (char *) optcmd_diagToStderr, (char *)0, "Enable diagnostics"}, {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc, "Don't read ~/.expect.rc"}, {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc, "Don't read system-wide expect.rc"}, @@ -267,11 +268,17 @@ } if (print_version) { extern char exp_version[]; printf ("expectk version %s\n", exp_version); - exp_exit (interp, 0); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 0"; + Tcl_Eval(interp, buffer); + } } p = Tcl_Merge(argc, argv); Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY); sprintf(buffer, "%d", argc); @@ -370,25 +377,21 @@ /* * Invoke platform-specific initialization. */ -#if TCL_MAJOR_VERSION < 8 - code = TkPlatformInit(interp); -#else code = TkpInit(interp, 0); -#endif done: if (argv != NULL) { ckfree((char *) argv); } return code; } /*ARGSUSED*/ -int +static int optcmd_eval(dst,interp,key,argc,argv) char *dst; Tcl_Interp *interp; char *key; int argc; @@ -407,14 +410,26 @@ argv[i] = argv[i+1]; } return argc; } + +static int +optcmd_diagToStderr(dst,interp,key,argc,argv) + char *dst; + Tcl_Interp *interp; + char *key; + int argc; + char **argv; +{ + expDiagToStderrSet(1); + return --argc; /* what the heck is the convention here!! */ +} #ifdef TCL_DEBUGGER /*ARGSUSED*/ -int +static int optcmd_debug(dst,interp,key,argc,argv) char *dst; Tcl_Interp *interp; char *key; int argc; Index: exp_noevent.c ================================================================== --- exp_noevent.c +++ exp_noevent.c @@ -28,45 +28,45 @@ #include #endif #include "tcl.h" #include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f defs */ +#include "exp_command.h" /* for struct ExpState defs */ #include "exp_event.h" /*ARGSUSED*/ void -exp_arm_background_filehandler(m) -int m; +exp_arm_background_filehandler(esPtr) +ExpState *esPtr; +{ +} + +/*ARGSUSED*/ +void +exp_disarm_background_filehandler(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void -exp_disarm_background_filehandler(m) -int m; +exp_disarm_background_filehandler_force(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void -exp_disarm_background_filehandler_force(m) -int m; +exp_unblock_background_filehandler(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void -exp_unblock_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_block_background_filehandler(m) -int m; +exp_block_background_filehandler(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void @@ -76,46 +76,42 @@ } /* returns status, one of EOF, TIMEOUT, ERROR or DATA */ /*ARGSUSED*/ int -exp_get_next_event(interp,masters, n,master_out,timeout,key) +exp_get_next_event(interp,esPtrs, n,esPtrOut,timeout,key) Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 1st event master, not set if none */ +ExpState (*esPtrs)[]; +int n; /* # of esPtrs */ +ExpState **esPtrOut; /* 1st event master, not set if none */ int timeout; /* seconds */ int key; { - int m; - struct exp_f *f; - - if (n > 1) { - exp_error(interp,"expect not compiled with multiprocess support"); - /* select a different INTERACT_TYPE in Makefile */ - return(TCL_ERROR); - } - - m = *master_out = masters[0]; - f = exp_fs + m; - - if (f->key != key) { - f->key = key; - f->force_read = FALSE; - return(EXP_DATA_OLD); - } else if ((!f->force_read) && (f->size != 0)) { - return(EXP_DATA_OLD); - } - - return(EXP_DATA_NEW); + if (n > 1) { + exp_error(interp,"expect not compiled with multiprocess support"); + /* select a different INTERACT_TYPE in Makefile */ + return(TCL_ERROR); + } + + esPtr = *esPtrOut = esPtrs[0]; + + if (esPtr->key != key) { + esPtr->key = key; + esPtr->force_read = FALSE; + return(EXP_DATA_OLD); + } else if ((!esPtr->force_read) && (esPtr->size != 0)) { + return(EXP_DATA_OLD); + } + + return(EXP_DATA_NEW); } /*ARGSUSED*/ int -exp_get_next_event_info(interp,fd,ready_mask) +exp_get_next_event_info(interp,esPtr,ready_mask) Tcl_Interp *interp; -int fd; +ExpState *esPtr; int ready_mask; { } /* There is no portable way to do sub-second sleeps on such a system, so */ Index: exp_poll.c ================================================================== --- exp_poll.c +++ exp_poll.c @@ -31,12 +31,10 @@ static struct pollfd initialFdArray; static struct pollfd *fdArray = &initialFdArray; static int fdsInUse = 0; /* space in use */ static int fdsMaxSpace = 1; /* space that has actually been allocated */ -#if TCL_MAJOR_VERSION >= 8 - /* * tclUnixNotify.c -- * * This file contains the implementation of the select-based * Unix-specific notifier, which is the lowest-level part of the @@ -249,41 +247,10 @@ filePtr->nextPtr = notifier.firstFileHandlerPtr; notifier.firstFileHandlerPtr = filePtr; } filePtr->proc = proc; filePtr->clientData = clientData; -#if NOTUSED - /* remaining junk is left over from select implementation - DEL */ - - filePtr->mask = mask; - - /* - * Update the check masks for this file. - */ - - index = fd/(NBBY*sizeof(fd_mask)); - bit = 1 << (fd%(NBBY*sizeof(fd_mask))); - if (mask & TCL_READABLE) { - notifier.checkMasks[index] |= bit; - } else { - notifier.checkMasks[index] &= ~bit; - } - if (mask & TCL_WRITABLE) { - (notifier.checkMasks+MASK_SIZE)[index] |= bit; - } else { - (notifier.checkMasks+MASK_SIZE)[index] &= ~bit; - } - if (mask & TCL_EXCEPTION) { - (notifier.checkMasks+2*(MASK_SIZE))[index] |= bit; - } else { - (notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit; - } - if (notifier.numFdBits <= fd) { - notifier.numFdBits = fd+1; - } -#endif /* notused */ - filePtr->pollArrayIndex = fdsInUse; cur_fd_index = fdsInUse; fdsInUse++; if (fdsInUse > fdsMaxSpace) { @@ -351,52 +318,10 @@ if (filePtr->fd == fd) { break; } } -#if NOTUSED - /* remaining junk is left over from select implementation - DEL */ - - /* - * Update the check masks for this file. - */ - - index = fd/(NBBY*sizeof(fd_mask)); - bit = 1 << (fd%(NBBY*sizeof(fd_mask))); - - if (filePtr->mask & TCL_READABLE) { - notifier.checkMasks[index] &= ~bit; - } - if (filePtr->mask & TCL_WRITABLE) { - (notifier.checkMasks+MASK_SIZE)[index] &= ~bit; - } - if (filePtr->mask & TCL_EXCEPTION) { - (notifier.checkMasks+2*(MASK_SIZE))[index] &= ~bit; - } - - /* - * Find current max fd. - */ - - if (fd+1 == notifier.numFdBits) { - for (notifier.numFdBits = 0; index >= 0; index--) { - mask = notifier.checkMasks[index] - | (notifier.checkMasks+MASK_SIZE)[index] - | (notifier.checkMasks+2*(MASK_SIZE))[index]; - if (mask) { - for (i = (NBBY*sizeof(fd_mask)); i > 0; i--) { - if (mask & (1 << (i-1))) { - break; - } - } - notifier.numFdBits = index * (NBBY*sizeof(fd_mask)) + i; - break; - } - } - } -#endif /* notused */ - /* * Clean up information in the callback record. */ if (prevPtr == NULL) { @@ -527,13 +452,10 @@ Tcl_WaitForEvent(timePtr) Tcl_Time *timePtr; /* Maximum block time, or NULL. */ { FileHandler *filePtr; FileHandlerEvent *fileEvPtr; -#if 0 - struct timeval timeout, *timeoutPtr; -#endif int timeout; struct timeval *timeoutPtr; int bit, index, mask, numFound; @@ -546,41 +468,19 @@ * check for, we return with a negative result rather than blocking * forever. */ if (timePtr) { -#if 0 - timeout.tv_sec = timePtr->sec; - timeout.tv_usec = timePtr->usec; - timeoutPtr = &timeout; -#endif timeout = timePtr->sec*1000 + timePtr->usec/1000; } else if (notifier.numFdBits == 0) { return -1; } else { timeoutPtr = NULL; } numFound = poll(fdArray,fdsInUse,timeout); -#if 0 - memcpy((VOID *) notifier.readyMasks, (VOID *) notifier.checkMasks, - 3*MASK_SIZE*sizeof(fd_mask)); - numFound = select(notifier.numFdBits, - (SELECT_MASK *) ¬ifier.readyMasks[0], - (SELECT_MASK *) ¬ifier.readyMasks[MASK_SIZE], - (SELECT_MASK *) ¬ifier.readyMasks[2*MASK_SIZE], timeoutPtr); - - /* - * Some systems don't clear the masks after an error, so - * we have to do it here. - */ - - if (numFound == -1) { - memset((VOID *) notifier.readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); - } -#endif /* * Queue all detected file events before returning. */ @@ -599,26 +499,10 @@ /* I have no idea if this is right ... */ if (fdArray[index].revents & (POLLPRI|POLLERR|POLLHUP|POLLNVAL)) { mask |= TCL_EXCEPTION; } -#if 0 - index = filePtr->fd / (NBBY*sizeof(fd_mask)); - bit = 1 << (filePtr->fd % (NBBY*sizeof(fd_mask))); - mask = 0; - - if (notifier.readyMasks[index] & bit) { - mask |= TCL_READABLE; - } - if ((notifier.readyMasks+MASK_SIZE)[index] & bit) { - mask |= TCL_WRITABLE; - } - if ((notifier.readyMasks+2*(MASK_SIZE))[index] & bit) { - mask |= TCL_EXCEPTION; - } -#endif - if (!mask) { continue; } else { numFound--; } @@ -638,243 +522,5 @@ filePtr->readyMask = mask; } return 0; } -#else /* TCL_MAJOR_VERSION < 8 */ - -/* - *---------------------------------------------------------------------- - * - * Tcl_WatchFile -- - * - * Arrange for Tcl_DoOneEvent to include this file in the masks - * for the next call to select. This procedure is invoked by - * event sources, which are in turn invoked by Tcl_DoOneEvent - * before it invokes select. - * - * Results: - * None. - * - * Side effects: - * - * The notifier will generate a file event when the I/O channel - * given by fd next becomes ready in the way indicated by mask. - * If fd is already registered then the old mask will be replaced - * with the new one. Once the event is sent, the notifier will - * not send any more events about the fd until the next call to - * Tcl_NotifyFile. - * - * Assumption for poll implementation: Tcl_WatchFile is presumed NOT - * to be called on the same file descriptior without intervening calls - * to Tcl_DoOneEvent. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_WatchFile(file, mask) - Tcl_File file; /* Generic file handle for a stream. */ - int mask; /* OR'ed combination of TCL_READABLE, - * TCL_WRITABLE, and TCL_EXCEPTION: - * indicates conditions to wait for - * in select. */ -{ - int fd, type; - int cur_fd_index = fdsInUse; - - fd = (int) Tcl_GetFileInfo(file, &type); - - if (type != TCL_UNIX_FD) { - panic("Tcl_WatchFile: unexpected file type"); - } - - fdsInUse++; - if (fdsInUse > fdsMaxSpace) { - if (fdArray != &initialFdArray) ckfree((char *)fdArray); - fdArray = (struct pollfd *)ckalloc(fdsInUse*sizeof(struct pollfd)); - fdsMaxSpace = fdsInUse; - } - - fdArray[cur_fd_index].fd = fd; - - /* I know that POLLIN/OUT is right. But I have no idea if POLLPRI - * corresponds well to TCL_EXCEPTION. - */ - - if (mask & TCL_READABLE) { - fdArray[cur_fd_index].events = POLLIN; - } - if (mask & TCL_WRITABLE) { - fdArray[cur_fd_index].events = POLLOUT; - } - if (mask & TCL_EXCEPTION) { - fdArray[cur_fd_index].events = POLLPRI; - } -} - - -/* - *---------------------------------------------------------------------- - * - * Tcl_FileReady -- - * - * Indicates what conditions (readable, writable, etc.) were - * present on a file the last time the notifier invoked select. - * This procedure is typically invoked by event sources to see - * if they should queue events. - * - * Results: - * The return value is 0 if none of the conditions specified by mask - * was true for fd the last time the system checked. If any of the - * conditions were true, then the return value is a mask of those - * that were true. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_FileReady(file, mask) - Tcl_File file; /* Generic file handle for a stream. */ - int mask; /* OR'ed combination of TCL_READABLE, - * TCL_WRITABLE, and TCL_EXCEPTION: - * indicates conditions caller cares about. */ -{ - int index, result, type, fd; - fd_mask bit; - - fd = (int) Tcl_GetFileInfo(file, &type); - if (type != TCL_UNIX_FD) { - panic("Tcl_FileReady: unexpected file type"); - } - - result = 0; - if ((mask & TCL_READABLE) && (fdArray[fd].revents & POLLIN)) { - result |= TCL_READABLE; - } - if ((mask & TCL_WRITABLE) && (fdArray[fd].revents & POLLOUT)) { - result |= TCL_WRITABLE; - } - /* I have no idea if this is right ... */ - if ((mask & TCL_EXCEPTION) && - (fdArray[fd].revents & (POLLPRI|POLLERR|POLLHUP|POLLNVAL))) { - result |= TCL_EXCEPTION; - } - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_WaitForEvent -- - * - * This procedure does the lowest level wait for events in a - * platform-specific manner. It uses information provided by - * previous calls to Tcl_WatchFile, plus the timePtr argument, - * to determine what to wait for and how long to wait. - * - * Results: - * 7.6 The return value is normally TCL_OK. However, if there are - * no events to wait for (e.g. no files and no timers) so that - * the procedure would block forever, then it returns TCL_ERROR. - * - * Side effects: - * May put the process to sleep for a while, depending on timePtr. - * When this procedure returns, an event of interest to the application - * has probably, but not necessarily, occurred. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_WaitForEvent(timePtr) - Tcl_Time *timePtr; /* Specifies the maximum amount of time - * that this procedure should block before - * returning. The time is given as an - * interval, not an absolute wakeup time. - * NULL means block forever. */ -{ - int timeout; - struct timeval *timeoutPtr; - - /* no need to clear revents */ - if (timePtr == NULL) { - if (!fdsInUse) return (TCL_ERROR); - timeout = -1; - } else { - timeout = timePtr->sec*1000 + timePtr->usec/1000; - } - - poll(fdArray,fdsInUse,timeout); - - fdsInUse = 0; - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_Sleep -- - * - * Delay execution for the specified number of milliseconds. - * - * Results: - * None. - * - * Side effects: - * Time passes. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_Sleep(ms) - int ms; /* Number of milliseconds to sleep. */ -{ - static struct timeval delay; - Tcl_Time before, after; - - /* - * The only trick here is that select appears to return early - * under some conditions, so we have to check to make sure that - * the right amount of time really has elapsed. If it's too - * early, go back to sleep again. - */ - - TclGetTime(&before); - after = before; - after.sec += ms/1000; - after.usec += (ms%1000)*1000; - if (after.usec > 1000000) { - after.usec -= 1000000; - after.sec += 1; - } - while (1) { - delay.tv_sec = after.sec - before.sec; - delay.tv_usec = after.usec - before.usec; - if (delay.tv_usec < 0) { - delay.tv_usec += 1000000; - delay.tv_sec -= 1; - } - - /* - * Special note: must convert delay.tv_sec to int before comparing - * to zero, since delay.tv_usec is unsigned on some platforms. - */ - - if ((((int) delay.tv_sec) < 0) - || ((delay.tv_usec == 0) && (delay.tv_sec == 0))) { - break; - } - - /* poll understands milliseconds, sigh */ - poll(fdArray,0,delay.tv_sec*1000 + delay.tv_usec/1000); - TclGetTime(&before); - } -} - -#endif /* TCL_MAJOR_VERSION < 8 */ - DELETED exp_printify.c Index: exp_printify.c ================================================================== --- exp_printify.c +++ /dev/null @@ -1,56 +0,0 @@ -/* exp_printify - printable versions of random ASCII strings - -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 "expect_cf.h" -#include "tcl.h" -#ifdef NO_STDLIB_H -#include "../compat/stdlib.h" -#else -#include /* for malloc */ -#endif -#include - -/* generate printable versions of random ASCII strings. Primarily used */ -/* by cmdExpect when -d forces it to print strings it is examining. */ -char * -exp_printify(s) -char *s; -{ - static int destlen = 0; - static char *dest = 0; - char *d; /* ptr into dest */ - unsigned int need; - - if (s == 0) return(""); - - /* worst case is every character takes 4 to printify */ - need = strlen(s)*4 + 1; - if (need > destlen) { - if (dest) ckfree(dest); - dest = ckalloc(need); - destlen = need; - } - - for (d = dest;*s;s++) { - if (*s == '\r') { - strcpy(d,"\\r"); d += 2; - } else if (*s == '\n') { - strcpy(d,"\\n"); d += 2; - } else if (*s == '\t') { - strcpy(d,"\\t"); d += 2; - } else if (isascii(*s) && isprint(*s)) { - *d = *s; d += 1; - } else { - sprintf(d,"\\x%02x",*s & 0xff); d += 4; - } - } - *d = '\0'; - return(dest); -} DELETED exp_printify.h Index: exp_printify.h ================================================================== --- exp_printify.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef __EXP_PRINTIFY_H__ -#define __EXP_PRINTIFY_H__ - -char *exp_printify(); - -#endif /* __EXP_PRINTIFY_H__ */ Index: exp_pty.c ================================================================== --- exp_pty.c +++ exp_pty.c @@ -32,18 +32,23 @@ #endif #include #include #include -#define EXP_AVOID_INCLUDING_TCL_H 1 +#include "tcl.h" +#include "exp_int.h" #include "expect_comm.h" #include "exp_rename.h" #include "exp_pty.h" #include -void debuglog(); +#if 0 +void expDiagLog(); +void expDiagLogU(); +void expDiagLogPtrSet(); +#endif #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif @@ -59,11 +64,16 @@ static char locksrc[50] = "/tmp/expect.pid"; /* pid is replaced by real pid */ /* locksrc is used as the link source, i.e., something to link from */ 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 HAVE_SIGLONGJMP +static sigjmp_buf env; /* for interruptable read() */ +#else static jmp_buf env; /* for interruptable read() */ +#endif /* HAVE_SIGLONGJMP */ + static int env_valid = FALSE; /* whether we can longjmp or not */ /* sigalarm_handler and i_read are here just for supporting the sanity */ /* checking of pty slave devices. I have only seen this happen on BSD */ /* systems, but it may need to be done to the other pty implementations */ @@ -82,11 +92,15 @@ signal(SIGALRM,sigalarm_handler); #endif /* check env_valid first to protect us from the alarm occurring */ /* in the window between i_read and alarm(0) */ +#ifdef HAVE_SIGLONGJMP + if (env_valid) siglongjmp(env,1); +#else if (env_valid) longjmp(env,1); +#endif /* HAVE_SIGLONGJMP */ } /* interruptable read */ static int i_read(fd,buffer,length,timeout) @@ -103,11 +117,15 @@ /* restart read if setjmp returns 0 (first time) or 2. */ /* abort if setjmp returns 1. */ alarm(timeout); +#ifdef HAVE_SIGLONGJMP + if (1 != sigsetjmp(env,1)) { +#else if (1 != setjmp(env)) { +#endif /* HAVE_SIGLONGJMP */ env_valid = TRUE; cc = read(fd,buffer,length); } env_valid = FALSE; i_read_errno = errno; /* errno can be overwritten by the */ @@ -140,11 +158,15 @@ /* recreate locksrc to prevent locks from 'looking old', so */ /* that they are not deleted (later on in this code) */ sprintf(locksrc,"/tmp/expect.%d",getpid()); (void) unlink(locksrc); - if (-1 == (lfd = creat(locksrc,0777))) { + /* stanislav shalunov notes that creat allows */ + /* race - someone could link to important file which root could then */ + /* smash. */ +/* if (-1 == (lfd = creat(locksrc,0777))) { */ + if (-1 == (lfd = open(locksrc,O_RDWR|O_CREAT|O_EXCL,0777))) { static char buf[256]; exp_pty_error = buf; sprintf(exp_pty_error,"can't create %s, errno = %d\n",locksrc, errno); return(-1); } @@ -165,11 +187,11 @@ /* returns non-negative if successful */ int exp_pty_test(master_name,slave_name,bank,num) char *master_name; char *slave_name; -int bank; +char bank; char *num; /* string representation of number */ { int master, slave; int cc; char c; @@ -177,11 +199,11 @@ /* make a lock file to prevent others (for now only */ /* expects) from allocating pty while we are playing */ /* with it. This allows us to rigorously test the */ /* pty is usable. */ if (exp_pty_lock(bank,num) == 0) { - debuglog("pty master (%s) is locked...skipping\r\n",master_name); + expDiagLogPtrStr("pty master (%s) is locked...skipping\r\n",master_name); return(-1); } /* verify no one else is using slave by attempting */ /* to read eof from master side */ if (0 > (master = open(master_name,RDWR))) return(-1); @@ -194,11 +216,11 @@ if (1) return master; #endif #ifdef HAVE_PTYTRAP if (access(slave_name, R_OK|W_OK) != 0) { - debuglog("could not open slave for pty master (%s)...skipping\r\n", + expDiagLogPtrStr("could not open slave for pty master (%s)...skipping\r\n", master_name); (void) close(master); return -1; } return(master); @@ -209,11 +231,11 @@ } (void) close(slave); cc = i_read(master,&c,1,10); (void) close(master); if (!(cc == 0 || cc == -1)) { - debuglog("%s slave open, skipping\r\n",slave_name); + expDiagLogPtrStr("%s slave open, skipping\r\n",slave_name); locked = FALSE; /* leave lock file around so Expect's avoid */ /* retrying this pty for near future */ return -1; } @@ -226,16 +248,16 @@ } (void) close(master); cc = i_read(slave,&c,1,10); (void) close(slave); if (!(cc == 0 || cc == -1)) { - debuglog("%s master open, skipping\r\n",master_name); + expDiagLogPtrStr("%s master open, skipping\r\n",master_name); return -1; } /* seems ok, let's use it */ - debuglog("using master pty %s\n",master_name); + expDiagLogPtrStr("using master pty %s\n",master_name); return(open(master_name,RDWR)); #endif } void @@ -248,11 +270,11 @@ } /* returns 1 if successfully locked, 0 otherwise */ int exp_pty_lock(bank,num) -int bank; +char bank; char *num; /* string representation of number */ { struct stat statbuf; if (locked) { @@ -271,5 +293,76 @@ else locked = TRUE; return locked; } +/* + * expDiagLog needs a different definition, depending on whether its + * called inside of Expect or the clib. Allow it to be set using this + * function. It's done here because this file (and pty_XXX.c) are the + * ones that call expDiagLog from the two different environments. + */ + +static void (*expDiagLogPtrVal) _ANSI_ARGS_((char *)); + +void +expDiagLogPtrSet(fn) + void (*fn) _ANSI_ARGS_((char *)); +{ + expDiagLogPtrVal = fn; +} + +void +expDiagLogPtr(str) + char *str; +{ + (*expDiagLogPtrVal)(str); +} + + + +void +expDiagLogPtrX(fmt,num) + char *fmt; + int num; +{ + static char buf[1000]; + sprintf(buf,fmt,num); + (*expDiagLogPtrVal)(buf); +} + + +void +expDiagLogPtrStr(fmt,str1) + char *fmt; + char *str1; +{ + static char buf[1000]; + sprintf(buf,fmt,str1); + (*expDiagLogPtrVal)(buf); +} + +void +expDiagLogPtrStrStr(fmt,str1,str2) + char *fmt; + char *str1, *str2; +{ + static char buf[1000]; + sprintf(buf,fmt,str1,str2); + (*expDiagLogPtrVal)(buf); +} + +static char * (*expErrnoMsgVal) _ANSI_ARGS_((int)); + +char * +expErrnoMsg(errorNo) +int errorNo; +{ + return (*expErrnoMsgVal)(errorNo); +} + +void +expErrnoMsgSet(fn) + char * (*fn) _ANSI_ARGS_((int)); +{ + expErrnoMsgVal = fn; +} Index: exp_regexp.c ================================================================== --- exp_regexp.c +++ exp_regexp.c @@ -1,5 +1,7 @@ +#if 0 /*WHOLE FILE*/ + /* * regcomp and regexec -- regsub and regerror are elsewhere * * Copyright (c) 1986 by University of Toronto. * Written by Henry Spencer. Not derived from licensed software. @@ -951,10 +953,12 @@ register int no; register char *save; register int min; int match_status; + if (*reginput == '\0') return EXP_CANMATCH; + /* * Lookahead to avoid useless match attempts * when we know what character comes next. */ match_status = EXP_CANTMATCH; @@ -970,11 +974,12 @@ if (nextch == '\0' || *reginput == nextch || *reginput == '\0') { int r = regmatch(next); if (r == EXP_MATCH) return(EXP_MATCH); if (r == EXP_CANMATCH) - match_status = r; +/* match_status = r;*/ + return(EXP_CANMATCH); } /* Couldn't or didn't -- back up. */ no--; reginput = save + no; } @@ -981,11 +986,17 @@ return(match_status); } /* NOTREACHED */ break; case END: - return(EXP_MATCH); /* Success! */ + /* Success! */ + if (*reginput == '\0') { + return(EXP_CANMATCH); + } else { + return(EXP_MATCH); + } + /* return(EXP_CANMATCH); Success! */ /* NOTREACHED */ break; default: if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) { goto doOpen; @@ -1249,5 +1260,6 @@ count++; } return(count); } #endif +#endif /* 0 WHOLE FILE */ Index: exp_regexp.h ================================================================== --- exp_regexp.h +++ exp_regexp.h @@ -1,8 +1,10 @@ +#if 0 /* WHOLE FILE */ /* access to regexp internals */ #define regbol exp_regbol #define regtry exp_regtry #define regexec exp_regexec #define regerror TclRegError extern char *regbol; int regtry(); +#endif /*0 WHOLE FILE */ Index: exp_rename.h ================================================================== --- exp_rename.h +++ exp_rename.h @@ -1,22 +1,11 @@ -/* translate.h - preface globals that appear in the expect library -with "exp_" so we don't conflict with the user. This saves me having -to use exp_XXX throughout the expect program itself, which was written -well before the library when I didn't have to worry about name conflicts. +/* exp_rename.h - preface globals that appear in the expect library with "exp_" +so we don't conflict with the user. This saves me having to use exp_XXX +throughout the expect program itself, which was written well before the library +when I didn't have to worry about name conflicts. Written by: Don Libes, NIST, 12/3/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. -*/ - -#define errorlog exp_errorlog -#define debuglog exp_debuglog -#define is_debugging exp_is_debugging -#define logfile exp_logfile -#define debugfile exp_debugfile -#define loguser exp_loguser -#define logfile_all exp_logfile_all - -#define getptymaster exp_getptymaster -#define getptyslave exp_getptyslave +would appreciate credit if this program or parts of it are used. */ + Index: exp_select.c ================================================================== --- exp_select.c +++ exp_select.c @@ -190,20 +190,20 @@ *master_out = masters[rr]; return(EXP_EOF); #else struct request_info ioctl_info; if (ioctl(masters[rr],TIOCREQCHECK,&ioctl_info) < 0) { - exp_debuglog("ioctl error on TIOCREQCHECK: %s",Tcl_ErrnoMsg(errno)); + exp_DiagLog("ioctl error on TIOCREQCHECK: %s",Tcl_ErrnoMsg(errno)); break; } if (ioctl_info.request == TIOCCLOSE) { /* eof */ *master_out = masters[rr]; return(EXP_EOF); } if (ioctl(masters[rr], TIOCREQSET, &ioctl_info) < 0) - exp_debuglog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno)); + expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno)); /* presumably, we trapped an open here */ goto restart; #endif /* HAVE_PTYTRAP */ } } Index: exp_simple.c ================================================================== --- exp_simple.c +++ exp_simple.c @@ -313,45 +313,45 @@ #include #endif #include "tcl.h" #include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f defs */ +#include "exp_command.h" /* for struct ExpState defs */ #include "exp_event.h" + +/*ARGSUSED*/ +void +exp_arm_background_channelhandler(esPtr) +ExpState *esPtr; +{ +} /*ARGSUSED*/ void -exp_arm_background_filehandler(m) -int m; +exp_disarm_background_channelhandler(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void -exp_disarm_background_filehandler(m) -int m; +exp_disarm_background_channelhandler_force(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void -exp_disarm_background_filehandler_force(m) -int m; +exp_unblock_background_channelhandler(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void -exp_unblock_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_block_background_filehandler(m) -int m; +exp_block_background_channelhandler(esPtr) +ExpState *esPtr; { } /*ARGSUSED*/ void @@ -361,46 +361,44 @@ } /* returns status, one of EOF, TIMEOUT, ERROR or DATA */ /*ARGSUSED*/ int -exp_get_next_event(interp,masters, n,master_out,timeout,key) +exp_get_next_event(interp,esPtrs, n,esPtrOut,timeout,key) Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 1st event master, not set if none */ +ExpState (*esPtrs)[]; +int n; /* # of esPtrs */ +ExpState **esPtrOut; /* 1st event master, not set if none */ int timeout; /* seconds */ int key; { - int m; - struct exp_f *f; - - if (n > 1) { - exp_error(interp,"expect not compiled with multiprocess support"); - /* select a different INTERACT_TYPE in Makefile */ - return(TCL_ERROR); - } - - m = *master_out = masters[0]; - f = exp_fs + m; - - if (f->key != key) { - f->key = key; - f->force_read = FALSE; - return(EXP_DATA_OLD); - } else if ((!f->force_read) && (f->size != 0)) { - return(EXP_DATA_OLD); - } - - return(EXP_DATA_NEW); + ExpState *esPtr; + + if (n > 1) { + exp_error(interp,"expect not compiled with multiprocess support"); + /* select a different INTERACT_TYPE in Makefile */ + return(TCL_ERROR); + } + + esPtr = *esPtrOut = esPtrs[0]; + + if (esPtr->key != key) { + esPtr->key = key; + esPtr->force_read = FALSE; + return(EXP_DATA_OLD); + } else if ((!esPtr->force_read) && (esPtr->size != 0)) { + return(EXP_DATA_OLD); + } + + return(EXP_DATA_NEW); } /*ARGSUSED*/ int -exp_get_next_event_info(interp,fd,ready_mask) +exp_get_next_event_info(interp,esPtr,ready_mask) Tcl_Interp *interp; -int fd; +ExpState *esPtr; int ready_mask; { } /* There is no portable way to do sub-second sleeps on such a system, so */ Index: exp_strf.c ================================================================== --- exp_strf.c +++ exp_strf.c @@ -96,12 +96,16 @@ extern char *getenv(); static int weeknumber(); adddecl(static int iso8601wknum();) #else +#ifndef strchr extern char *strchr(const char *str, int ch); +#endif + extern char *getenv(const char *v); + static int weeknumber(const struct tm *timeptr, int firstweekday); adddecl(static int iso8601wknum(const struct tm *timeptr);) #endif /* attempt to use strftime to compute timezone, else fallback to */ @@ -491,11 +495,11 @@ * * XPG4 erroneously included POSIX.2 rationale text in the * main body of the standard. Thus it requires week 53. */ - int weeknum, jan1day, diff; + int weeknum, jan1day; /* get week number, Monday as first day of the week */ weeknum = weeknumber(timeptr, 1); /* Index: exp_trap.c ================================================================== --- exp_trap.c +++ exp_trap.c @@ -85,16 +85,15 @@ { struct trap *trap; /* last trap processed */ int rc; int i; Tcl_Interp *sig_interp; -/* extern Tcl_Interp *exp_interp;*/ - exp_debuglog("sighandler: handling signal(%d)\r\n",got_sig); + expDiagLog("sighandler: handling signal(%d)\r\n",got_sig); if (got_sig <= 0 || got_sig >= NSIG) { - errorlog("caught impossible signal %d\r\n",got_sig); + expErrorLog("caught impossible signal %d\r\n",got_sig); abort(); } /* start to work on this sig. got_sig can now be overwritten */ /* and it won't cause a problem */ @@ -105,19 +104,19 @@ /* decrement below looks dangerous */ /* Don't we need to temporarily block bottomhalf? */ if (current_sig == SIGCHLD) { sigchld_count--; - exp_debuglog("sigchld_count-- == %d\n",sigchld_count); + expDiagLog("sigchld_count-- == %d\n",sigchld_count); } if (!trap->action) { /* In this one case, we let ourselves be called when no */ /* signaler predefined, since we are calling explicitly */ /* from another part of the program, and it is just simpler */ if (current_sig == 0) return code; - errorlog("caught unexpected signal: %s (%d)\r\n", + expErrorLog("caught unexpected signal: %s (%d)\r\n", signal_to_string(current_sig),current_sig); abort(); } if (trap->interp) { @@ -157,11 +156,11 @@ } #ifdef REARM_SIG int sigchld_sleep; static int rearm_sigchld = FALSE; /* TRUE if sigchld needs to be */ - /* rearmed (i.e., because it has + /* rearmed (i.e., because it has */ /* just gone off) */ static int rearming_sigchld = FALSE; #endif /* called upon receipt of a user-declared signal */ @@ -196,16 +195,19 @@ /* In case of SIGCHLD though, we must recall it as many times as * we have received it. */ if (sig == SIGCHLD) { sigchld_count++; -/* exp_debuglog(stderr,"sigchld_count++ == %d\n",sigchld_count);*/ } #if 0 /* if we are doing an i_read, restart it */ - if (env_valid && (sig != 0)) longjmp(env,2); -#endif +#ifdef HAVE_SIGLONGJMP + if (env_valid && (sig != 0)) siglongjmp(env,2); +#else + if (env_valid && (sig != 0)) longjmp(env,2); +#endif /* HAVE_SIGLONGJMP */ +#endif /* 0 */ } /*ARGSUSED*/ void exp_rearm_sigchld(interp) @@ -290,19 +292,20 @@ return -1; } /*ARGSUSED*/ int -Exp_TrapCmd(clientData, interp, argc, argv) +Exp_TrapObjCmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; -int argc; -char **argv; +int objc; +Tcl_Obj *CONST objv[]; { char *action = 0; int n; /* number of signals in list */ - char **list; /* list of signals */ + Tcl_Obj **list; /* list of signals */ + char *arg; int len; /* length of action */ int i; int show_name = FALSE; /* if user asked for current sig by name */ int show_number = FALSE;/* if user asked for current sig by number */ int show_max = FALSE; /* if user asked for NSIG-1 */ @@ -309,75 +312,80 @@ int rc = TCL_OK; int new_code = FALSE; /* if action result should overwrite orig */ Tcl_Interp *new_interp = interp;/* interp in which to evaluate */ /* action when signal occurs */ - argc--; argv++; + objc--; objv++; + + while (objc) { + arg = Tcl_GetString(*objv); - while (*argv) { - if (streq(*argv,"-code")) { - argc--; argv++; + if (streq(arg,"-code")) { + objc--; objv++; new_code = TRUE; - } else if (streq(*argv,"-interp")) { - argc--; argv++; + } else if (streq(arg,"-interp")) { + objc--; objv++; new_interp = 0; - } else if (streq(*argv,"-name")) { - argc--; argv++; + } else if (streq(arg,"-name")) { + objc--; objv++; show_name = TRUE; - } else if (streq(*argv,"-number")) { - argc--; argv++; + } else if (streq(arg,"-number")) { + objc--; objv++; show_number = TRUE; - } else if (streq(*argv,"-max")) { - argc--; argv++; + } else if (streq(arg,"-max")) { + objc--; objv++; show_max = TRUE; } else break; } if (show_name || show_number || show_max) { - if (argc > 0) goto usage_error; - if (show_max) { - sprintf(interp->result,"%d",NSIG-1); - return TCL_OK; - } - - if (current_sig == NO_SIG) { - exp_error(interp,"no signal in progress"); - return TCL_ERROR; - } - if (show_name) { - /* skip over "SIG" */ - interp->result = signal_to_string(current_sig) + 3; - } else { - sprintf(interp->result,"%d",current_sig); - } - return TCL_OK; - } - - if (argc == 0 || argc > 2) goto usage_error; - - if (argc == 1) { - int sig = exp_string_to_signal(interp,*argv); - if (sig == -1) return TCL_ERROR; - - if (traps[sig].action) { - Tcl_AppendResult(interp,traps[sig].action,(char *)0); - } else { - interp->result = "SIG_DFL"; - } - return TCL_OK; - } - - action = *argv; - - /* argv[1] is the list of signals - crack it open */ - if (TCL_OK != Tcl_SplitList(interp,argv[1],&n,&list)) { - errorlog("%s\r\n",interp->result); - goto usage_error; - } - - for (i=0;i 0) goto usage_error; + if (show_max) { + Tcl_SetObjResult(interp,Tcl_NewIntObj(NSIG-1)); + } + + if (current_sig == NO_SIG) { + Tcl_SetResult(interp,"no signal in progress",TCL_STATIC); + return TCL_ERROR; + } + if (show_name) { + /* skip over "SIG" */ + Tcl_SetResult(interp,signal_to_string(current_sig) + 3,TCL_STATIC); + } else { + Tcl_SetObjResult(interp,Tcl_NewIntObj(current_sig)); + } + return TCL_OK; + } + + if (objc == 0 || objc > 2) goto usage_error; + + if (objc == 1) { + int sig = exp_string_to_signal(interp,arg); + if (sig == -1) return TCL_ERROR; + + if (traps[sig].action) { + Tcl_SetResult(interp,traps[sig].action,TCL_STATIC); + } else { + Tcl_SetResult(interp,"SIG_DFL",TCL_STATIC); + } + return TCL_OK; + } + + action = arg; + + /* objv[1] is the list of signals - crack it open */ + if (TCL_OK != Tcl_ListObjGetElements(interp,objv[1],&n,&list)) { + return TCL_ERROR; + } + + for (i=0;iresult */ + Tcl_Obj *eip; /* errorInfo */ + Tcl_Obj *ecp; /* errorCode */ + Tcl_Obj *irp; /* interp->result */ - exp_debuglog("async event handler: Tcl_Eval(%s)\r\n",trap->action); + expDiagLogU("async event handler: Tcl_Eval("); + expDiagLogU(trap->action); + expDiagLogU(")\r\n"); /* save to prevent user from redefining trap->code while trap */ /* is executing */ code_flag = trap->code; if (!code_flag) { /* * save return values */ - eip = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY); - if (eip) { - Tcl_DStringInit(&ei); - eip = Tcl_DStringAppend(&ei,eip,-1); - } - ecp = Tcl_GetVar(interp,"errorCode",TCL_GLOBAL_ONLY); - if (ecp) { - Tcl_DStringInit(&ec); - ecp = Tcl_DStringAppend(&ec,ecp,-1); - } - /* I assume interp->result is always non-zero, right? */ - Tcl_DStringInit(&ir); - Tcl_DStringAppend(&ir,interp->result,-1); + + eip = Tcl_GetVar2Ex(interp,"errorInfo","",TCL_GLOBAL_ONLY); + if (eip) eip = Tcl_DuplicateObj(eip); + ecp = Tcl_GetVar2Ex(interp,"errorCode","",TCL_GLOBAL_ONLY); + if (ecp) ecp = Tcl_DuplicateObj(ecp); + irp = Tcl_GetObjResult(interp); + if (irp) irp = Tcl_DuplicateObj(irp); } newcode = Tcl_GlobalEval(interp,trap->action); /* @@ -473,63 +466,68 @@ * if new code is to be ignored (usual case - see "else" below) * allow only OK/RETURN from trap, otherwise complain */ if (code_flag) { - exp_debuglog("return value = %d for trap %s, action %s\r\n", - newcode,signal_to_string(sig),trap->action); - if (*interp->result != 0) { - errorlog("%s\r\n",interp->result); + expDiagLog("return value = %d for trap %s, action ",newcode,signal_to_string(sig)); + expDiagLogU(trap->action); + expDiagLogU("\r\n"); + if (0 != strcmp(Tcl_GetStringResult(interp),"")) { /* * Check errorinfo and see if it contains -nostack. * This shouldn't be necessary, but John changed the * top level interp so that it distorts arbitrary * return values into TCL_ERROR, so by the time we * get back, we'll have lost the value of errorInfo */ - eip = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY); - exp_nostack_dump = - (eip && (0 == strncmp("-nostack",eip,8))); + eip = Tcl_GetVar2Ex(interp,"errorInfo","",TCL_GLOBAL_ONLY); + if (eip) { + exp_nostack_dump = (0 == strncmp("-nostack",Tcl_GetString(eip),8)); + } } } else if (newcode != TCL_OK && newcode != TCL_RETURN) { - if (newcode != TCL_ERROR) { - exp_error(interp,"return value = %d for trap %s, action %s\r\n",newcode,signal_to_string(sig),trap->action); - } - Tcl_BackgroundError(interp); + if (newcode != TCL_ERROR) { + exp_error(interp,"return value = %d for trap %s, action %s\r\n",newcode,signal_to_string(sig),trap->action); + } + Tcl_BackgroundError(interp); } if (!code_flag) { /* * restore values */ Tcl_ResetResult(interp); /* turns off Tcl's internal */ - /* flags: ERR_IN_PROGRESS, ERROR_CODE_SET */ + /* flags: ERR_IN_PROGRESS, ERROR_CODE_SET */ + /* This also wipes clean errorInfo/Code/result which is why */ + /* all the calls to Tcl_Dup earlier */ if (eip) { - Tcl_AddErrorInfo(interp,eip); - Tcl_DStringFree(&ei); + /* odd that Tcl doesn't have a call that does all this at once */ + int len; + char *s = Tcl_GetStringFromObj(eip,&len); + Tcl_AddObjErrorInfo(interp,s,len); + Tcl_DecrRefCount(eip); + /* we never incr'd it, but the code allows this */ } else { - Tcl_UnsetVar(interp,"errorInfo",0); + Tcl_UnsetVar(interp,"errorInfo",0); } /* restore errorCode. Note that Tcl_AddErrorInfo (above) */ /* resets it to NONE. If the previous value is NONE, it's */ /* important to avoid calling Tcl_SetErrorCode since this */ /* with cause Tcl to set its internal ERROR_CODE_SET flag. */ if (ecp) { - if (!streq("NONE",ecp)) - Tcl_SetErrorCode(interp,ecp,(char *)0); - Tcl_DStringFree(&ec); + if (!streq("NONE",Tcl_GetString(ecp))) + Tcl_SetErrorCode(interp,ecp); + /* we're just passing on the errorcode obj */ + /* presumably, Tcl will incr ref count */ } else { - Tcl_UnsetVar(interp,"errorCode",0); + Tcl_UnsetVar(interp,"errorCode",0); } - Tcl_DStringResult(interp,&ir); - Tcl_DStringFree(&ir); - newcode = oldcode; /* note that since newcode gets overwritten here by old code */ /* it is possible to return in the middle of a trap by using */ /* "return" (or "continue" for that matter)! */ @@ -537,15 +535,15 @@ return newcode; } static struct exp_cmd_data cmd_data[] = { -{"trap", exp_proc(Exp_TrapCmd), (ClientData)EXP_SPAWN_ID_BAD, 0}, +{"trap", Exp_TrapObjCmd, 0, (ClientData)EXP_SPAWN_ID_BAD, 0}, {0}}; void exp_init_trap_cmds(interp) Tcl_Interp *interp; { exp_create_commands(interp,cmd_data); } Index: exp_tty.c ================================================================== --- exp_tty.c +++ exp_tty.c @@ -32,12 +32,12 @@ #include "tcl.h" #include "exp_prog.h" #include "exp_rename.h" #include "exp_tty_in.h" -#include "exp_log.h" #include "exp_command.h" +#include "exp_log.h" static int is_raw = FALSE; static int is_noecho = FALSE; int exp_ioctled_devtty = FALSE; @@ -147,18 +147,24 @@ if (exp_dev_tty == -1) return(0); *tty_old = tty_current; /* save old parameters */ *was_raw = is_raw; *was_echo = !is_noecho; - debuglog("tty_raw_noecho: was raw = %d echo = %d\r\n",is_raw,!is_noecho); + expDiagLog("tty_raw_noecho: was raw = %d echo = %d\r\n",is_raw,!is_noecho); exp_tty_raw(1); exp_tty_echo(-1); if (exp_tty_set_simple(&tty_current) == -1) { - errorlog("ioctl(raw): %s\r\n",Tcl_PosixError(interp)); - exp_exit(interp,1); + expErrorLog("ioctl(raw): %s\r\n",Tcl_PosixError(interp)); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } } exp_ioctled_devtty = TRUE; return(1); } @@ -176,18 +182,24 @@ if (exp_dev_tty == -1) return(0); *tty_old = tty_current; /* save old parameters */ *was_raw = is_raw; *was_echo = !is_noecho; - debuglog("tty_cooked_echo: was raw = %d echo = %d\r\n",is_raw,!is_noecho); + expDiagLog("tty_cooked_echo: was raw = %d echo = %d\r\n",is_raw,!is_noecho); exp_tty_raw(-1); exp_tty_echo(1); if (exp_tty_set_simple(&tty_current) == -1) { - errorlog("ioctl(noraw): %s\r\n",Tcl_PosixError(interp)); - exp_exit(interp,1); + expErrorLog("ioctl(noraw): %s\r\n",Tcl_PosixError(interp)); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } } exp_ioctled_devtty = TRUE; return(1); } @@ -198,17 +210,23 @@ exp_tty *tty; int raw; int echo; { if (exp_tty_set_simple(tty) == -1) { - errorlog("ioctl(set): %s\r\n",Tcl_PosixError(interp)); - exp_exit(interp,1); + expErrorLog("ioctl(set): %s\r\n",Tcl_PosixError(interp)); + + /* SF #439042 -- Allow overide of "exit" by user / script + */ + { + char buffer [] = "exit 1"; + Tcl_Eval(interp, buffer); + } } is_raw = raw; is_noecho = !echo; tty_current = *tty; - debuglog("tty_set: raw = %d, echo = %d\r\n",is_raw,!is_noecho); + expDiagLog("tty_set: raw = %d, echo = %d\r\n",is_raw,!is_noecho); exp_ioctled_devtty = TRUE; } #if 0 /* avoids scoping problems */ @@ -308,36 +326,37 @@ { char **new_argv; int i; int rc; - /* insert "system" at front, null at end, */ - /* and optional redirect in middle, hence "+3" */ - new_argv = (char **)ckalloc((3+argc)*sizeof(char *)); - new_argv[0] = exec_cmd; - new_argv[1] = stty_cmd; + Tcl_Obj *cmdObj = Tcl_NewStringObj("",0); + Tcl_IncrRefCount(cmdObj); + + Tcl_AppendStringsToObj(cmdObj,"exec /bin/stty",(char *)0); for (i=1;i/dev/tty"; + " >/dev/tty", #else - " +#include "tcl.h" #include "exp_tty_in.h" #include "exp_rename.h" -#define EXP_AVOID_INCLUDING_TCL_H #include "expect_comm.h" +#include "exp_command.h" #include "exp_log.h" #ifndef TRUE #define FALSE 0 #define TRUE 1 Index: expect.c ================================================================== --- expect.c +++ expect.c @@ -12,13 +12,10 @@ #include #include #include #include /* for isspace */ #include /* for time(3) */ -#if 0 -#include -#endif #include "expect_cf.h" #ifdef HAVE_SYS_WAIT_H #include @@ -30,11 +27,10 @@ #include "tcl.h" #include "string.h" -#include "tclRegexp.h" #include "exp_rename.h" #include "exp_prog.h" #include "exp_command.h" #include "exp_log.h" #include "exp_event.h" @@ -53,18 +49,32 @@ int exp_default_rm_nulls = TRUE; /* user variable names */ #define EXPECT_TIMEOUT "timeout" #define EXPECT_OUT "expect_out" + +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; - char *pat; /* original pattern spec */ - char *body; /* ptr to body to be executed upon match */ + Tcl_Obj *pat; /* original pattern spec */ + Tcl_Obj *body; /* ptr to body to be executed upon match */ #define PAT_EOF 1 #define PAT_TIMEOUT 2 #define PAT_DEFAULT 3 #define PAT_FULLBUFFER 4 #define PAT_GLOB 5 /* glob-style pattern list */ @@ -75,18 +85,16 @@ int use; /* PAT_XXX */ int simple_start;/* offset 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 iwrite;*/ /* if true write spawn_id */ 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? */ - regexp *re; /* if this is 0, then pattern match via glob */ }; /* descriptions of the pattern types, used for debugging */ char *pattern_style[PAT_TYPES]; @@ -123,146 +131,50 @@ 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 */ -#if 0 -static jmp_buf env; /* for interruptable read() */ - /* longjmp(env,1) times out the read */ - /* longjmp(env,2) restarts the read */ -static int env_valid = FALSE; /* whether we can longjmp or not */ -#endif #ifdef SIMPLE_EVENT static int alarm_fired; /* if alarm occurs */ #endif -void exp_background_filehandlers_run_all(); +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 */ static char *exp_indirect_update2(); /* 2-part Tcl variable names */ -static int exp_i_read _ANSI_ARGS_((Tcl_Interp *,int,int,int)); - #ifdef SIMPLE_EVENT /*ARGSUSED*/ static RETSIGTYPE sigalarm_handler(n) int n; /* unused, for compatibility with STDC */ { alarm_fired = TRUE; -#if 0 - /* check env_valid first to protect us from the alarm occurring */ - /* in the window between i_read and alarm(0) */ - if (env_valid) longjmp(env,1); -#endif /*0*/ } #endif /*SIMPLE_EVENT*/ -#if 0 -/*ARGSUSED*/ -static RETSIGTYPE -sigalarm_handler(n) -int n; /* unused, for compatibility with STDC */ -{ -#ifdef REARM_SIG - signal(SIGALRM,sigalarm_handler); -#endif - - /* check env_valid first to protect us from the alarm occurring */ - /* in the window between i_read and alarm(0) */ - if (env_valid) longjmp(env,1); -} -#endif /*0*/ - -#if 0 - -/* upon interrupt, act like timeout */ -/*ARGSUSED*/ -static RETSIGTYPE -sigint_handler(n) -int n; /* unused, for compatibility with STDC */ -{ -#ifdef REARM_SIG - signal(SIGINT,sigint_handler);/* not nec. for BSD, but doesn't hurt */ -#endif - -#ifdef TCL_DEBUGGER - if (exp_tcl_debugger_available) { - /* if the debugger is active and we're reading something, */ - /* force the debugger to go interactive now and when done, */ - /* restart the read. */ - - Dbg_On(exp_interp,env_valid); - - /* restart the read */ - if (env_valid) longjmp(env,2); - - /* if no read is in progess, just let debugger start at */ - /* the next command. */ - return; - } -#endif - -#if 0 -/* the ability to timeout a read via ^C is hereby removed 8-Mar-1993 - DEL */ - - /* longjmp if we are executing a read inside of expect command */ - if (env_valid) longjmp(env,1); -#endif - - /* if anywhere else in code, prepare to exit */ - exp_exit(exp_interp,0); -} -#endif /*0*/ - -/* remove nulls from s. Initially, the number of chars in s is c, */ -/* not strlen(s). This count does not include the trailing null. */ -/* returns number of nulls removed. */ -static int -rm_nulls(s,c) -char *s; -int c; -{ - char *s2 = s; /* points to place in original string to put */ - /* next non-null character */ - int count = 0; - int i; - - for (i=0;ire) ckfree((char *)ec->re); - - if (ec->i_list->duration == EXP_PERMANENT) { - if (ec->pat) ckfree(ec->pat); - if (ec->body) ckfree(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 */ + if (ec->i_list->duration == EXP_PERMANENT) { + if (ec->pat) Tcl_DecrRefCount(ec->pat); + 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(interp,eg,free_ilist) @@ -327,22 +239,23 @@ \nfoo\nbar TRUE Current test is very cheap and almost always right :-) */ int -exp_one_arg_braced(p) -char *p; +exp_one_arg_braced(objPtr) /* INTL */ +Tcl_Obj *objPtr; { int seen_nl = FALSE; + char *p = Tcl_GetString(objPtr); for (;*p;p++) { if (*p == '\n') { seen_nl = TRUE; continue; } - if (!isspace(*p)) { + if (!isspace(*p)) { /* INTL: ISO space */ return(seen_nl); } } return FALSE; } @@ -350,49 +263,107 @@ /* 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 TCL_whatever */ /*ARGSUSED*/ int -exp_eval_with_one_arg(clientData,interp,argv) +exp_eval_with_one_arg(clientData,interp,objv) /* INTL */ ClientData clientData; Tcl_Interp *interp; -char **argv; -{ - char *buf; - int rc; - char *a; - - /* + 11 is for " -nobrace " and null at end */ - buf = ckalloc(strlen(argv[0]) + strlen(argv[1]) + 11); - /* recreate statement (with -nobrace to prevent recursion) */ - sprintf(buf,"%s -nobrace %s",argv[0],argv[1]); +Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ +#define NUM_STATIC_OBJS 20 + Tcl_Obj *staticObjArray[NUM_STATIC_OBJS]; + int maxobjs = NUM_STATIC_OBJS; + Tcl_Token *tokenPtr; + char *p, *next; + int rc; + Tcl_Obj **objs = staticObjArray; + int objc, bytesLeft, numWords, i; + Tcl_Parse parse; + + /* + * Prepend the command name and the -nobrace switch so we can + * reinvoke without recursing. + */ + objc = 2; + objs[0] = objv[0]; + objs[1] = Tcl_NewStringObj("-nobrace", -1); + Tcl_IncrRefCount(objs[0]); + Tcl_IncrRefCount(objs[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. + */ + + if (objc + numWords > maxobjs) { + Tcl_Obj ** newobjs; + maxobjs = (objc + numWords) * 2; + newobjs = (Tcl_Obj **)ckalloc(maxobjs * sizeof (Tcl_Obj *)); + memcpy(newobjs, objs, objc*sizeof(Tcl_Obj *)); + if (objs != staticObjArray) { + ckfree((char*)objs); + } + objs = newobjs; + } + + /* + * For each word, perform substitutions then store the + * result in the objs array. + */ + + for (tokenPtr = parse.tokenPtr; numWords > 0; + numWords--, tokenPtr += (tokenPtr->numComponents + 1)) { + objs[objc] = Tcl_EvalTokens(interp, tokenPtr+1, + tokenPtr->numComponents); + if (objs[objc] == NULL) { + rc = TCL_ERROR; + goto done; + } + objc++; + } + } /* - * replace top-level newlines with blanks + * Advance to the next command in the script. */ - - /* Should only be necessary to run over argv[1] and then sprintf */ - /* that into the buffer, but the ICEM guys insist that writing */ - /* back over the original arguments makes their Tcl compiler very */ - /* unhappy. */ - for (a=buf;*a;) { - extern char *TclWordEnd(); - - for (;isspace(*a);a++) { - if (*a == '\n') *a = ' '; - } -#if TCL_MAJOR_VERSION < 8 - a = TclWordEnd(a,0,(int *)0)+1; -#else - a = TclWordEnd(a,&a[strlen(a)],0,(int *)0)+1; -#endif - } - - rc = Tcl_Eval(interp,buf); - - ckfree(buf); - return(rc); + next = parse.commandStart + parse.commandSize; + bytesLeft -= next - p; + p = next; + Tcl_FreeParse(&parse); + } while (bytesLeft > 0); + + /* + * Now evaluate the entire command with no further substitutions. + */ + + rc = Tcl_EvalObjv(interp, objc, objs, 0); + done: + for (i = 0; i < objc; i++) { + Tcl_DecrRefCount(objs[i]); + } + if (objs != staticObjArray) { + ckfree((char *) objs); + } + return(rc); +#undef NUM_STATIC_OBJS } static void ecase_clear(ec) struct ecase *ec; @@ -400,14 +371,12 @@ ec->i_list = 0; ec->pat = 0; ec->body = 0; ec->transfer = TRUE; ec->indices = FALSE; -/* ec->iwrite = FALSE;*/ ec->iread = FALSE; ec->timestamp = FALSE; - ec->re = 0; ec->Case = CASE_NORM; ec->use = PAT_GLOB; } static struct ecase * @@ -444,393 +413,552 @@ The exp_i chain can be broken by the caller if desired. */ static int -parse_expect_args(interp,eg,default_spawn_id,argc,argv) +parse_expect_args(interp,eg,default_esPtr,objc,objv) Tcl_Interp *interp; struct exp_cmd_descriptor *eg; -int default_spawn_id; /* suggested master if called as expect_user or _tty */ -int argc; -char **argv; -{ - int i; - char *arg; - struct ecase ec; /* temporary to collect args */ - - argv++; - argc--; - - 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+(argc/2))); - - eg->ecd.count = 0; - - for (i = 0;i=argc) { - exp_error(interp,"-i requires following spawn_id"); - goto error; - } - - ec.i_list = exp_new_i_complex(interp,argv[i], - eg->duration,exp_indirect_update2); - - 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; - - continue; - } else if (exp_flageq("indices",arg,2)) { - ec.indices = TRUE; - continue; - } else if (exp_flageq("iwrite",arg,2)) { -/* ec.iwrite = TRUE;*/ - continue; - } else if (exp_flageq("iread",arg,2)) { - ec.iread = TRUE; - continue; - } else if (exp_flageq("timestamp",arg,2)) { - ec.timestamp = TRUE; - continue; - } else if (exp_flageq("timeout",arg,2)) { - i++; - if (i>=argc) { - exp_error(interp,"-timeout requires following # of seconds"); - goto error; - } - - eg->timeout = atoi(argv[i]); - eg->timeout_specified_by_flag = TRUE; - continue; - } else if (exp_flageq("nobrace",arg,7)) { - /* 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. */ - continue; - } else { - exp_error(interp,"usage: unrecognized flag <%s>",arg); - goto error; - } - } - - /* 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_spawn_id != EXP_SPAWN_ID_BAD) { - eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration); - } else { - /* it'll be checked later, if used */ - (void) exp_update_master(interp,&default_spawn_id,0,0); - eg->i_list = exp_new_i_simple(default_spawn_id,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 */ - save_str(&ec.pat,argv[i],eg->duration == EXP_TEMPORARY); - save_str(&ec.body,argv[i+1],eg->duration == EXP_TEMPORARY); - - i++; - - *(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec; +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) { + 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; + } + 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); + + 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_spawn_id != EXP_SPAWN_ID_BAD) { - eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration); - } else { - /* it'll be checked later, if used */ - (void) exp_update_master(interp,&default_spawn_id,0,0); - eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration); - } - } - - return(TCL_OK); + 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); - - /* undo temporary ecase */ - /* free_ecase doesn't quite handle this right, so do it by hand */ - if (ec.re) ckfree((char *)ec.re); - if (eg->duration == EXP_PERMANENT) { - if (ec.pat) ckfree(ec.pat); - if (ec.body) ckfree(ec.body); - } - - if (eg->i_list) - exp_free_i(interp,eg->i_list,exp_indirect_update2); - return(TCL_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 */ - struct exp_f *f; /* struct exp_f that matched */ - char *buffer; /* buffer that matched */ - int match; /* # of chars in buffer that matched */ - /* or # of chars in buffer at EOF */ + struct ecase *e; /* ecase that matched */ + ExpState *esPtr; /* ExpState that matched */ + Tcl_Obj *buffer; /* buffer that matched */ + int match; /* # of bytes in buffer that matched */ + /* or # of bytes in buffer at EOF */ }; + + +/* + *---------------------------------------------------------------------- + * + * 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. + * + *---------------------------------------------------------------------- + */ + +char * +string_case_first(string,pattern) /* INTL */ + register char *string; /* String. */ + register char *pattern; /* Pattern, which may contain + * special characters. */ +{ + char *s, *p; + int offset; + Tcl_UniChar ch1, ch2; + + while (*string != 0) { + s = string; + p = pattern; + while (*s) { + s += Tcl_UtfToUniChar(s, &ch1); + offset = Tcl_UtfToUniChar(p, &ch2); + if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { + break; + } + p += offset; + } + if (*p == '\0') { + return string; + } + 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(interp,e,m,o,last_f,last_case,suffix) +eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix) Tcl_Interp *interp; struct ecase *e; -int m; +ExpState *esPtr; struct eval_out *o; /* 'output' - i.e., final case of interest */ /* next two args are for debugging, when they change, reprint buffer */ -struct exp_f **last_f; +ExpState **last_esPtr; int *last_case; char *suffix; { - struct exp_f *f = exp_fs + m; - char *buffer; - - /* if -nocase, use the lowerized buffer */ - buffer = ((e->Case == CASE_NORM)?f->buffer:f->lower); - - /* if master or case changed, redisplay debug-buffer */ - if ((f != *last_f) || e->Case != *last_case) { - debuglog("\r\nexpect%s: does \"%s\" (spawn_id %d) match %s ", - suffix, - dprintify(buffer),f-exp_fs, - pattern_style[e->use]); - *last_f = f; - *last_case = e->Case; - } - - if (e->use == PAT_RE) { - debuglog("\"%s\"? ",dprintify(e->pat)); - TclRegError((char *)0); - if (buffer && TclRegExec(e->re,buffer,buffer)) { - o->e = e; - o->match = e->re->endp[0]-buffer; - o->buffer = buffer; - o->f = f; - debuglog(yes); - return(EXP_MATCH); - } else { - debuglog(no); - if (TclGetRegError()) { - exp_error(interp,"-re failed: %s",TclGetRegError()); - return(EXP_TCLERROR); - } - } - } else if (e->use == PAT_GLOB) { - int match; /* # of chars that matched */ - - debuglog("\"%s\"? ",dprintify(e->pat)); - if (buffer && (-1 != (match = Exp_StringMatch( - buffer,e->pat,&e->simple_start)))) { - o->e = e; - o->match = match; - o->buffer = buffer; - o->f = f; - debuglog(yes); - return(EXP_MATCH); - } else debuglog(no); - } else if (e->use == PAT_EXACT) { - char *p = strstr(buffer,e->pat); - debuglog("\"%s\"? ",dprintify(e->pat)); - if (p) { - e->simple_start = p - buffer; - o->e = e; - o->match = strlen(e->pat); - o->buffer = buffer; - o->f = f; - debuglog(yes); - return(EXP_MATCH); - } else debuglog(no); - } else if (e->use == PAT_NULL) { - int i = 0; - debuglog("null? "); - for (;isize;i++) { - if (buffer[i] == 0) { - o->e = e; - o->match = i+1; /* in this case, match is */ - /* just the # of chars + 1 */ - /* before the null */ - o->buffer = buffer; - o->f = f; - debuglog(yes); - return EXP_MATCH; - } - } - debuglog(no); - } else if ((f->size == f->msize) && (f->size > 0)) { - debuglog("%s? ",e->pat); - o->e = e; - o->match = f->umsize; - o->buffer = f->buffer; - o->f = f; - debuglog(yes); - return(EXP_FULLBUFFER); - } - return(EXP_NOMATCH); + Tcl_Obj *buffer; + Tcl_RegExp re; + Tcl_RegExpInfo info; + char *str; + int length, flags; + int result; + + buffer = esPtr->buffer; + str = Tcl_GetStringFromObj(buffer, &length); + + /* if ExpState or case changed, redisplay debug-buffer */ + if ((esPtr != *last_esPtr) || e->Case != *last_case) { + expDiagLog("\r\nexpect%s: does \"",suffix); + expDiagLogU(expPrintify(str)); + 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->Case == CASE_NORM) { + flags = TCL_REG_ADVANCED; + } else { + flags = TCL_REG_ADVANCED | TCL_REG_NOCASE; + } + + re = Tcl_GetRegExpFromObj(interp, e->pat, flags); + + result = Tcl_RegExpExecObj(interp, re, buffer, 0 /* offset */, + -1 /* nmatches */, 0 /* eflags */); + if (result > 0) { + + o->e = e; + + /* + * Retrieve the byte offset of the end of the + * matched string. + */ + + Tcl_RegExpGetInfo(re, &info); + o->match = Tcl_UtfAtIndex(str, info.matches[0].end) - str; + o->buffer = buffer; + 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 bytes that matched */ + + expDiagLog("\""); + expDiagLogU(expPrintify(Tcl_GetString(e->pat))); + expDiagLog("\"? "); + if (buffer) { + match = Exp_StringCaseMatch(Tcl_GetString(buffer), + Tcl_GetString(e->pat), + (e->Case == CASE_NORM) ? 0 : 1, + &e->simple_start); + if (match != -1) { + o->e = e; + o->match = match; + o->buffer = buffer; + 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); + char *p; + + if (e->Case == CASE_NORM) { + p = strstr(str, pat); + } else { + p = string_case_first(str, pat); + } + + expDiagLog("\""); + expDiagLogU(expPrintify(Tcl_GetString(e->pat))); + expDiagLog("\"? "); + if (p) { + e->simple_start = p - str; + o->e = e; + o->match = patLength; + o->buffer = buffer; + o->esPtr = esPtr; + expDiagLogU(yes); + return(EXP_MATCH); + } else expDiagLogU(no); + } else if (e->use == PAT_NULL) { + char *p; + expDiagLogU("null? "); + p = Tcl_UtfFindFirst(str, 0); + + if (p) { + o->e = e; + o->match = p-str; + o->buffer = buffer; + 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 */ + if ((expSizeGet(esPtr) + TCL_UTF_MAX >= esPtr->msize) + && (length > 0)) { + o->e = e; + o->match = length; + o->buffer = esPtr->buffer; + 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(interp,eg,m,o,last_f,last_case,status,masters,mcount,suffix) +eval_cases(interp,eg,esPtr,o,last_esPtr,last_case,status,esPtrs,mcount,suffix) Tcl_Interp *interp; struct exp_cmd_descriptor *eg; -int m; +ExpState *esPtr; struct eval_out *o; /* 'output' - i.e., final case of interest */ /* next two args are for debugging, when they change, reprint buffer */ -struct exp_f **last_f; +ExpState **last_esPtr; int *last_case; int status; -int *masters; +ExpState *(esPtrs[]); int mcount; char *suffix; { - int i; - int em; /* master of ecase */ - struct ecase *e; - - if (o->e || status == EXP_TCLERROR || eg->ecd.count == 0) return(status); - - if (status == EXP_TIMEOUT) { - for (i=0;iecd.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;iecd.count;i++) { - e = eg->ecd.cases[i]; - if (e->use == PAT_EOF || e->use == PAT_DEFAULT) { - struct exp_fd_list *fdl; - - for (fdl=e->i_list->fd_list; fdl ;fdl=fdl->next) { - em = fdl->fd; - if (em == EXP_SPAWN_ID_ANY || em == m) { - 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;iecd.count;i++) { - struct exp_fd_list *fdl; - int j; - - e = eg->ecd.cases[i]; - if (e->use == PAT_TIMEOUT || - e->use == PAT_DEFAULT || - e->use == PAT_EOF) continue; - - for (fdl = e->i_list->fd_list; fdl; fdl = fdl->next) { - em = fdl->fd; - /* if em == EXP_SPAWN_ID_ANY, then user is explicitly asking */ - /* every case to be checked against every master */ - if (em == EXP_SPAWN_ID_ANY) { - /* test against each spawn_id */ - for (j=0;je || status == EXP_TCLERROR || eg->ecd.count == 0) return(status); + + if (status == EXP_TIMEOUT) { + for (i=0;iecd.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;iecd.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;iecd.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;ji_list,exp_i); } /* remove ecases tied to a single direct spawn id */ static void -ecmd_remove_fd(interp,ecmd,m,direct) +ecmd_remove_state(interp,ecmd,esPtr,direct) Tcl_Interp *interp; struct exp_cmd_descriptor *ecmd; -int m; +ExpState *esPtr; int direct; { - struct exp_i *exp_i, *next; - struct exp_fd_list **fdl; - - for (exp_i=ecmd->i_list;exp_i;exp_i=next) { - next = exp_i->next; - - if (!(direct & exp_i->direct)) continue; - - for (fdl = &exp_i->fd_list;*fdl;) { - if (m == ((*fdl)->fd)) { - struct exp_fd_list *tmp = *fdl; - *fdl = (*fdl)->next; - exp_free_fd_single(tmp); - - /* if last bg ecase, disarm spawn id */ - if ((ecmd->cmdtype == EXP_CMD_BG) && (m != EXP_SPAWN_ID_ANY)) { - exp_fs[m].bg_ecount--; - if (exp_fs[m].bg_ecount == 0) { - exp_disarm_background_filehandler(m); - exp_fs[m].bg_interp = 0; - } - } - - continue; - } - fdl = &(*fdl)->next; - } - - /* if left with no fds (and is direct), get rid of it */ - /* and any dependent ecases */ - if (exp_i->direct == EXP_DIRECT && !exp_i->fd_list) { - exp_i_remove_with_ecases(interp,ecmd,exp_i); - } - } -} - -/* this is called from exp_close to clean up the fd */ -void -exp_ecmd_remove_fd_direct_and_indirect(interp,m) -Tcl_Interp *interp; -int m; -{ - ecmd_remove_fd(interp,&exp_cmds[EXP_CMD_BEFORE],m,EXP_DIRECT|EXP_INDIRECT); - ecmd_remove_fd(interp,&exp_cmds[EXP_CMD_AFTER],m,EXP_DIRECT|EXP_INDIRECT); - ecmd_remove_fd(interp,&exp_cmds[EXP_CMD_BG],m,EXP_DIRECT|EXP_INDIRECT); + 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(interp,esPtr) +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_filehandler_force(m); + exp_disarm_background_channelhandler_force(esPtr); } -/* arm a list of background fd's */ +/* arm a list of background ExpState's */ static void -fd_list_arm(interp,fdl) -Tcl_Interp *interp; -struct exp_fd_list *fdl; -{ - /* for each spawn id in list, arm if necessary */ - for (;fdl;fdl=fdl->next) { - int m = fdl->fd; - if (m == EXP_SPAWN_ID_ANY) continue; - - if (exp_fs[m].bg_ecount == 0) { - exp_arm_background_filehandler(m); - exp_fs[m].bg_interp = interp; - } - exp_fs[m].bg_ecount++; - } +state_list_arm(interp,slPtr) +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_fd(exp_i,fd) +exp_i_uses_state(exp_i,esPtr) struct exp_i *exp_i; -int fd; +ExpState *esPtr; { - struct exp_fd_list *fdp; + struct exp_state_list *fdp; - for (fdp = exp_i->fd_list;fdp;fdp=fdp->next) { - if (fdp->fd == fd) return 1; + for (fdp = exp_i->state_list;fdp;fdp=fdp->next) { + if (fdp->esPtr == esPtr) return 1; } return 0; } static void @@ -989,18 +1117,17 @@ Tcl_Interp *interp; struct ecase *ec; { if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer"); if (ec->indices) Tcl_AppendElement(interp,"-indices"); -/* if (ec->iwrite) Tcl_AppendElement(interp,"-iwrite");*/ if (!ec->Case) Tcl_AppendElement(interp,"-nocase"); - if (ec->re) Tcl_AppendElement(interp,"-re"); + 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,ec->pat); - Tcl_AppendElement(interp,ec->body?ec->body:""); + 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(interp,ecmd,exp_i) @@ -1023,597 +1150,735 @@ { Tcl_AppendElement(interp,"-i"); if (exp_i->direct == EXP_INDIRECT) { Tcl_AppendElement(interp,exp_i->variable); } else { - struct exp_fd_list *fdp; + struct exp_state_list *fdp; /* if more than one element, add braces */ - if (exp_i->fd_list->next) + if (exp_i->state_list->next) Tcl_AppendResult(interp," {",(char *)0); - for (fdp = exp_i->fd_list;fdp;fdp=fdp->next) { + for (fdp = exp_i->state_list;fdp;fdp=fdp->next) { char buf[10]; /* big enough for a small int */ - sprintf(buf,"%d",fdp->fd); + sprintf(buf,"%d",fdp->esPtr); Tcl_AppendElement(interp,buf); } - if (exp_i->fd_list->next) + if (exp_i->state_list->next) Tcl_AppendResult(interp,"} ",(char *)0); } } -#if 0 -/* delete ecases based on named -i descriptors */ -int -expect_delete(interp,ecmd,argc,argv) -Tcl_Interp *interp; -struct exp_cmd_descriptor *ecmd; -int argc; -char **argv; -{ - while (*argv) { - if (streq(argv[0],"-i") && argv[1]) { - iflag = argv[1]; - argc-=2; argv+=2; - } else if (streq(argv[0],"-all")) { - all = TRUE; - argc--; argv++; - } else if (streq(argv[0],"-noindirect")) { - direct &= ~EXP_INDIRECT; - argc--; argv++; - } else { - exp_error(interp,"usage: -delete [-all | -i spawn_id]\n"); - return TCL_ERROR; - } - } - - if (all) { - /* same logic as at end of regular expect cmd */ - free_ecases(interp,ecmd,0); - exp_free_i(interp,ecmd->i_list,exp_indirect_update2); - return TCL_OK; - } - - if (!iflag) { - if (0 == exp_update_master(interp,&m,0,0)) { - return TCL_ERROR; - } - } else if (Tcl_GetInt(interp,iflag,&m) != TCL_OK) { - /* handle as in indirect */ - - struct exp_i **old_i; - - for (old_i=&ecmd->i_list;*old_i;) { - struct exp_i *tmp; - - if ((*old_i)->direct == EXP_DIRECT) continue; - if (!streq((*old_i)->variable,iflag)) 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_i,exp_indirect_update2); - } else { - old_i = &(*old_i)->next; - } - return TCL_OK; - } - - /* delete ecases of this direct_fd */ - /* unfinish after this ... */ - for (exp_i=ecmd->i_list;exp_i;exp_i=exp_i->next) { - if (!(direct & exp_i->direct)) continue; - if (!exp_i_uses_fd(exp_i,m)) continue; - - /* delete each ecase that uses this exp_i */ - - - ecase_by_exp_i_append(interp,ecmd,exp_i); - } - - return TCL_OK; -} -#endif - -/* return current setting of the permanent expect_before/after/bg */ -int -expect_info(interp,ecmd,argc,argv) -Tcl_Interp *interp; -struct exp_cmd_descriptor *ecmd; -int argc; -char **argv; -{ - struct exp_i *exp_i; - int i; - int direct = EXP_DIRECT|EXP_INDIRECT; - char *iflag = 0; - int all = FALSE; /* report on all fds */ - int m; - - while (*argv) { - if (streq(argv[0],"-i") && argv[1]) { - iflag = argv[1]; - argc-=2; argv+=2; - } else if (streq(argv[0],"-all")) { - all = TRUE; - argc--; argv++; - } else if (streq(argv[0],"-noindirect")) { - direct &= ~EXP_INDIRECT; - argc--; argv++; - } else { - exp_error(interp,"usage: -info [-all | -i spawn_id]\n"); - return TCL_ERROR; - } - } - - if (all) { - /* avoid printing out -i when redundant */ - struct exp_i *previous = 0; - - for (i=0;iecd.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 (0 == exp_update_master(interp,&m,0,0)) { - return TCL_ERROR; - } - } else if (Tcl_GetInt(interp,iflag,&m) != TCL_OK) { - /* handle as in indirect */ - Tcl_ResetResult(interp); - for (i=0;iecd.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_fd(exp_i,m)) continue; - ecase_by_exp_i_append(interp,ecmd,exp_i); - } - - return TCL_OK; -} - -/* Exp_ExpectGlobalCmd is invoked to process expect_before/after */ -/*ARGSUSED*/ -int -Exp_ExpectGlobalCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int result = TCL_OK; - struct exp_i *exp_i, **eip; - struct exp_fd_list *fdl; /* temp for interating over fd_list */ - struct exp_cmd_descriptor eg; - int count; - - struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData; - - if ((argc == 2) && exp_one_arg_braced(argv[1])) { - return(exp_eval_with_one_arg(clientData,interp,argv)); - } else if ((argc == 3) && streq(argv[1],"-brace")) { - char *new_argv[2]; - new_argv[0] = argv[0]; - new_argv[1] = argv[2]; - return(exp_eval_with_one_arg(clientData,interp,new_argv)); - } - - if (argc > 1 && (argv[1][0] == '-')) { - if (exp_flageq("info",&argv[1][1],4)) { - return(expect_info(interp,ecmd,argc-2,argv+2)); - } - } - - exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT); - - if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD, - argc,argv)) { - 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 (fdl=exp_i->fd_list;fdl;fdl=fdl->next) { - int m = fdl->fd; - - /* validate all input descriptors */ - if (m != EXP_SPAWN_ID_ANY) { - if (!exp_fd2f(interp,m,1,1,"expect")) { - result = TCL_ERROR; - goto cleanup; - } - } - - /* remove spawn id from exp_i */ - ecmd_remove_fd(interp,ecmd,m,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) { - char *msg = exp_indirect_update1(interp,ecmd,exp_i); - if (msg) { - /* unusual way of handling error return */ - /* because of Tcl's variable tracing */ - strcpy(interp->result,msg); - 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) { - fd_list_arm(interp,exp_i->fd_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_filehandlers_run_all(); - } - - return(result); +/* return current setting of the permanent expect_before/after/bg */ +int +expect_info(interp,ecmd,objc,objv) +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) { + 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;iecd.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;iecd.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, interp, objc, objv) +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; + + struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData; + + if ((objc == 2) && exp_one_arg_braced(objv[1])) { + return(exp_eval_with_one_arg(clientData,interp,objv)); + } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { + Tcl_Obj *new_objv[2]; + new_objv[0] = objv[0]; + new_objv[1] = objv[2]; + return(exp_eval_with_one_arg(clientData,interp,new_objv)); + } + + if (objc > 1 && (Tcl_GetString(objv[1])[0] == '-')) { + if (exp_flageq("info",Tcl_GetString(objv[1])+1,4)) { + return(expect_info(interp,ecmd,objc,objv)); + } + } + + exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT); + + if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD, + objc,objv)) { + 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) { + char *msg = exp_indirect_update1(interp,ecmd,exp_i); + if (msg) { + /* unusual way of handling error return */ + /* because of Tcl's variable tracing */ + strcpy(interp->result,msg); + 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(); + } + + return(result); } /* adjusts file according to user's size request */ void -exp_adjust(f) -struct exp_f *f; -{ - int new_msize; - - /* get the latest buffer size. Double the user input for */ - /* two reasons. 1) Need twice the space in case the match */ - /* straddles two bufferfuls, 2) easier to hack the division */ - /* by two when shifting the buffers later on. The extra */ - /* byte in the malloc's is just space for a null we can slam on the */ - /* end. It makes the logic easier later. The -1 here is so that */ - /* requests actually come out to even/word boundaries (if user */ - /* gives "reasonable" requests) */ - new_msize = f->umsize*2 - 1; - if (new_msize != f->msize) { - if (!f->buffer) { - /* allocate buffer space for 1st time */ - f->buffer = ckalloc((unsigned)new_msize+1); - f->lower = ckalloc((unsigned)new_msize+1); - f->size = 0; - } else { - /* buffer already exists - resize */ - - /* if truncated, forget about some data */ - if (f->size > new_msize) { - /* copy end of buffer down */ - memmove(f->buffer,f->buffer+(f->size - new_msize),new_msize); - memmove(f->lower, f->lower +(f->size - new_msize),new_msize); - f->size = new_msize; - - f->key = expect_key++; - } - - f->buffer = ckrealloc(f->buffer,new_msize+1); - f->lower = ckrealloc(f->lower,new_msize+1); - } - f->msize = new_msize; - f->buffer[f->size] = '\0'; - f->lower[f->size] = '\0'; - } -} - +expAdjust(esPtr) +ExpState *esPtr; +{ + int new_msize; + int length; + Tcl_Obj *newObj; + char *string; + int excessBytes; + char *excessGuess; + char *p; + + /* + * Resize buffer to user's request * 2 + 1. + * x2: in case the match straddles two bufferfuls. + * +1: for trailing null. + */ + + new_msize = esPtr->umsize*2 + 1; + + if (new_msize != esPtr->msize) { + string = Tcl_GetStringFromObj(esPtr->buffer, &length); + if (length > new_msize) { + /* + * too much data, forget about data at beginning of buffer + */ + + excessBytes = length - new_msize; /* initial guess */ + + /* + * Alas, string + excessBytes may be in the middle of a UTF char. + * Find out for sure. + */ + excessGuess = string + excessBytes; + for (p=string;;p=Tcl_UtfNext(p)) { + if (p >= excessGuess) break; + } + + /* now we can calculate a valid # of excess bytes */ + excessBytes = p - string; + newObj = Tcl_NewStringObj(string + excessBytes,length - excessBytes); + } else { + /* + * too little data + */ + + /* first copy what's there */ + newObj = Tcl_NewStringObj(string,length); + + /* + * Force object to allocate a buffer at least new_msize bytes long, + * then reset correct string length. + */ + + Tcl_SetObjLength(newObj,new_msize); + Tcl_SetObjLength(newObj,length); + } + Tcl_IncrRefCount(newObj); + Tcl_DecrRefCount(esPtr->buffer); + esPtr->buffer = newObj; + + esPtr->key = expect_key++; + esPtr->msize = new_msize; + } +} + +#if OBSOLETE +/* Strip parity */ +static void +expParityStrip(obj,offsetBytes) + 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); + } + } +} +#endif /*OBSOLETE*/ + +/* 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(obj,offset) + 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 += Tcl_UtfToUniChar(s,&uc); + if (s > end) { + printf("UTF out of sync with terminator\n"); + fflush(stdout); + abort(); + } + } + s += offset; + while (*s) { + Tcl_UniChar uc; + + s += Tcl_UtfToUniChar(s,&uc); + if (s > end) { + printf("UTF from offset out of sync with terminator\n"); + fflush(stdout); + abort(); + } + } +} + +/* Strip UTF-encoded nulls from object, beginning at offset */ +static int +expNullStrip(obj,offsetBytes) + Tcl_Obj *obj; + int offsetBytes; +{ + char *src, *src2; + char *dest; + Tcl_UniChar uc; + int newsize; /* size of obj after all nulls removed */ + + src2 = src = dest = Tcl_GetString(obj) + offsetBytes; + + while (*src) { + src += Tcl_UtfToUniChar(src,&uc); + if (uc != 0) { + dest += Tcl_UniCharToUtf(uc,dest); + } + } + newsize = offsetBytes + (dest - src2); + Tcl_SetObjLength(obj,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(interp,esPtr,timeout,save_flags) /* INTL */ +Tcl_Interp *interp; +ExpState *esPtr; +int timeout; +int save_flags; +{ + int cc = EXP_TIMEOUT; + int size = expSizeGet(esPtr); + + if (size + TCL_UTF_MAX >= esPtr->msize) + 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->buffer, + esPtr->msize - (size / TCL_UTF_MAX), + 1 /* append */); + i_read_errno = errno; + +#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; +} /* - - expect_read() 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), -expect_read will also call this a successful read (for the purposes if -needing to pattern match against it). - -*/ + * 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 -expect_read(interp,masters,masters_max,m,timeout,key) +expRead(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key) Tcl_Interp *interp; -int *masters; /* If 0, then m is already known and set. */ -int masters_max; /* If *masters is not-zero, then masters_max */ - /* is the number of masters. */ - /* If *masters is zero, then masters_max */ - /* is used as the mask (ready vs except). */ - /* Crude but simplifies the interface. */ -int *m; /* Out variable to leave new master. */ +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; { - struct exp_f *f; - 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 (masters == 0) { - /* we already know the master, just find out what happened */ - cc = exp_get_next_event_info(interp,*m,masters_max); - tcl_set_flags = TCL_GLOBAL_ONLY; - } else { - cc = exp_get_next_event(interp,masters,masters_max,m,timeout,key); - tcl_set_flags = 0; - } - - if (cc == EXP_DATA_NEW) { - /* try to read it */ - - cc = exp_i_read(interp,*m,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) { - f = exp_fs + *m; - f->buffer[f->size += cc] = '\0'; - - /* strip parity if requested */ - if (f->parity == 0) { - /* do it from end backwards */ - char *p = f->buffer + f->size - 1; - int count = cc; - while (count--) { - *p-- &= 0x7f; - } - } - } /* else { - assert(cc < 0) in which case some sort of error was - encountered such as an interrupt with that forced an - error return - } */ - } else if (cc == EXP_DATA_OLD) { - f = exp_fs + *m; - 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=%d): %s",*m, - Tcl_PosixError(interp)); - exp_close(interp,*m); - } - 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 */ - - if (f->size) write_count = f->size - f->printed; - else write_count = 0; - - if (write_count) { - if (logfile_all || (loguser && logfile)) { - fwrite(f->buffer + f->printed,1,write_count,logfile); - } - /* don't write to user if they're seeing it already, */ - /* that is, typing it! */ - if (loguser && !exp_is_stdinfd(*m) && !exp_is_devttyfd(*m)) - fwrite(f->buffer + f->printed, - 1,write_count,stdout); - if (debugfile) fwrite(f->buffer + f->printed, - 1,write_count,debugfile); - - /* remove 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 (f->rm_nulls) { - f->size -= rm_nulls(f->buffer + f->printed,write_count); - } - f->buffer[f->size] = '\0'; - - /* copy to lowercase buffer */ - exp_lowmemcpy(f->lower+f->printed, - f->buffer+f->printed, - 1 + f->size - f->printed); - - f->printed = f->size; /* count'm even if not logging */ - } - return(cc); + 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)); + 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,Tcl_GetString(esPtr->buffer) + esPtr->printed); + + /* + * 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->buffer,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(interp,f,save_flags,array_name,caller_name) +exp_buffer_shuffle(interp,esPtr,save_flags,array_name,caller_name) /* INTL */ Tcl_Interp *interp; -struct exp_f *f; +ExpState *esPtr; int save_flags; char *array_name; char *caller_name; { - char spawn_id[10]; /* enough for a %d */ - char match_char; /* place to hold char temporarily */ - /* uprooted by a NULL */ - - int first_half = f->size/2; - int second_half = f->size - first_half; - - /* - * allow user to see data we are discarding - */ - - sprintf(spawn_id,"%d",f-exp_fs); - debuglog("%s: set %s(spawn_id) \"%s\"\r\n", - caller_name,array_name,dprintify(spawn_id)); - Tcl_SetVar2(interp,array_name,"spawn_id",spawn_id,save_flags); - - /* temporarily null-terminate buffer in middle */ - match_char = f->buffer[first_half]; - f->buffer[first_half] = 0; - - debuglog("%s: set %s(buffer) \"%s\"\r\n", - caller_name,array_name,dprintify(f->buffer)); - Tcl_SetVar2(interp,array_name,"buffer",f->buffer,save_flags); - - /* remove middle-null-terminator */ - f->buffer[first_half] = match_char; - - memcpy(f->buffer,f->buffer+first_half,second_half); - memcpy(f->lower, f->lower +first_half,second_half); - f->size = second_half; - f->printed -= first_half; - if (f->printed < 0) f->printed = 0; + char *str; + char *middleGuess; + char *p; + int length, newlen; + int skiplen; + char lostByte; + + /* + * 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. + */ + + if (Tcl_IsShared(esPtr->buffer)) { + panic("exp_buffer_shuffle called with shared buffer object"); + } + + str = Tcl_GetStringFromObj(esPtr->buffer,&length); + + /* guess at the middle */ + middleGuess = str + length/2; + + /* crawl our way into the middle of the string + * to make sure we are at a UTF char boundary + */ + for (p=str;*p;p = Tcl_UtfNext(p)) { + if (p > middleGuess) break; /* ok, that's enough */ + } + + /* + * p is now at the beginning of a UTF char in the middle of the string + */ + + /* + * before doing move, show user data we are discarding + */ + skiplen = p-str; + lostByte = *p; + /* temporarily stick null in middle of string */ + Tcl_SetObjLength(esPtr->buffer,skiplen); + + expDiagLog("%s: set %s(buffer) \"",caller_name,array_name); + expDiagLogU(expPrintify(Tcl_GetString(esPtr->buffer))); + expDiagLogU("\"\r\n"); + Tcl_SetVar2(interp,array_name,"buffer",Tcl_GetString(esPtr->buffer), + save_flags); + + /* + * restore damage + */ + *p = lostByte; + + /* + * move 2nd half of string down to 1st half + */ + + newlen = length - skiplen; + memmove(str,p, newlen); + + Tcl_SetObjLength(esPtr->buffer,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 @@ -1645,68 +1910,10 @@ case EXP_TCLCNTTIMER: return EXP_CONTINUE_TIMER; case EXP_TCLRETTCL: return EXP_TCL_RETURN; } } -/* returns # of chars 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 -exp_i_read(interp,m,timeout,save_flags) -Tcl_Interp *interp; -int m; -int timeout; -int save_flags; -{ - struct exp_f *f; - int cc = EXP_TIMEOUT; - - f = exp_fs + m; - if (f->size == f->msize) - exp_buffer_shuffle(interp,f,save_flags,EXPECT_OUT,"expect"); - -#ifdef SIMPLE_EVENT - restart: - - alarm_fired = FALSE; - - if (timeout > -1) { - signal(SIGALRM,sigalarm_handler); - alarm((timeout > 0)?timeout:1); - } -#endif - - cc = read(m,f->buffer+f->size, f->msize-f->size); - i_read_errno = errno; - -#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)); - } - if (!f->valid) { - exp_error(interp,"spawn_id %d no longer valid",f-exp_fs); - return EXP_TCLERROR; - } - goto restart; - } - } - } -#endif - return(cc); -} - /* 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. */ @@ -1713,62 +1920,62 @@ char * exp_get_var(interp,var) Tcl_Interp *interp; char *var; { - char *val; + char *val; - if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */))) - return(val); - return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY)); + if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */))) + return(val); + return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY)); } static int get_timeout(interp) Tcl_Interp *interp; { - static int timeout = INIT_EXPECT_TIMEOUT; - char *t; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + char *t; - if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) { - timeout = atoi(t); - } - return(timeout); + 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_fds(i_list,fd_union) +update_expect_states(i_list,i_union) struct exp_i *i_list; -struct exp_fd_list **fd_union; -{ - struct exp_i *p; - - /* for each i_list in an expect statement ... */ - for (p=i_list;p;p=p->next) { - struct exp_fd_list *fdl; - - /* for each fd in the i_list */ - for (fdl=p->fd_list;fdl;fdl=fdl->next) { - struct exp_fd_list *tmpfdl; - struct exp_fd_list *u; - - if (fdl->fd == EXP_SPAWN_ID_ANY) continue; - - /* check this one against all so far */ - for (u = *fd_union;u;u=u->next) { - if (fdl->fd == u->fd) goto found; - } - /* if not found, link in as head of list */ - tmpfdl = exp_new_fd(fdl->fd); - tmpfdl->next = *fd_union; - *fd_union = tmpfdl; - found:; - } - } - return TCL_OK; +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(cmdtype) int cmdtype; @@ -1799,11 +2006,11 @@ 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_filehandlers_run_all(); + exp_background_channelhandlers_run_all(); return msg; } static char * @@ -1810,33 +2017,38 @@ exp_indirect_update1(interp,ecmd,exp_i) Tcl_Interp *interp; struct exp_cmd_descriptor *ecmd; struct exp_i *exp_i; { - struct exp_fd_list *fdl; /* temp for interating over fd_list */ + struct exp_state_list *slPtr; /* temp for interating over state_list */ /* - * disarm any fd's that lose all their ecases + * disarm any ExpState's that lose all their ecases */ if (ecmd->cmdtype == EXP_CMD_BG) { /* clean up each spawn id used by this exp_i */ - for (fdl=exp_i->fd_list;fdl;fdl=fdl->next) { - int m = fdl->fd; + for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) { + ExpState *esPtr = slPtr->esPtr; - if (m == EXP_SPAWN_ID_ANY) continue; + 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 (!exp_fd2f(interp,fdl->fd,1,0,"")) continue; + if (!expStateCheck(interp,slPtr->esPtr,1,0,"")) continue; - exp_fs[m].bg_ecount--; - if (exp_fs[m].bg_ecount == 0) { - exp_disarm_background_filehandler(m); - exp_fs[m].bg_interp = 0; + /* 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; } } } /* @@ -1847,770 +2059,545 @@ /* * check validity of all fd's in variable */ - for (fdl=exp_i->fd_list;fdl;fdl=fdl->next) { - /* validate all input descriptors */ - if (fdl->fd == EXP_SPAWN_ID_ANY) continue; - - if (!exp_fd2f(interp,fdl->fd,1,1, - exp_cmdtype_printable(ecmd->cmdtype))) { - static char msg[200]; - sprintf(msg,"%s from indirect variable (%s)", - interp->result,exp_i->variable); - return msg; - } + 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))) { + static char msg[200]; + sprintf(msg,"%s from indirect variable (%s)", + interp->result,exp_i->variable); + return msg; + } } /* for each spawn id in list, arm if necessary */ if (ecmd->cmdtype == EXP_CMD_BG) { - fd_list_arm(interp,exp_i->fd_list); + state_list_arm(interp,exp_i->state_list); } return (char *)0; } -void -exp_background_filehandlers_run_all() -{ - int m; - struct exp_f *f; - - /* kick off any that already have input waiting */ - for (m=0;m<=exp_fd_max;m++) { - f = exp_fs + m; - if (!f->valid) continue; - - /* is bg_interp the best way to check if armed? */ - if (f->bg_interp && (f->size > 0)) { - exp_background_filehandler((ClientData)f->fd_ptr,0/*ignored*/); - } - } +int +expMatchProcess(interp, eo, cc, bg, detail) + 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_Obj *buffer; + struct ecase *e = 0; /* points to current ecase */ + int match = -1; /* characters matched */ + char match_char; /* place to hold char temporarily */ + /* 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)); + + if (eo->e) { + e = eo->e; + body = e->body; + if (cc != EXP_TIMEOUT) { + esPtr = eo->esPtr; + match = eo->match; + buffer = eo->buffer; + } + } else if (cc == EXP_EOF) { + /* read an eof but no user-supplied case */ + esPtr = eo->esPtr; + match = eo->match; + buffer = eo->buffer; + } + + if (match >= 0) { + char name[20], value[20]; + int i; + + if (e && e->use == PAT_RE) { + Tcl_RegExp re; + int flags; + Tcl_RegExpInfo info; + + 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); + + 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(buffer, 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)); + } + } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) { + char *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 = Tcl_GetString(esPtr->buffer) + e->simple_start; + /* temporarily null-terminate in middle */ + match_char = str[match]; + str[match] = 0; + out("0,string",str); + str[match] = match_char; + + /* 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 */ + /* that an EOF occurred with match == 0 */ + if (eo->esPtr) { + char *str; + int length; + + out("spawn_id",esPtr->name); + + str = Tcl_GetStringFromObj(esPtr->buffer, &length); + /* Save buf[0..match] */ + /* temporarily null-terminate string in middle */ + match_char = str[match]; + str[match] = 0; + out("buffer",str); + /* remove middle-null-terminator */ + str[match] = match_char; + + /* "!e" means no case matched - transfer by default */ + if (!e || e->transfer) { + /* delete matched chars from input buffer */ + esPtr->printed -= match; + if (length != 0) { + memmove(str,str+match,length-match); + } + Tcl_SetObjLength(esPtr->buffer, length-match); + } + + if (cc == EXP_EOF) { + /* exp_close() deletes all background bodies */ + /* so save eof body temporarily */ + if (body) Tcl_IncrRefCount(body); + 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_filehandler(clientData,mask) +exp_background_channelhandler(clientData,mask) /* INTL */ ClientData clientData; int mask; { - int m; - - Tcl_Interp *interp; - int cc; /* number of chars returned in a single read */ + ExpState *esPtr; + Tcl_Interp *interp; + int cc; /* number of bytes returned in a single read */ /* or negative EXP_whatever */ - struct exp_f *f; /* file associated with master */ - - int i; /* trusty temporary */ - - struct eval_out eo; /* final case of interest */ - struct exp_f *last_f; /* for differentiating when multiple f's */ + 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 */ - m = *(int *)clientData; - f = exp_fs + m; - interp = f->bg_interp; - - /* temporarily prevent this handler from being invoked again */ - exp_block_background_filehandler(m); - - /* 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 { - cc = expect_read(interp,(int *)0,mask,&m,EXP_TIME_INFINITY,0); - } + int last_case; /* as above but for case */ + + /* restore our environment */ + esPtr = (ExpState *)clientData; + 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.f = 0; /* no final file selected yet */ - eo.match = 0; /* nothing matched yet */ - - /* force redisplay of buffer when debugging */ - last_f = 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], - m,&eo,&last_f,&last_case,cc,&m,1,"_background"); - cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG], - m,&eo,&last_f,&last_case,cc,&m,1,"_background"); - cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], - m,&eo,&last_f,&last_case,cc,&m,1,"_background"); - if (cc == EXP_TCLERROR) { + eo.e = 0; /* no final case yet */ + eo.esPtr = 0; /* no final file selected yet */ + eo.match = 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.f = exp_fs + m; - eo.match = eo.f->size; - eo.buffer = eo.f->buffer; - debuglog("expect_background: read eof\r\n"); - goto matched; - } - if (!eo.e) { - /* if we get here, there must not have been a match */ - 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.match = expSizeGet(eo.esPtr); + eo.buffer = eo.esPtr->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: -#define out(i,val) debuglog("expect_background: set %s(%s) \"%s\"\r\n",EXPECT_OUT,i, \ - dprintify(val)); \ - Tcl_SetVar2(interp,EXPECT_OUT,i,val,TCL_GLOBAL_ONLY); - { -/* int iwrite = FALSE;*/ /* write spawn_id? */ - char *body = 0; - char *buffer; /* pointer to normal or lowercased data */ - struct ecase *e = 0; /* points to current ecase */ - int match = -1; /* characters matched */ - char match_char; /* place to hold char temporarily */ - /* uprooted by a NULL */ - char *eof_body = 0; - - if (eo.e) { - e = eo.e; - body = e->body; -/* iwrite = e->iwrite;*/ - if (cc != EXP_TIMEOUT) { - f = eo.f; - match = eo.match; - buffer = eo.buffer; - } -#if 0 - if (e->timestamp) { - char value[20]; - - time(¤t_time); - elapsed_time = current_time - start_time; - elapsed_time_total = current_time - start_time_total; - sprintf(value,"%d",elapsed_time); - out("seconds",value); - sprintf(value,"%d",elapsed_time_total); - out("seconds_total",value); - /* deprecated */ - exp_timestamp(interp,¤t_time,EXPECT_OUT); - } -#endif - } else if (cc == EXP_EOF) { - /* read an eof but no user-supplied case */ - f = eo.f; - match = eo.match; - buffer = eo.buffer; - } - - if (match >= 0) { - char name[20], value[20]; - - if (e && e->use == PAT_RE) { - regexp *re = e->re; - - for (i=0;istartp[i] == 0) continue; - - if (e->indices) { - /* start index */ - sprintf(name,"%d,start",i); - offset = re->startp[i]-buffer; - sprintf(value,"%d",offset); - out(name,value); - - /* end index */ - sprintf(name,"%d,end",i); - sprintf(value,"%d", - re->endp[i]-buffer-1); - out(name,value); - } - - /* string itself */ - sprintf(name,"%d,string",i); - - /* temporarily null-terminate in */ - /* middle */ - match_char = *re->endp[i]; - *re->endp[i] = 0; - out(name,re->startp[i]); - *re->endp[i] = match_char; - } - /* redefine length of string that */ - /* matched for later extraction */ - match = re->endp[0]-buffer; - } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) { - char *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 = f->buffer + e->simple_start; - /* temporarily null-terminate in middle */ - match_char = str[match]; - str[match] = 0; - out("0,string",str); - str[match] = match_char; - - /* 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) { - debuglog("expect_background: full buffer\r\n"); - } - } - - /* this is broken out of (match > 0) (above) since it can */ - /* that an EOF occurred with match == 0 */ - if (eo.f) { - char spawn_id[10]; /* enough for a %d */ - -/* if (iwrite) {*/ - sprintf(spawn_id,"%d",f-exp_fs); - out("spawn_id",spawn_id); -/* }*/ - - /* save buf[0..match] */ - /* temporarily null-terminate string in middle */ - match_char = f->buffer[match]; - f->buffer[match] = 0; - out("buffer",f->buffer); - /* remove middle-null-terminator */ - f->buffer[match] = match_char; - - /* "!e" means no case matched - transfer by default */ - if (!e || e->transfer) { - /* delete matched chars from input buffer */ - f->size -= match; - f->printed -= match; - if (f->size != 0) { - memmove(f->buffer,f->buffer+match,f->size); - memmove(f->lower,f->lower+match,f->size); - } - f->buffer[f->size] = '\0'; - f->lower[f->size] = '\0'; - } - - if (cc == EXP_EOF) { - /* exp_close() deletes all background bodies */ - /* so save eof body temporarily */ - if (body) { - eof_body = ckalloc(strlen(body)+1); - strcpy(eof_body,body); - body = eof_body; - } - - exp_close(interp,f - exp_fs); - } - - } - - if (body) { - int result = Tcl_GlobalEval(interp,body); - if (result != TCL_OK) Tcl_BackgroundError(interp); - - if (eof_body) ckfree(eof_body); - } - - - /* - * 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. - */ - if (exp_fs[m].valid && (exp_fs[m].bg_status == blocked) - && (f->size > 0)) { - cc = f->size; - goto do_more_data; - } - } + 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. + */ + + if ((!esPtr->freeWhenBgHandlerUnblocked) && (esPtr->bg_status == blocked)) { + if (0 != (cc = expSizeGet(esPtr))) { + goto do_more_data; + } + } finish: - /* fd could have gone away, so check before using */ - if (exp_fs[m].valid) - exp_unblock_background_filehandler(m); + exp_unblock_background_channelhandler(esPtr); + if (esPtr->freeWhenBgHandlerUnblocked) + expStateFree(esPtr); } -#undef out /*ARGSUSED*/ int -Exp_ExpectCmd(clientData, interp, argc, argv) +Exp_ExpectObjCmd(clientData, interp, objc, objv) ClientData clientData; Tcl_Interp *interp; -int argc; -char **argv; +int objc; +Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int cc; /* number of chars returned in a single read */ + int cc; /* number of chars returned in a single read */ /* or negative EXP_whatever */ - int m; /* before doing an actual read, attempt */ - /* to match upon any spawn_id */ - struct exp_f *f; /* file associated with master */ - - int i; /* trusty temporary */ - struct exp_cmd_descriptor eg; - struct exp_fd_list *fd_list; /* list of masters to watch */ - struct exp_fd_list *fdl; /* temp for interating over fd_list */ - int *masters; /* array of masters to watch */ - int mcount; /* number of masters 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 */ - time_t elapsed_time_total;/* time from now to match/fail/timeout */ - time_t elapsed_time; /* time from restart to (ditto) */ - - struct exp_f *last_f; /* for differentiating when multiple f's */ + 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? */ - - if ((argc == 2) && exp_one_arg_braced(argv[1])) { - return(exp_eval_with_one_arg(clientData,interp,argv)); - } else if ((argc == 3) && streq(argv[1],"-brace")) { - char *new_argv[2]; - new_argv[0] = argv[0]; - new_argv[1] = argv[2]; - return(exp_eval_with_one_arg(clientData,interp,new_argv)); - } - - time(&start_time_total); - start_time = start_time_total; - reset_timer = TRUE; - - /* make arg list for processing cases */ - /* do it dynamically, since expect can be called recursively */ - - exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY); - fd_list = 0; - masters = 0; - if (TCL_ERROR == parse_expect_args(interp,&eg, - *(int *)clientData,argc,argv)) - return TCL_ERROR; + 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? */ + + if ((objc == 2) && exp_one_arg_braced(objv[1])) { + return(exp_eval_with_one_arg(clientData,interp,objv)); + } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) { + Tcl_Obj *new_objv[2]; + new_objv[0] = objv[0]; + new_objv[1] = objv[2]; + return(exp_eval_with_one_arg(clientData,interp,new_objv)); + } + + time(&start_time_total); + 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)) + return TCL_ERROR; restart_with_update: - /* validate all descriptors */ - /* and flatten fds into array */ - - if ((TCL_ERROR == update_expect_fds(exp_cmds[EXP_CMD_BEFORE].i_list,&fd_list)) - || (TCL_ERROR == update_expect_fds(exp_cmds[EXP_CMD_AFTER].i_list, &fd_list)) - || (TCL_ERROR == update_expect_fds(eg.i_list,&fd_list))) { - result = TCL_ERROR; - goto cleanup; - } - - /* declare ourselves "in sync" with external view of close/indirect */ - configure_count = exp_configure_count; - - /* count and validate fd_list */ - mcount = 0; - for (fdl=fd_list;fdl;fdl=fdl->next) { - mcount++; - /* validate all input descriptors */ - if (!exp_fd2f(interp,fdl->fd,1,1,"expect")) { - result = TCL_ERROR; - goto cleanup; - } - } - - /* make into an array */ - masters = (int *)ckalloc(mcount * sizeof(int)); - for (fdl=fd_list,i=0;fdl;fdl=fdl->next,i++) { - masters[i] = fdl->fd; - } - - restart: - if (first_time) first_time = 0; - else time(&start_time); - - 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_f = 0; - - /* end of restart code */ - - eo.e = 0; /* no final case yet */ - eo.f = 0; /* no final file selected yet */ - eo.match = 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) { - time(¤t_time); - 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 = expect_read(interp,masters,mcount,&m,remtime,key); - } - - /*SUPPRESS 530*/ - if (cc == EXP_EOF) { - /* do nothing */ - } else if (cc == EXP_TIMEOUT) { - debuglog("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 */ - - f = exp_fs + m; - - /* below here, cc as general status */ - cc = EXP_NOMATCH; - - /* force redisplay of buffer when debugging */ - last_f = 0; - } - - cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE], - m,&eo,&last_f,&last_case,cc,masters,mcount,""); - cc = eval_cases(interp,&eg, - m,&eo,&last_f,&last_case,cc,masters,mcount,""); - cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], - m,&eo,&last_f,&last_case,cc,masters,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.f = exp_fs + m; - eo.match = eo.f->size; - eo.buffer = eo.f->buffer; - debuglog("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 */ - f->force_read = TRUE; - - if (timeout != EXP_TIME_INFINITY) { - time(¤t_time); - remtime = end_time - current_time; - } - } - - goto done; + /* 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 time(&start_time); + + 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.match = 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) { + time(¤t_time); + 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.match = expSizeGet(eo.esPtr); + eo.buffer = eo.esPtr->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) { + time(¤t_time); + remtime = end_time - current_time; + } + } + + goto done; error: - result = exp_2tcl_returnvalue(cc); + result = exp_2tcl_returnvalue(cc); done: -#define out(i,val) debuglog("expect: set %s(%s) \"%s\"\r\n",EXPECT_OUT,i, \ - dprintify(val)); \ - Tcl_SetVar2(interp,EXPECT_OUT,i,val,0); - - if (result != TCL_ERROR) { -/* int iwrite = FALSE;*/ /* write spawn_id? */ - char *body = 0; - char *buffer; /* pointer to normal or lowercased data */ - struct ecase *e = 0; /* points to current ecase */ - int match = -1; /* characters matched */ - char match_char; /* place to hold char temporarily */ - /* uprooted by a NULL */ - char *eof_body = 0; - - if (eo.e) { - e = eo.e; - body = e->body; -/* iwrite = e->iwrite;*/ - if (cc != EXP_TIMEOUT) { - f = eo.f; - match = eo.match; - buffer = eo.buffer; - } - if (e->timestamp) { - char value[20]; - - time(¤t_time); - elapsed_time = current_time - start_time; - elapsed_time_total = current_time - start_time_total; - sprintf(value,"%d",elapsed_time); - out("seconds",value); - sprintf(value,"%d",elapsed_time_total); - out("seconds_total",value); - - /* deprecated */ - exp_timestamp(interp,¤t_time,EXPECT_OUT); - } - } else if (cc == EXP_EOF) { - /* read an eof but no user-supplied case */ - f = eo.f; - match = eo.match; - buffer = eo.buffer; - } - - if (match >= 0) { - char name[20], value[20]; - - if (e && e->use == PAT_RE) { - regexp *re = e->re; - - for (i=0;istartp[i] == 0) continue; - - if (e->indices) { - /* start index */ - sprintf(name,"%d,start",i); - offset = re->startp[i]-buffer; - sprintf(value,"%d",offset); - out(name,value); - - /* end index */ - sprintf(name,"%d,end",i); - sprintf(value,"%d", - re->endp[i]-buffer-1); - out(name,value); - } - - /* string itself */ - sprintf(name,"%d,string",i); - - /* temporarily null-terminate in */ - /* middle */ - match_char = *re->endp[i]; - *re->endp[i] = 0; - out(name,re->startp[i]); - *re->endp[i] = match_char; - } - /* redefine length of string that */ - /* matched for later extraction */ - match = re->endp[0]-buffer; - } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) { - char *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 = f->buffer + e->simple_start; - /* temporarily null-terminate in middle */ - match_char = str[match]; - str[match] = 0; - out("0,string",str); - str[match] = match_char; - - /* 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) { - debuglog("expect: full buffer\r\n"); - } - } - - /* this is broken out of (match > 0) (above) since it can */ - /* that an EOF occurred with match == 0 */ - if (eo.f) { - char spawn_id[10]; /* enough for a %d */ - -/* if (iwrite) {*/ - sprintf(spawn_id,"%d",f-exp_fs); - out("spawn_id",spawn_id); -/* }*/ - - /* save buf[0..match] */ - /* temporarily null-terminate string in middle */ - match_char = f->buffer[match]; - f->buffer[match] = 0; - out("buffer",f->buffer); - /* remove middle-null-terminator */ - f->buffer[match] = match_char; - - /* "!e" means no case matched - transfer by default */ - if (!e || e->transfer) { - /* delete matched chars from input buffer */ - f->size -= match; - f->printed -= match; - if (f->size != 0) { - memmove(f->buffer,f->buffer+match,f->size); - memmove(f->lower,f->lower+match,f->size); - } - f->buffer[f->size] = '\0'; - f->lower[f->size] = '\0'; - } - - if (cc == EXP_EOF) { - /* exp_close() deletes all background bodies */ - /* so save eof body temporarily */ - if (body) { - eof_body = ckalloc(strlen(body)+1); - strcpy(eof_body,body); - body = eof_body; - } - - exp_close(interp,f - exp_fs); - } - - } - - if (body) { - result = Tcl_Eval(interp,body); - - if (eof_body) ckfree(eof_body); - } - } + 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)) { - debuglog("expect: continuing expect\r\n"); - goto restart; - } - - if (fd_list) { - exp_free_fd(fd_list); - fd_list = 0; - } - if (masters) { - ckfree((char *)masters); - masters = 0; - } - - if (result == EXP_CONTINUE) { - debuglog("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); - - return(result); -} -#undef out - -/* beginning of deprecated code */ - -#define out(elt) Tcl_SetVar2(interp,array,elt,ascii,0); -void -exp_timestamp(interp,timeval,array) -Tcl_Interp *interp; -time_t *timeval; -char *array; -{ - struct tm *tm; - char *ascii; - - tm = localtime(timeval); /* split */ - ascii = asctime(tm); /* print */ - ascii[24] = '\0'; /* zap trailing \n */ - - out("timestamp"); - - sprintf(ascii,"%ld",*timeval); - out("epoch"); - - sprintf(ascii,"%d",tm->tm_sec); - out("sec"); - sprintf(ascii,"%d",tm->tm_min); - out("min"); - sprintf(ascii,"%d",tm->tm_hour); - out("hour"); - sprintf(ascii,"%d",tm->tm_mday); - out("mday"); - sprintf(ascii,"%d",tm->tm_mon); - out("mon"); - sprintf(ascii,"%d",tm->tm_year); - out("year"); - sprintf(ascii,"%d",tm->tm_wday); - out("wday"); - sprintf(ascii,"%d",tm->tm_yday); - out("yday"); - sprintf(ascii,"%d",tm->tm_isdst); - out("isdst"); -} -/* end of deprecated code */ + 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); + + return(result); +} /*ARGSUSED*/ static int Exp_TimestampCmd(clientData, interp, argc, argv) ClientData clientData; @@ -2669,90 +2656,84 @@ exp_error(interp,"args: [-seconds #] [-format format]"); return TCL_ERROR; } -/* lowmemcpy - like memcpy but it lowercases result */ -void -exp_lowmemcpy(dest,src,n) -char *dest; -char *src; -int n; -{ - for (;n>0;n--) { - *dest = ((isascii(*src) && isupper(*src))?tolower(*src):*src); - src++; dest++; - } -} - /*ARGSUSED*/ int Exp_MatchMaxCmd(clientData,interp,argc,argv) ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - int size = -1; - int m = -1; - struct exp_f *f; - int Default = FALSE; - - argc--; argv++; - - for (;argc>0;argc--,argv++) { - if (streq(*argv,"-d")) { - Default = TRUE; - } else if (streq(*argv,"-i")) { - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-i needs argument"); - return(TCL_ERROR); - } - m = atoi(*argv); - } else break; - } - - if (!Default) { - if (m == -1) { - if (!(f = exp_update_master(interp,&m,0,0))) - return(TCL_ERROR); - } else { - if (!(f = exp_fd2f(interp,m,0,0,"match_max"))) - return(TCL_ERROR); - } - } else if (m != -1) { - exp_error(interp,"cannot do -d and -i at the same time"); - return(TCL_ERROR); - } - - if (argc == 0) { - if (Default) { - size = exp_default_match_max; - } else { - size = f->umsize; - } - sprintf(interp->result,"%d",size); - return(TCL_OK); - } - - if (argc > 1) { - exp_error(interp,"too many arguments"); - return(TCL_OK); - } - - /* all that's left is to set the size */ - size = atoi(argv[0]); - if (size <= 0) { - exp_error(interp,"must be positive"); - return(TCL_ERROR); - } - - if (Default) exp_default_match_max = size; - else f->umsize = size; - - return(TCL_OK); + int size = -1; + ExpState *esPtr = 0; + char *chanName = 0; + int Default = FALSE; + + argc--; argv++; + + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-d")) { + Default = TRUE; + } else if (streq(*argv,"-i")) { + argc--;argv++; + if (argc < 1) { + exp_error(interp,"-i needs argument"); + return(TCL_ERROR); + } + chanName = *argv; + } else break; + } + + if (Default && chanName) { + exp_error(interp,"cannot do -d and -i at the same time"); + return(TCL_ERROR); + } + + if (!Default) { + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,0,0,0))) { + return(TCL_ERROR); + } + } else { + + if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"match_max"))) + return(TCL_ERROR); + } + } + + if (argc == 0) { + if (Default) { + size = exp_default_match_max; + } else { + size = esPtr->umsize; + } + sprintf(interp->result,"%d",size); + return(TCL_OK); + } + + if (argc > 1) { + exp_error(interp,"too many arguments"); + return(TCL_OK); + } + + /* + * All that's left is to set the size + */ + + size = atoi(argv[0]); + 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_RemoveNullsCmd(clientData,interp,argc,argv) @@ -2759,69 +2740,71 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - int value = -1; - int m = -1; - struct exp_f *f; - int Default = FALSE; - - argc--; argv++; - - for (;argc>0;argc--,argv++) { - if (streq(*argv,"-d")) { - Default = TRUE; - } else if (streq(*argv,"-i")) { - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-i needs argument"); - return(TCL_ERROR); - } - m = atoi(*argv); - } else break; - } - - if (!Default) { - if (m == -1) { - if (!(f = exp_update_master(interp,&m,0,0))) - return(TCL_ERROR); - } else { - if (!(f = exp_fd2f(interp,m,0,0,"remove_nulls"))) - return(TCL_ERROR); - } - } else if (m != -1) { - exp_error(interp,"cannot do -d and -i at the same time"); - return(TCL_ERROR); - } - - if (argc == 0) { - if (Default) { - value = exp_default_match_max; - } else { - value = f->rm_nulls; - } - sprintf(interp->result,"%d",value); - return(TCL_OK); - } - - if (argc > 1) { - exp_error(interp,"too many arguments"); - return(TCL_OK); - } - - /* all that's left is to set the value */ - value = atoi(argv[0]); - if (value != 0 && value != 1) { - exp_error(interp,"must be 0 or 1"); - return(TCL_ERROR); - } - - if (Default) exp_default_rm_nulls = value; - else f->rm_nulls = value; - - return(TCL_OK); + int value = -1; + ExpState *esPtr = 0; + char *chanName = 0; + int Default = FALSE; + + argc--; argv++; + + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-d")) { + Default = TRUE; + } else if (streq(*argv,"-i")) { + argc--;argv++; + if (argc < 1) { + exp_error(interp,"-i needs argument"); + return(TCL_ERROR); + } + chanName = *argv; + } else break; + } + + if (Default && chanName) { + exp_error(interp,"cannot do -d and -i at the same time"); + return(TCL_ERROR); + } + + if (!Default) { + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,0,0,0))) + return(TCL_ERROR); + } else { + if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"remove_nulls"))) + return(TCL_ERROR); + } + } + + if (argc == 0) { + if (Default) { + value = exp_default_rm_nulls; + } else { + value = esPtr->rm_nulls; + } + sprintf(interp->result,"%d",value); + return(TCL_OK); + } + + if (argc > 1) { + exp_error(interp,"too many arguments"); + return(TCL_OK); + } + + /* all that's left is to set the value */ + value = atoi(argv[0]); + 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_ParityCmd(clientData,interp,argc,argv) @@ -2828,77 +2811,81 @@ ClientData clientData; Tcl_Interp *interp; int argc; char **argv; { - int parity; - int m = -1; - struct exp_f *f; - int Default = FALSE; - - argc--; argv++; - - for (;argc>0;argc--,argv++) { - if (streq(*argv,"-d")) { - Default = TRUE; - } else if (streq(*argv,"-i")) { - argc--;argv++; - if (argc < 1) { - exp_error(interp,"-i needs argument"); - return(TCL_ERROR); - } - m = atoi(*argv); - } else break; - } - - if (!Default) { - if (m == -1) { - if (!(f = exp_update_master(interp,&m,0,0))) - return(TCL_ERROR); - } else { - if (!(f = exp_fd2f(interp,m,0,0,"parity"))) - return(TCL_ERROR); - } - } else if (m != -1) { - exp_error(interp,"cannot do -d and -i at the same time"); - return(TCL_ERROR); - } - - if (argc == 0) { - if (Default) { - parity = exp_default_parity; - } else { - parity = f->parity; - } - sprintf(interp->result,"%d",parity); - return(TCL_OK); - } - - if (argc > 1) { - exp_error(interp,"too many arguments"); - return(TCL_OK); - } - - /* all that's left is to set the parity */ - parity = atoi(argv[0]); - - if (Default) exp_default_parity = parity; - else f->parity = parity; - - return(TCL_OK); + int parity; + ExpState *esPtr = 0; + char *chanName = 0; + int Default = FALSE; + + argc--; argv++; + + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-d")) { + Default = TRUE; + } else if (streq(*argv,"-i")) { + argc--;argv++; + if (argc < 1) { + exp_error(interp,"-i needs argument"); + return(TCL_ERROR); + } + chanName = *argv; + } else break; + } + + if (Default && chanName) { + exp_error(interp,"cannot do -d and -i at the same time"); + return(TCL_ERROR); + } + + if (!Default) { + if (!chanName) { + if (!(esPtr = expStateCurrent(interp,0,0,0))) { + return(TCL_ERROR); + } + } else { + if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"parity"))) { + return(TCL_ERROR); + } + } + } + + if (argc == 0) { + if (Default) { + parity = exp_default_parity; + } else { + parity = esPtr->parity; + } + sprintf(interp->result,"%d",parity); + return(TCL_OK); + } + + if (argc > 1) { + exp_error(interp,"too many arguments"); + return(TCL_OK); + } + + /* all that's left is to set the parity */ + parity = atoi(argv[0]); + + if (Default) exp_default_parity = parity; + else esPtr->parity = parity; + + return(TCL_OK); } #if DEBUG_PERM_ECASES /* This big chunk of code is just for debugging the permanent */ /* expect cases */ void -exp_fd_print(fdl) -struct exp_fd_list *fdl; +exp_fd_print(slPtr) +struct exp_state_list *slPtr; { - if (!fdl) return; - printf("%d ",fdl->fd); - exp_fd_print(fdl->next); + if (!slPtr) return; + printf("%d ",slPtr->esPtr); + exp_fd_print(slPtr->next); } void exp_i_print(exp_i) struct exp_i *exp_i; @@ -2909,12 +2896,12 @@ 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("fds: "); - exp_fd_print(exp_i->fd_list); printf("\n"); + printf("ExpStates: "); + exp_fd_print(exp_i->state_list); printf("\n"); exp_i_print(exp_i->next); } void exp_ecase_print(ecase) @@ -2964,36 +2951,41 @@ exp_cmds_print(); return TCL_OK; } #endif /*DEBUG_PERM_ECASES*/ -/* need address for passing into cmdExpect */ -static int spawn_id_bad = EXP_SPAWN_ID_BAD; -static int spawn_id_user = EXP_SPAWN_ID_USER; +void +expExpectVarsInit() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + tsdPtr->timeout = INIT_EXPECT_TIMEOUT; +} static struct exp_cmd_data cmd_data[] = { -{"expect", exp_proc(Exp_ExpectCmd), (ClientData)&spawn_id_bad, 0}, -{"expect_after",exp_proc(Exp_ExpectGlobalCmd),(ClientData)&exp_cmds[EXP_CMD_AFTER],0}, -{"expect_before",exp_proc(Exp_ExpectGlobalCmd),(ClientData)&exp_cmds[EXP_CMD_BEFORE],0}, -{"expect_user", exp_proc(Exp_ExpectCmd), (ClientData)&spawn_id_user, 0}, -{"expect_tty", exp_proc(Exp_ExpectCmd), (ClientData)&exp_dev_tty, 0}, -{"expect_background",exp_proc(Exp_ExpectGlobalCmd),(ClientData)&exp_cmds[EXP_CMD_BG],0}, +{"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_proc(Exp_MatchMaxCmd), 0, 0}, {"remove_nulls",exp_proc(Exp_RemoveNullsCmd), 0, 0}, -{"parity", exp_proc(Exp_ParityCmd), 0, 0}, +{"parity", exp_proc(Exp_ParityCmd), 0, 0}, {"timestamp", exp_proc(Exp_TimestampCmd), 0, 0}, {0}}; void exp_init_expect_cmds(interp) Tcl_Interp *interp; { exp_create_commands(interp,cmd_data); + + Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0); - Tcl_SetVar(interp,EXP_SPAWN_ID_ANY_VARNAME,EXP_SPAWN_ID_ANY_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); Index: expect.h ================================================================== --- expect.h +++ expect.h @@ -8,10 +8,386 @@ would appreciate credit if this program or parts of it are used. */ #ifndef _EXPECT_H #define _EXPECT_H + +#include +#include + +/* + * tcl.h -- + * + * This header file describes the externally-visible facilities + * of the Tcl interpreter. + * + * Copyright (c) 1987-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1993-1996 Lucent Technologies. + * Copyright (c) 1998-1999 Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: expect.h,v 5.29 2000/01/06 23:22:05 wart Exp $ + */ + +#ifndef _TCL +#define _TCL + +#ifndef __WIN32__ +# if defined(_WIN32) || defined(WIN32) +# define __WIN32__ +# endif +#endif + +#ifdef __WIN32__ +# ifndef STRICT +# define STRICT +# endif +# ifndef USE_PROTOTYPE +# define USE_PROTOTYPE 1 +# endif +# ifndef HAS_STDARG +# define HAS_STDARG 1 +# endif +# ifndef USE_PROTOTYPE +# define USE_PROTOTYPE 1 +# endif + +/* + * Under Windows we need to call Tcl_Alloc in all cases to avoid competing + * C run-time library issues. + */ + +# ifndef USE_TCLALLOC +# define USE_TCLALLOC 1 +# endif +#endif /* __WIN32__ */ + +/* + * The following definitions set up the proper options for Macintosh + * compilers. We use this method because there is no autoconf equivalent. + */ + +#ifdef MAC_TCL +# ifndef HAS_STDARG +# define HAS_STDARG 1 +# endif +# ifndef USE_TCLALLOC +# define USE_TCLALLOC 1 +# endif +# ifndef NO_STRERROR +# define NO_STRERROR 1 +# endif +#endif + +/* + * Utility macros: STRINGIFY takes an argument and wraps it in "" (double + * quotation marks), JOIN joins two arguments. + */ + +#define VERBATIM(x) x +#ifdef _MSC_VER +# define STRINGIFY(x) STRINGIFY1(x) +# define STRINGIFY1(x) #x +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +#else +# ifdef RESOURCE_INCLUDED +# define STRINGIFY(x) STRINGIFY1(x) +# define STRINGIFY1(x) #x +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +# else +# ifdef __STDC__ +# define STRINGIFY(x) #x +# define JOIN(a,b) a##b +# else +# define STRINGIFY(x) "x" +# define JOIN(a,b) VERBATIM(a)VERBATIM(b) +# endif +# endif +#endif + +/* + * A special definition used to allow this header file to be included + * in resource files so that they can get obtain version information from + * this file. Resource compilers don't like all the C stuff, like typedefs + * and procedure declarations, that occur below. + */ + +#ifndef RESOURCE_INCLUDED + +#ifndef BUFSIZ +#include +#endif + +/* + * Definitions that allow Tcl functions with variable numbers of + * arguments to be used with either varargs.h or stdarg.h. TCL_VARARGS + * is used in procedure prototypes. TCL_VARARGS_DEF is used to declare + * the arguments in a function definiton: it takes the type and name of + * the first argument and supplies the appropriate argument declaration + * string for use in the function definition. TCL_VARARGS_START + * initializes the va_list data structure and returns the first argument. + */ + +#if defined(__STDC__) || defined(HAS_STDARG) +# include + +# define TCL_VARARGS(type, name) (type name, ...) +# define TCL_VARARGS_DEF(type, name) (type name, ...) +# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) +#else +# include + +# ifdef __cplusplus +# define TCL_VARARGS(type, name) (type name, ...) +# define TCL_VARARGS_DEF(type, name) (type va_alist, ...) +# else +# define TCL_VARARGS(type, name) () +# define TCL_VARARGS_DEF(type, name) (va_alist) +# endif +# define TCL_VARARGS_START(type, name, list) \ + (va_start(list), va_arg(list, type)) +#endif + +/* + * Macros used to declare a function to be exported by a DLL. + * Used by Windows, maps to no-op declarations on non-Windows systems. + * The default build on windows is for a DLL, which causes the DLLIMPORT + * and DLLEXPORT macros to be nonempty. To build a static library, the + * macro STATIC_BUILD should be defined. + */ + +#ifdef STATIC_BUILD +# define DLLIMPORT +# define DLLEXPORT +#else +# if defined(__WIN32__) && (defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec))) +# define DLLIMPORT __declspec(dllimport) +# define DLLEXPORT __declspec(dllexport) +# else +# define DLLIMPORT +# define DLLEXPORT +# endif +#endif + +/* + * These macros are used to control whether functions are being declared for + * import or export. If a function is being declared while it is being built + * to be included in a shared library, then it should have the DLLEXPORT + * storage class. If is being declared for use by a module that is going to + * link against the shared library, then it should have the DLLIMPORT storage + * class. If the symbol is beind declared for a static build or for use from a + * stub library, then the storage class should be empty. + * + * The convention is that a macro called BUILD_xxxx, where xxxx is the + * name of a library we are building, is set on the compile line for sources + * that are to be placed in the library. When this macro is set, the + * storage class will be set to DLLEXPORT. At the end of the header file, the + * storage class will be reset to DLLIMPORt. + */ + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcl +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * Definitions that allow this header file to be used either with or + * without ANSI C features like function prototypes. */ + +#undef _ANSI_ARGS_ +#undef CONST + +#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE) +# define _USING_PROTOTYPES_ 1 +# define _ANSI_ARGS_(x) x +# define CONST const +#else +# define _ANSI_ARGS_(x) () +# define CONST +#endif + +#ifdef __cplusplus +# define EXTERN extern "C" TCL_STORAGE_CLASS +#else +# define EXTERN extern TCL_STORAGE_CLASS +#endif + +/* + * Macro to use instead of "void" for arguments that must have + * type "void *" in ANSI C; maps them to type "char *" in + * non-ANSI systems. + */ +#ifndef __WIN32__ +#ifndef VOID +# ifdef __STDC__ +# define VOID void +# else +# define VOID char +# endif +#endif +#else /* __WIN32__ */ +/* + * The following code is copied from winnt.h + */ +#ifndef VOID +#define VOID void +typedef char CHAR; +typedef short SHORT; +typedef long LONG; +#endif +#endif /* __WIN32__ */ + +/* + * Miscellaneous declarations. + */ + +#ifndef NULL +#define NULL 0 +#endif + +typedef struct Tcl_RegExp_ *Tcl_RegExp; + +/* + * The following declarations either map ckalloc and ckfree to + * malloc and free, or they map them to procedures with all sorts + * of debugging hooks defined in tclCkalloc.c. + */ + +#ifdef TCL_MEM_DEBUG + +# define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__) +# define Tcl_Free(x) Tcl_DbCkfree(x, __FILE__, __LINE__) +# define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__) +# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__) +# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__) +# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__) + +#else + +/* + * If USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of + * the native malloc/free. The only time USE_TCLALLOC should not be + * true is when compiling the Tcl/Tk libraries on Unix systems. In this + * case we can safely call the native malloc/free directly as a performance + * optimization. + */ + +# if USE_TCLALLOC +# define ckalloc(x) Tcl_Alloc(x) +# define ckfree(x) Tcl_Free(x) +# define ckrealloc(x,y) Tcl_Realloc(x,y) +# else +# define ckalloc(x) malloc(x) +# define ckfree(x) free(x) +# define ckrealloc(x,y) realloc(x,y) +# endif +# define Tcl_DumpActiveMemory(x) +# define Tcl_ValidateAllMemory(x,y) + +#endif /* !TCL_MEM_DEBUG */ + + +/* + * These function have been renamed. The old names are deprecated, but we + * define these macros for backwards compatibilty. + */ + +#define Tcl_Ckalloc Tcl_Alloc +#define Tcl_Ckfree Tcl_Free +#define Tcl_Ckrealloc Tcl_Realloc +#define Tcl_Return Tcl_SetResult +#define Tcl_TildeSubst Tcl_TranslateFileName + +/* + * In later releases, Tcl_Panic will be the correct name to use. For now + * we leave it as panic to avoid breaking existing binaries. + */ + +#define Tcl_Panic panic +#define Tcl_PanicVA panicVA + +#endif /* RESOURCE_INCLUDED */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* _TCL */ + +/* + * end of tcl.h definitions + */ + + +/* + * regexp definitions - from tcl8.0/tclRegexp.h + */ + +/* + * Definitions etc. for regexp(3) routines. + * + * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof], + * not the System V one. + * + * RCS: @(#) $Id: expect.h,v 5.29 2000/01/06 23:22:05 wart Exp $ + */ + +#ifndef _REGEXP +#define _REGEXP 1 + +#ifdef BUILD_tcl +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +#endif + +/* + * NSUBEXP must be at least 10, and no greater than 117 or the parser + * will not work properly. + */ + +#define NSUBEXP 20 + +typedef struct regexp { + char *startp[NSUBEXP]; + char *endp[NSUBEXP]; + char regstart; /* Internal use only. */ + char reganch; /* Internal use only. */ + char *regmust; /* Internal use only. */ + int regmlen; /* Internal use only. */ + char program[1]; /* Unwarranted chumminess with compiler. */ +} regexp; + +EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp)); +EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start)); +EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest)); +EXTERN void exp_TclRegError _ANSI_ARGS_((char *msg)); +EXTERN char *TclGetRegError _ANSI_ARGS_((void)); + +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* REGEXP */ + + +/* + * end of regexp definitions + */ + + +/* + * finally - expect-specific definitions + */ #include "expect_comm.h" enum exp_type { exp_end = 0, /* placeholder - no more cases */ @@ -48,18 +424,30 @@ EXTERN char *exp_stty_init; /* initial stty args */ EXTERN int exp_ttycopy; /* copy tty parms from /dev/tty */ EXTERN int exp_ttyinit; /* set tty parms to sane state */ EXTERN int exp_console; /* redirect console */ +#ifdef HAVE_SIGLONGJMP +EXTERN sigjmp_buf exp_readenv; /* for interruptable read() */ +#else EXTERN jmp_buf exp_readenv; /* for interruptable read() */ +#endif /* HAVE_SIGLONGJMP */ + EXTERN int exp_reading; /* whether we can longjmp or not */ #define EXP_ABORT 1 /* abort read */ #define EXP_RESTART 2 /* restart read */ +EXTERN int exp_is_debugging; +EXTERN int exp_loguser; + +EXTERN void (*exp_close_in_child)(); /* procedure to close files in child */ +EXTERN void exp_slave_control _ANSI_ARGS_((int,int)); EXTERN int exp_logfile_all; EXTERN FILE *exp_debugfile; EXTERN FILE *exp_logfile; +extern void exp_debuglog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); +extern void exp_errorlog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); EXTERN int exp_disconnect _ANSI_ARGS_((void)); EXTERN FILE *exp_popen _ANSI_ARGS_((char *command)); EXTERN void (*exp_child_exec_prelude) _ANSI_ARGS_((void)); Index: expect.man ================================================================== --- expect.man +++ expect.man @@ -368,11 +368,11 @@ The following fragment uses .B disconnect to continue running the script in the background. .nf - if [fork]!=0 exit + if {[fork]!=0} exit disconnect . . . .fi The following script reads a password, and then runs a program @@ -384,11 +384,11 @@ .nf send_user "password?\\ " expect_user -re "(.*)\\n" for {} 1 {} { - if [fork]!=0 {sleep 3600;continue} + if {[fork]!=0} {sleep 3600;continue} disconnect spawn priv_prog expect Password: send "$expect_out(1,string)\\r" . . . @@ -449,18 +449,22 @@ (or 0 if not specified) is returned as the exit status of .BR Expect . .B exit is implicitly executed if the end of the script is reached. .TP -.B exp_continue +\fBexp_continue\fR [-continue_timer] The command .B exp_continue allows .B expect itself to continue -executing rather than returning as it normally would. -(See +executing rather than returning as it normally would. By +default +.B exp_continue +resets the timeout timer. The +.I -continue_timer +flag prevents timer from being restarted. (See .B expect for more information.) .TP .BI exp_internal " [\-f file] value" causes further commands to send diagnostic information internal to @@ -781,11 +785,11 @@ .IP Normally, the matched output is discarded from Expect's internal buffers. This may be prevented by prefixing a pattern with the .B \-notransfer flag. This flag is especially useful in experimenting (and can be -abbreviated to "-n" for convenience while experimenting). +abbreviated to "-not" for convenience while experimenting). The spawn id associated with the matching output (or eof or full_buffer) is stored in .IR expect_out(spawn_id) . @@ -1250,11 +1254,11 @@ To restart it, send a continue signal (such as by "kill \-CONT "). If you really want to send a SIGSTOP to such a process (by ^Z), consider spawning csh first and then running your program. On the other hand, if you want to send a SIGSTOP to .B Expect -itself, first press the escape character, and then press ^Z. +itself, first call interpreter (perhaps by using an escape character), and then press ^Z. .IP String-body pairs can be used as a shorthand for avoiding having to enter the interpreter and execute commands interactively. The previous terminal mode is used while the body of a string-body pair is being executed. .IP @@ -1422,11 +1426,11 @@ It is possible to change the processes that are being interacted with by using indirect spawn ids. (Indirect spawn ids are described in the section on the expect command.) Indirect spawn ids may be specified with the -i, -u, -input, or -output flags. .TP -.B interpreter +.B interpreter " [args]" causes the user to be interactively prompted for .B Expect and Tcl commands. The result of each command is printed. .IP @@ -1464,10 +1468,16 @@ prompt may be set by defining a procedure called "prompt2". .IP During .BR interpreter , cooked mode is used, even if the its caller was using raw mode. +.IP +If stdin is closed, +.B interpreter +will return unless the +.B \-eof +flag is used, in which case the subsequent argument is invoked. .TP .BI log_file " [args] [[\-a] file]" If a filename is provided, .B log_file will record a transcript of the session (beginning at that point) in the file. @@ -1641,11 +1651,11 @@ flag declares that the string be sent to the named spawn_id. If the spawn_id is .IR user_spawn_id , and the terminal is in raw mode, newlines in the string are translated to return-newline -sequences so that they appear as it the terminal was in cooked mode. +sequences so that they appear as if the terminal was in cooked mode. The .B \-raw flag disables this translation. The @@ -1833,11 +1843,11 @@ If /dev/tty does not exist (such as in a cron, at, or batch script), then .I tty_spawn_id is not defined. This may be tested as: .nf - if [info vars tty_spawn_id] { + if {[info vars tty_spawn_id]} { # /dev/tty exists } else { # /dev/tty doesn't exist # probably in cron, batch, or at script } @@ -2157,11 +2167,11 @@ If you want to define your own trap on SIGINT but still trap to the debugger when it is running, use: .nf - if ![exp_debug] {trap mystuff SIGINT} + if {![exp_debug]} {trap mystuff SIGINT} .fi Alternatively, you can trap to the debugger using some other signal. .B trap @@ -2314,11 +2324,11 @@ .BR interact ) use a heuristic to decide if the list is actually one argument or many. The heuristic can fail only in the case when the list actually does represent a single argument which has multiple embedded \\n's with non-whitespace characters between them. This seems sufficiently improbable, -however the argument "-brace" can be used to force a single argument +however the argument "\-nobrace" can be used to force a single argument to be handled as a single argument. This could conceivably be used with machine-generated Expect code. .SH BUGS It was really tempting to name the program "sex" (for either "Smart EXec" or "Send-EXpect"), but good sense (or perhaps just Puritanism) prevailed. Index: expect_cf.h.in ================================================================== --- expect_cf.h.in +++ expect_cf.h.in @@ -3,10 +3,11 @@ */ #ifndef __EXPECT_CF_H__ #define __EXPECT_CF_H__ #undef NO_STDLIB_H /* Tcl requires this name */ +#undef NO_UNION_WAIT #undef HAVE_STDARG_H #undef HAVE_VARARGS_H #undef HAVE_STROPTS_H #undef HAVE_SYSCONF_H #undef HAVE_SYS_FCNTL_H @@ -24,10 +25,11 @@ #undef HAVE_TCGETS_OR_TCGETA_IN_TERMIOS_H #undef pid_t #undef RETSIGTYPE #undef TIME_WITH_SYS_TIME /* ok to include both time.h and sys/time.h */ +#undef SETPGRP_VOID /* if setpgrp takes 0 args */ /* * This section is for compile macros needed by * everything else. */ @@ -39,10 +41,11 @@ #undef HAVE_SYSCONF #undef SIMPLE_EVENT #undef HAVE_STRFTIME #undef HAVE_MEMMOVE #undef HAVE_TIMEZONE /* timezone() a la Pyramid */ +#undef HAVE_SIGLONGJMP #undef HAVE_STRCHR #ifndef HAVE_STRCHR #define strchr(s,c) index(s,c) #endif /* HAVE_STRCHR */ Index: expect_comm.h ================================================================== --- expect_comm.h +++ expect_comm.h @@ -8,112 +8,10 @@ */ #ifndef _EXPECT_COMM_H #define _EXPECT_COMM_H -#if 0 -#include "expect_cf.h" -#endif - -#include -#include - -/* since it's possible that the caller may include tcl.h before including - this file, we cannot include varargs/stdargs ourselves */ - -/* Much of the following stdarg/prototype support is taken from tcl.h - * (7.5) with modifications. What's going on here is that don't want - * to simply include tcl.h everywhere, because one of the files is the - * Tcl-less Expect library.) - */ - - -/* Definitions that allow Tcl functions with variable numbers of - * arguments to be used with either varargs.h or stdarg.h. - * TCL_VARARGS is used in procedure prototypes. TCL_VARARGS_DEF is - * used to declare the arguments in a function definiton: it takes the - * type and name of the first argument and supplies the appropriate - * argument declaration string for use in the function definition. - * TCL_VARARGS_START initializes the va_list data structure and - * returns the first argument. */ - -/* in Tcl 7.5, Tcl now supplies these definitions */ -#if !defined(TCL_VARARGS) -# if defined(__STDC__) || defined(HAVE_STDARG_H) -# include -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type name, ...) -# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) -# else -# include -# ifdef __cplusplus -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type va_alist, ...) -# else -# define TCL_VARARGS(type, name) () -# define TCL_VARARGS_DEF(type, name) (va_alist) -# endif -# define TCL_VARARGS_START(type, name, list) \ - (va_start(list), va_arg(list, type)) -# endif /* use stdarg.h */ - -/* - * Definitions that allow this header file to be used either with or - * without ANSI C features like function prototypes. - */ - -# undef _ANSI_ARGS_ -# undef CONST - -# if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE) -# define _USING_PROTOTYPES_ 1 -# define _ANSI_ARGS_(x) x -# define CONST const -# else -# define _ANSI_ARGS_(x) () -# define CONST -# endif - -# ifdef __cplusplus -# define EXTERN extern "C" -# else -# define EXTERN extern -# endif - -#endif /* defined(TCL_VARARGS) */ - -/* Arghhh! Tcl pulls in all of tcl.h in order to get the regexp funcs */ -/* Tcl offers us a way to avoid this: temporarily define _TCL. Here goes: */ - -#ifdef EXP_AVOID_INCLUDING_TCL_H -# ifdef _TCL -# define EXP__TCL_WAS_DEFINED -# else -# define _TCL -# endif -#endif - -#include "tclRegexp.h" - -/* clean up the mess */ -#ifdef EXP_AVOID_INCLUDING_TCL_H -# ifdef EXP__TCL_WAS_DEFINED -# undef EXP__TCL_WAS_DEFINED -# else -# undef _TCL -# endif -#endif - -#if 0 -/* moved to exp_int.h so expect_cf.h no longer needs to be installed */ -#ifdef NO_STDLIB_H -# include "../compat/stdlib.h" -#else -# include /* for malloc */ -#endif /*NO_STDLIB_H*/ -#endif - /* common return codes for Expect functions */ /* The library actually only uses TIMEOUT and EOF */ #define EXP_ABEOF -1 /* abnormal eof in Expect */ /* when in library, this define is not used. */ /* Instead "-1" is used literally in the */ @@ -141,32 +39,27 @@ #define EXP_TCLCNTEXP -24 #define EXP_TCLRETTCL -25 /* yet more TCL return codes */ /* Tcl does not safely provide a way to define the values of these, so */ -/* use ridiculously numbers for safety */ +/* use ridiculously different numbers for safety */ #define EXP_CONTINUE -101 /* continue expect command */ /* and restart timer */ #define EXP_CONTINUE_TIMER -102 /* continue expect command */ /* and continue timer */ #define EXP_TCL_RETURN -103 /* converted by interact */ /* and interpeter from */ /* inter_return into */ /* TCL_RETURN*/ -#define EXP_TIME_INFINITY -1 -#define EXP_SPAWN_ID_BAD -1 - -EXTERN int exp_is_debugging; -EXTERN int exp_loguser; -EXTERN int exp_disconnected; /* proc. disc'd from controlling tty */ - -EXTERN void (*exp_close_in_child)(); /* procedure to close files in child */ -EXTERN void exp_close_tcl_files(); /* deflt proc: close all Tcl's files */ - -EXTERN void exp_slave_control _ANSI_ARGS_((int,int)); +/* + * Everything below here should eventually be moved into expect.h + * and Expect-thread-safe variables. + */ EXTERN char *exp_pty_error; /* place to pass a string generated */ /* deep in the innards of the pty */ /* code but needed by anyone */ +EXTERN int exp_disconnected; /* proc. disc'd from controlling tty */ + #endif /* _EXPECT_COMM_H */ Index: expect_tcl.h ================================================================== --- expect_tcl.h +++ expect_tcl.h @@ -12,10 +12,18 @@ #ifndef _EXPECT_TCL_H #define _EXPECT_TCL_H #include "expect_comm.h" +/* + * This is a convenience macro used to initialize a thread local storage ptr. + * Stolen from tclInt.h + */ +#ifndef TCL_TSD_INIT +#define TCL_TSD_INIT(keyPtr) (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) +#endif + EXTERN int exp_cmdlinecmds; EXTERN int exp_interactive; EXTERN FILE *exp_cmdfile; EXTERN char *exp_cmdfilename; EXTERN int exp_getpid; /* pid of Expect itself */ @@ -26,22 +34,21 @@ EXTERN Tcl_Interp *exp_interp; #define Exp_Init Expect_Init EXTERN int Expect_Init _ANSI_ARGS_((Tcl_Interp *)); /* for Tcl_AppInit apps */ EXTERN void exp_parse_argv _ANSI_ARGS_((Tcl_Interp *,int argc,char **argv)); -EXTERN int exp_interpreter _ANSI_ARGS_((Tcl_Interp *)); +EXTERN int exp_interpreter _ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *)); EXTERN int exp_interpret_cmdfile _ANSI_ARGS_((Tcl_Interp *,FILE *)); EXTERN int exp_interpret_cmdfilename _ANSI_ARGS_((Tcl_Interp *,char *)); EXTERN void exp_interpret_rcfiles _ANSI_ARGS_((Tcl_Interp *,int my_rc,int sys_rc)); EXTERN char * exp_cook _ANSI_ARGS_((char *s,int *len)); -EXTERN void exp_close_on_exec _ANSI_ARGS_((int)); +EXTERN void expCloseOnExec _ANSI_ARGS_((int)); /* app-specific exit handler */ EXTERN void (*exp_app_exit)_ANSI_ARGS_((Tcl_Interp *)); -EXTERN void exp_exit _ANSI_ARGS_((Tcl_Interp *,int status)); EXTERN void exp_exit_handlers _ANSI_ARGS_((ClientData)); EXTERN void exp_error _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); #endif /* _EXPECT_TCL_H */ Index: fixline1 ================================================================== --- fixline1 +++ fixline1 @@ -7,7 +7,16 @@ #!expect ... #!../expect ... #!expectk ... #!foo/bar/expectk ... # -regsub "^#!(.*/)*(.*)" [gets stdin] "#!$argv/\\2" line1 +if {0} { + # Original scheme, but this can wire in a platform-specific path + regsub "^#!(.*/)*(.*)" [gets stdin] "#!$argv/\\2" line1 +} else { + set header "#!/bin/sh\n" + append header "# \\\n" + append header {exec expect "$0" ${1+"$@"}} + + regsub "^#!(.*/)*(.*)" [gets stdin] $header line1 +} puts -nonewline "$line1\n[read stdin]" Index: pty_sgttyb.c ================================================================== --- pty_sgttyb.c +++ pty_sgttyb.c @@ -24,11 +24,12 @@ #include "expect_cf.h" #include "exp_rename.h" #include "exp_tty_in.h" #include "exp_pty.h" -void debuglog(); +void expDiagLog(); +void expDiagLogU(); #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif @@ -157,16 +158,16 @@ /* code to allocate force expect to get a controlling tty */ /* even if it doesn't start with one (i.e., under cron). */ /* This code is not necessary, but helpful for testing odd things. */ if (exp_dev_tty == -1) { /* give ourselves a controlling tty */ - int master = getptymaster(); + int master = exp_getptymaster(); fcntl(master,F_SETFD,1); /* close-on-exec */ setpgrp(0,0); close(0); close(1); - getptyslave(exp_get_var(exp_interp,"stty_init")); + exp_getptyslave(exp_get_var(exp_interp,"stty_init")); close(2); fcntl(0,F_DUPFD,2); /* dup 0 onto 2 */ } #endif @@ -174,11 +175,11 @@ if (knew_dev_tty) ttytype(GET_TTYTYPE,exp_dev_tty,0,0,(char *)0); } /* returns fd of master end of pseudotty */ int -getptymaster() +exp_getptymaster() { int master = -1; char *hex, *bank; struct stat statbuf; @@ -216,11 +217,11 @@ int control; { } int -getptyslave(ttycopy,ttyinit,stty_args) +exp_getptyslave(ttycopy,ttyinit,stty_args) int ttycopy; int ttyinit; char *stty_args; { int slave; Index: pty_termios.c ================================================================== --- pty_termios.c +++ pty_termios.c @@ -25,11 +25,27 @@ to recode them. You may, if you absolutely want to get rid of any vestiges of Tcl. */ extern char *TclGetRegError(); +#if defined(HAVE_PTMX_BSD) && defined(HAVE_PTMX) +/* + * Some systems have both PTMX and PTMX_BSD. + * In fact, alphaev56-dec-osf4.0e has /dev/pts, /dev/pty, /dev/ptym, + * /dev/ptm, /dev/ptmx, and /dev/ptmx_bsd + * Suggestion from Martin Buchholz is that BSD + * is usually deprecated and so should be here. + */ +#undef HAVE_PTMX_BSD +#endif +/* Linux and Digital systems can be configured to have both. +According to Ashley Pittman , Digital works better +with openpty which supports 4000 while ptmx supports 60. */ +#if defined(HAVE_OPENPTY) && defined(HAVE_PTMX) +#undef HAVE_PTMX +#endif #if defined(HAVE_PTYM) && defined(HAVE_PTMX) /* * HP-UX 10.0 with streams (optional) have both PTMX and PTYM. I don't * know which is preferred but seeing as how the HP trap stuff is so @@ -72,21 +88,22 @@ #if defined(_SEQUENT_) # include #endif -#ifdef HAVE_PTMX +#if defined(HAVE_PTMX) && defined(HAVE_STROPTS_H) # include #endif #include "exp_win.h" #include "exp_tty_in.h" #include "exp_rename.h" #include "exp_pty.h" -void debuglog(); +void expDiagLog(); +void expDiagLogPtr(); #include /*extern char *sys_errlist[];*/ #ifndef TRUE @@ -303,19 +320,19 @@ if (ttyinit) { /* overlay parms originally supplied by Makefile */ /* As long as BSD stty insists on stdout == stderr, we can no longer write */ /* diagnostics to parent stderr, since stderr has is now child's */ /* Maybe someday they will fix stty? */ -/* debuglog("getptyslave: (default) stty %s\n",DFLT_STTY);*/ +/* expDiagLogPtrStr("exp_getptyslave: (default) stty %s\n",DFLT_STTY);*/ pty_stty(DFLT_STTY,slave_name); } #endif /* lastly, give user chance to override any terminal parms */ if (s) { /* give user a chance to override any terminal parms */ -/* debuglog("getptyslave: (user-requested) stty %s\n",s);*/ +/* expDiagLogPtrStr("exp_getptyslave: (user-requested) stty %s\n",s);*/ pty_stty(s,slave_name); } } } @@ -348,11 +365,11 @@ #define R_OK 04 #define W_OK 02 #endif int -getptymaster() +exp_getptymaster() { char *hex, *bank; struct stat stat_buf; int master = -1; int slave = -1; @@ -373,11 +390,11 @@ close(master); return(-1); } else if (grantpt(master)) { static char buf[500]; exp_pty_error = buf; - sprintf(exp_pty_error,"grantpt(%d) failed - likely reason is that your system administrator (in a rage of blind passion to rid the system of security holes) removed setuid from the utility used internally by grantpt to change pty permissions. Tell your system admin to reestablish setuid on the utility. Get the utility name by running Expect under truss or trace."); + sprintf(exp_pty_error,"grantpt(%s) failed - likely reason is that your system administrator (in a rage of blind passion to rid the system of security holes) removed setuid from the utility used internally by grantpt to change pty permissions. Tell your system admin to reestablish setuid on the utility. Get the utility name by running Expect under truss or trace.", expErrnoMsg(errno)); close(master); return(-1); } #ifdef TIOCFLUSH (void) ioctl(master,TIOCFLUSH,(char *)0); @@ -482,11 +499,11 @@ sprintf (master_name, "%s%s", "/dev/ptyp", num_str); if (stat (master_name, &stat_buf) < 0) break; sprintf (slave_name, "%s%s", "/dev/ttyp", num_str); - master = exp_pty_test (master_name, slave_name, 0, num_str); + master = exp_pty_test(master_name,slave_name,'0',num_str); if (master >= 0) goto done; } #endif @@ -539,11 +556,11 @@ if (stat(master_name, &stat_buf) < 0) break; for (num = 0; num<100; num++) { *slave_bank = *tty_bank; sprintf(tty_num,"%02d",num); strcpy(slave_num,tty_num); - master = exp_pty_test(master_name,slave_name,tty_bank,tty_num); + master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num); if (master >= 0) goto done; } } /* @@ -555,11 +572,11 @@ if (stat(master_name, &stat_buf) < 0) break; for (num = 0; num<1000; num++) { *slave_bank = *tty_bank; sprintf(tty_num,"%03d",num); strcpy(slave_num,tty_num); - master = exp_pty_test(master_name,slave_name,tty_bank,tty_num); + master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num); if (master >= 0) goto done; } } #endif /* HAVE_PTYM */ @@ -600,35 +617,40 @@ ioctl(master, TIOCTRAP, &control); #endif /* HAVE_PTYTRAP */ } int -getptyslave(ttycopy,ttyinit,stty_args) +exp_getptyslave(ttycopy,ttyinit,stty_args) int ttycopy; int ttyinit; char *stty_args; { int slave, slave2; char buf[10240]; - if (0 > (slave = open(slave_name, O_RDWR))) return(-1); + if (0 > (slave = open(slave_name, O_RDWR))) { + static char buf[500]; + exp_pty_error = buf; + sprintf(exp_pty_error,"open(%s,rw) = %d (%s)",slave_name,slave,expErrnoMsg(errno)); + return(-1); + } #if defined(HAVE_PTMX_BSD) if (ioctl (slave, I_LOOK, buf) != 0) if (ioctl (slave, I_PUSH, "ldterm")) { - debuglog("ioctl(%s,I_PUSH,\"ldterm\") = %s\n",Tcl_ErrnoMsg(errno)); + expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ldterm\") = %s\n",slave,expErrnoMsg(errno)); } #else #if defined(HAVE_PTMX) if (ioctl(slave, I_PUSH, "ptem")) { - debuglog("ioctl(%s,I_PUSH,\"ptem\") = %s\n",Tcl_ErrnoMsg(errno)); + expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ptem\") = %s\n",slave,expErrnoMsg(errno)); } if (ioctl(slave, I_PUSH, "ldterm")) { - debuglog("ioctl(%s,I_PUSH,\"ldterm\") = %s\n",Tcl_ErrnoMsg(errno)); + expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ldterm\") = %s\n",slave,expErrnoMsg(errno)); } if (ioctl(slave, I_PUSH, "ttcompat")) { - debuglog("ioctl(%s,I_PUSH,\"ttcompat\") = %s\n",Tcl_ErrnoMsg(errno)); + expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ttcompat\") = %s\n",slave,expErrnoMsg(errno)); } #endif #endif if (0 == slave) { @@ -700,43 +722,43 @@ (SELECT_MASK_TYPE *)0, (SELECT_MASK_TYPE *)0, (SELECT_MASK_TYPE *)&excep, &t); if (rc != 1) { - debuglog("spawned process never started, errno = %d\n",errno); + expDiagLogPtrStr("spawned process never started: %s\r\n",expErrnoMsg(errno)); return(-1); } if (ioctl(fd,TIOCREQCHECK,&ioctl_info) < 0) { - debuglog("ioctl(TIOCREQCHECK) failed, errno = %d\n",errno); + expDiagLogPtrStr("ioctl(TIOCREQCHECK) failed: %s\r\n",expErrnoMsg(errno)); return(-1); } found = ioctl_info.request; - debuglog("trapped pty op = %x",found); + expDiagLogPtrX("trapped pty op = %x",found); if (found == TIOCOPEN) { - debuglog(" TIOCOPEN"); + expDiagLogPtr(" TIOCOPEN"); } else if (found == TIOCCLOSE) { - debuglog(" TIOCCLOSE"); + expDiagLogPtr(" TIOCCLOSE"); } #ifdef TIOCSCTTY if (found == TIOCSCTTY) { - debuglog(" TIOCSCTTY"); + expDiagLogPtr(" TIOCSCTTY"); } #endif if (found & IOC_IN) { - debuglog(" IOC_IN (set)"); + expDiagLogPtr(" IOC_IN (set)"); } else if (found & IOC_OUT) { - debuglog(" IOC_OUT (get)"); + expDiagLogPtr(" IOC_OUT (get)"); } - debuglog("\n"); + expDiagLogPtr("\n"); if (ioctl(fd, TIOCREQSET, &ioctl_info) < 0) { - debuglog("ioctl(TIOCREQSET) failed, errno = %d\n",errno); + expDiagLogPtrStr("ioctl(TIOCREQSET) failed: %s\r\n",expErrnoMsg(errno)); return(-1); } return(found); } #endif Index: pty_unicos.c ================================================================== --- pty_unicos.c +++ pty_unicos.c @@ -54,11 +54,11 @@ #ifdef HAVE_SYSCONF_H #include #endif -void debuglog(); +void expDiagLog(); #ifndef TRUE #define TRUE 1 #define FALSE 0 #endif @@ -200,74 +200,74 @@ setreuid(realuid,realuid); } /* returns fd of master end of pseudotty */ int -getptymaster() +exp_getptymaster() { struct stat sb; int master; int npty; exp_pty_error = 0; - debuglog("getptymaster: lowpty=%d highpty=%d\n",lowpty,highpty); + expDiagLog("exp_getptymaster: lowpty=%d highpty=%d\n",lowpty,highpty); for (npty = lowpty; npty <= highpty; npty++) { if (seteuid(0) == -1) { /* we need to be root! */ - debuglog("getptymaster: seteuid root errno=%d\n", + expDiagLog("exp_getptymaster: seteuid root errno=%d\n", errno); } (void) sprintf(linep, "/dev/pty/%03d", npty); master = open(linep, O_RDWR); if (master < 0) { - debuglog("getptymaster: open linep=%s errno=%d\n", + expDiagLog("exp_getptymaster: open linep=%s errno=%d\n", linep,errno); continue; } (void) sprintf(linet, "/dev/ttyp%03d", npty); if(stat(linet, &sb) < 0) { - debuglog("getptymaster: stat linet=%s errno=%d\n", + expDiagLog("exp_getptymaster: stat linet=%s errno=%d\n", linet,errno); (void) close(master); continue; } if (sb.st_uid || sb.st_gid || sb.st_mode != 0600) { if (chown(linet, realuid, realgid) == -1) { - debuglog("getptymaster: chown linet=%s errno=%d\n", + expDiagLog("exp_getptymaster: chown linet=%s errno=%d\n", linet,errno); } if (chmod(linet, 0600) == -1) { - debuglog("getptymaster: chmod linet=%s errno=%d\n", + expDiagLog("exp_getptymaster: chmod linet=%s errno=%d\n", linet,errno); } (void)close(master); master = open(linep, 2); if (master < 0) { - debuglog("getptymaster: reopen linep=%s errno=%d\n", + expDiagLog("exp_getptymaster: reopen linep=%s errno=%d\n", linep,errno); continue; } } if (seteuid(realuid) == -1) { /* back to who we are! */ - debuglog("getptymaster: seteuid user errno=%d\n", + expDiagLog("exp_getptymaster: seteuid user errno=%d\n", errno); } if (access(linet, R_OK|W_OK) != 0) { - debuglog("getptymaster: access linet=%s errno=%d\n", + expDiagLog("exp_getptymaster: access linet=%s errno=%d\n", linet,errno); (void) close(master); continue; } - debuglog("getptymaster: allocated %s\n",linet); + expDiagLog("exp_getptymaster: allocated %s\n",linet); ptys[npty] = -1; exp_pty_slave_name = linet; return(master); } if (seteuid(realuid) == -1) { /* back to who we are! */ - debuglog("getptymaster: seteuid user errno=%d\n",errno); + expDiagLog("exp_getptymaster: seteuid user errno=%d\n",errno); } return(-1); } /* see comment in pty_termios.c */ @@ -278,26 +278,26 @@ int control; { } int -getptyslave(ttycopy,ttyinit,stty_args) +exp_getptyslave(ttycopy,ttyinit,stty_args) int ttycopy; int ttyinit; char *stty_args; { int slave; if (0 > (slave = open(linet, O_RDWR))) { - debuglog("getptyslave: open linet=%s errno=%d\n",linet,errno); + expDiagLog("exp_getptyslave: open linet=%s errno=%d\n",linet,errno); return(-1); } /* sanity check - if slave not 0, skip rest of this and return */ /* to what will later be detected as an error in caller */ if (0 != slave) { - debuglog("getptyslave: slave fd not 0\n"); + expDiagLog("exp_getptyslave: slave fd not 0\n"); return(slave); } if (0 == slave) { /* if opened in a new process, slave will be 0 (and */ @@ -315,11 +315,11 @@ setptyutmp() { struct utmp utmp; if (seteuid(0) == -1) { /* Need to be root */ - debuglog("setptyutmp: setuid root errno=%d\n",errno); + expDiagLog("setptyutmp: setuid root errno=%d\n",errno); return(-1); } (void) time(&utmp.ut_time); utmp.ut_type = USER_PROCESS; utmp.ut_pid = getpid(); @@ -326,15 +326,15 @@ strncpy(utmp.ut_user,myname,sizeof(utmp.ut_user)); strncpy(utmp.ut_host,hostname,sizeof(utmp.ut_host)); strncpy(utmp.ut_line,linet+5,sizeof(utmp.ut_line)); strncpy(utmp.ut_id,linet+8,sizeof(utmp.ut_id)); if (pututline(&utmp) == NULL) { - debuglog("setptyutmp: pututline failed\n"); + expDiagLog("setptyutmp: pututline failed\n"); } endutent(); if (seteuid(realuid) == -1) - debuglog("setptyutmp: seteuid user errno=%d\n",errno); + expDiagLog("setptyutmp: seteuid user errno=%d\n",errno); return(0); } setptypid(pid) int pid; @@ -341,11 +341,11 @@ { int npty; for (npty = lowpty; npty <= highpty; npty++) { if (ptys[npty] < 0) { - debuglog("setptypid: ttyp%03d pid=%d\n",npty,pid); + expDiagLog("setptypid: ttyp%03d pid=%d\n",npty,pid); ptys[npty] = pid; break; } } } @@ -353,33 +353,33 @@ ttyp_reset() { int npty; if (seteuid(0) == -1) { /* we need to be root! */ - debuglog("ttyp_reset: seteuid root errno=%d\n",errno); + expDiagLog("ttyp_reset: seteuid root errno=%d\n",errno); } for (npty = lowpty; npty <= highpty; npty++) { if (ptys[npty] <= 0) continue; (void) sprintf(linet, "/dev/ttyp%03d", npty); - debuglog("ttyp_reset: resetting %s, killing %d\n", + expDiagLog("ttyp_reset: resetting %s, killing %d\n", linet,ptys[npty]); if (chown(linet,0,0) == -1) { - debuglog("ttyp_reset: chown %s errno=%d\n",linet,errno); + expDiagLog("ttyp_reset: chown %s errno=%d\n",linet,errno); } if (chmod(linet, 0666) == -1) { - debuglog("ttyp_reset: chmod %s errno=%d\n",linet,errno); + expDiagLog("ttyp_reset: chmod %s errno=%d\n",linet,errno); } resetptyutmp(); if (kill(ptys[npty],SIGKILL) == -1) { - debuglog("ttyp_reset: kill pid=%d errno=%d\n", + expDiagLog("ttyp_reset: kill pid=%d errno=%d\n", ptys[npty],errno); } } if (seteuid(realuid) == -1) { /* Back to who we really are */ - debuglog("ttyp_reset: seteuid user errno=%d\n",errno); + expDiagLog("ttyp_reset: seteuid user errno=%d\n",errno); } } void exp_pty_exit() @@ -397,11 +397,11 @@ sizeof (utmp.ut_id)); utmp.ut_type = USER_PROCESS; /* position to entry in utmp file */ if(getutid(&utmp) == NULL) { - debuglog("resetptyutmp: no utmp entry for %s\n",linet); + expDiagLog("resetptyutmp: no utmp entry for %s\n",linet); return(-1); /* no utmp entry for this line ??? */ } /* set up the new entry */ strncpy(utmp.ut_name,"",sizeof(utmp.ut_name)); Index: tcldbg.h ================================================================== --- tcldbg.h +++ tcldbg.h @@ -35,11 +35,11 @@ EXTERN char *Dbg_VarName; EXTERN char *Dbg_DefaultCmdName; /* trivial interface, creates a "debug" command in your interp */ -EXTERN int Dbg_Init _ANSI_ARGS_((Tcl_Interp *)); +EXTERN int Tcldbg_Init _ANSI_ARGS_((Tcl_Interp *)); EXTERN void Dbg_On _ANSI_ARGS_((Tcl_Interp *interp, int immediate)); EXTERN void Dbg_Off _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN char **Dbg_ArgcArgv _ANSI_ARGS_((int argc,char *argv[], Index: tests/.Sanitize ================================================================== --- tests/.Sanitize +++ tests/.Sanitize @@ -23,12 +23,14 @@ Things-to-keep: .Sanitize README -all +all.tcl defs +logfile.test +send.test spawn.test pid.test cat.test expect.test stty.test Index: tests/README ================================================================== --- tests/README +++ tests/README @@ -1,91 +1,120 @@ Expect Test Suite --------------- +----------------- This directory contains a set of validation tests for the Expect commands. Each of the files whose name ends in ".test" is intended to fully exercise one or a few Expect commands. The commands tested by a given file are listed in the first line of the file. -You can run the tests in two ways: +You can run the tests in three ways: + (a) type "make test" in the parent directory to this one; this will run all of the tests. - (b) start up expect in this directory, then "source" the test - file (for example, type "source parse.test"). To run all - of the tests, type "source all". -In either case no output will be generated if all goes well, except -for a listing of the tests. If there are errors then additional -messages will appear in the format described below. - -The rest of this file provides additional information on the -features of the testing environment. - -This approach to testing (and most of this file) was copied from the -Tcl distribution. - -Definitions file: ------------------ - -The file "defs" defines a collection of procedures and variables -used to run the tests. It is read in automatically by each of the -.test files if needed, but once it has been read once it will not -be read again by the .test files. If you change defs while running -tests you'll have to "source" it by hand to load its new contents. - -Test output: ------------- - -Normally, output only appears when there are errors. However, if -the variable VERBOSE is set to 1 then tests will be run in "verbose" -mode and output will be generated for each test regardless of -whether it succeeded or failed. Test output consists of the -following information: - - - the test identifier (which can be used to locate the test code - in the .test file) - - a brief description of the test - - the contents of the test code - - the actual results produced by the tests - - a "PASSED" or "FAILED" message - - the expected results (if the test failed) - -You can set VERBOSE either interactively (after the defs file has been -read in), or you can change the default value in "defs". - -Selecting tests for execution: ------------------------------- - -Normally, all the tests in a file are run whenever the file is -"source"d. However, you can select a specific set of tests using -the global variable TESTS. This variable contains a pattern; any -test whose identifier matches TESTS will be run. For example, -the following interactive command causes all of the "for" tests in -groups 2 and 4 to be executed: - - set TESTS {for-[24]*} - -TESTS defaults to *, but you can change the default in "defs" if -you wish. - -Saving keystrokes: ------------------- - -A convenience procedure named "dotests" is included in file -"defs". It takes two arguments--the name of the test file (such -as "parse.test"), and a pattern selecting the tests you want to -execute. It sets TESTS to the second argument, calls "source" on -the file specified in the first argument, and restores TESTS to -its pre-call value at the end. - -Batch vs. interactive execution: --------------------------------- - -The tests can be run in either batch or interactive mode. Batch -mode refers to using I/O redirection from a UNIX shell. For example, -the following command causes the tests in the file named "parse.test" -to be executed: - - expect < parse.test > parse.test.results - -Users who want to execute the tests in this fashion need to first -ensure that the file "defs" has proper values for the global -variables that control the testing environment (VERBOSE and TESTS). + + (b) type "expect ?