Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,53 @@ +2001-08-01 Jeff Hobbs + + * Dbg.c (Dbg_On): fixed handling of stepping. [Bug: #446412] + +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 ADDED ChangeLog.win32 Index: ChangeLog.win32 ================================================================== --- /dev/null +++ ChangeLog.win32 @@ -0,0 +1,980 @@ +2002-03-16 davygrvy + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinMessage.cpp: + * win/expWinMessage.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinUtils.cpp: + * win/expWinUtils.hpp: + * win/slavedrv.dsp: + fixed a nasty bug in the SetArgv() function that was all my + fault. + + -=[ TAGGED as 'win32-jump-point-1' ]=- + +2002-03-15 davygrvy + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + * win/expWinMessage.cpp: + * win/expWinMessage.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrapDbg.cpp: + * win/expWinSpawnClient.hpp: + * win/expWinSpawnStdioClient.cpp: + final instalment. tried to work on cleanup issues, but more + testing needed. Fixed a big bug in ConsoleDebugger:: + OnFillConsoleOutputCharacter() where the master console handle + was null. I successfully logged into panix.com with Win2k's + telnet.exe and trapped it all! + +2002-03-13 davygrvy + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrapDbg.cpp: + * win/slavedrv.dsp: + milestone! It works. + +2002-03-12 davygrvy + * win/MsvcDbgControl.cpp: + * win/MsvcDbgControl.h: + * win/expWinSlaveMain.cpp: + * win/slavedrv.dsp: + Got debug build working again. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + * win/expWinMessage.cpp: + * win/expWinMessage.hpp: + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrap.hpp: + * win/expWinSlaveTrapDbg.cpp: + * win/expWinSpawnClient.hpp: + * win/expWinSpawnPipeClient.cpp: + removed all use of Tcl from the slavedrv. It was only being + used for hash tables. replaced them with std::map. It's a bit + fatter now, but i'll live. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + re-added use of tcl's hash tables, but this time using the + template. + + * win/expWinDynloadTclStubs.c: + * win/expWinDynloadTclStubs.cpp: + * win/expWinSpawnPipeClient.cpp: + * win/expWinSpawnStdioClient.cpp: + renamed + + * win/TclAdapter.hpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinMessage.cpp: + * win/expWinMessage.hpp: + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSpawnPipeClient.cpp: + * win/expWinTest.cpp: + * win/expWinUtils.cpp: + * win/expWinUtils.hpp: + * win/slavedrv.dsp: + * win/slavedrv_test.dsp: + Message class pulled-out to a seperate source file, due to + expected growth in that area. + + * win/expWinConsoleDebugger.hpp: + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrapDbg.cpp: + * win/expWinUtils.cpp: + * win/expWinUtils.hpp: + * win/slavedrv.dsp: + * win/slavedrv.rc: + * win/slavedrv_test.dsp: + final cleaning of Tcl from the slavedrv. + + * win/MsvcDbgControl.cpp: + * win/expWinMessage.cpp: + * win/expWinMessage.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSpawnPipeClient.cpp: + more stuff added to the pipe client component. slavedrv.exe + now sits at a miniature 29,184 bytes :) + + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrapDbg.cpp: + Re-arranged headers. The ConsoleDebugger class is now hidden + from public veiw. I might have to pull off a bridge pattern to + hide it more correctly. + + * win/TclHash.hpp: + Added a Top() and Next() for hash searches. + + * win/expWinSlaveMain.cpp: + * win/expWinSpawnClient.hpp: + renamed SpawnPipeClient to SpawnStdioClient to be more + meaningful. + + * win/expWinDynloadTclStubs.c: + * win/expWinSlaveDbg.c: + * win/expWinSlaveDrv.c: + * win/expWinSlaveKey.c: + not needed anymore + + * win/expWinDynloadTclStubs.cpp: + * win/expWinSlave.hpp: + added a ShutdownTcl() so I wouldn't have to share the HMODULE. + + * win/TclHash.hpp: + Wait a sec. I'm not happy with the STL's map template. It + adds too much bloat. Let's go back to Tcl's hash tables. + + * win/expWinDynloadTclStubs.c: + we'll need this again. + + * win/expWinSlaveTrap.hpp: + * win/expWinSlaveTrapDbg.cpp: + added a write() method. + +2002-03-11 davygrvy + * win/expWinUtils.cpp: + * win/expWinUtils.hpp: + Moved BuildCommandLine out of the ConsoleDebugger class for + testing reasons. + + * win/expWinUtils.cpp: + minor lint + + * win/TclAdapter.hpp: + * win/expWinTest.cpp: + * win/slavedrv.dsw: + * win/slavedrv_test.dsp: + Added a test for the BuildCommandLine function. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinDynloadTclStubs.c: + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSpawnMailboxCli.cpp: + * win/expWinSpawnPipeClient.cpp: + * win/slavedrv.dsp: + replacing mailboxing with simple pipes as our transport. + + * win/expWinSpawnPipeClient.cpp: + * win/expWinUtils.cpp: + added missing file header comments + + * generic/exp.decls: + * generic/expIntPlatDecls.h: + * generic/expStubInit.c: + added ExpSyslogGetSysMsg() + +2002-03-10 davygrvy + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrapDbg.cpp: + * win/expWinSpawnMailboxCli.cpp: + * win/slavedrvmc.mc: + Added more fatal error checks. + +2002-03-09 davygrvy + * win/MsvcDbgControl.cpp: + * win/MsvcDbgControl.h: + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + * win/expWinInt.h: + * win/expWinSlaveMain.cpp: + * win/expWinSpawnMailboxCli.cpp: + * win/slavedrv.dsp: + * win/slavedrv.dsw: + Almost linkable again. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + Changed all uses of NULL to the C++ 0L understanding. + + * win/slavedrv.mc: + fixed file header comments, again. + + * win/slavedrv.dsp: + now builds for release once more. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + * win/expWinDynloadTclStubs.c: + * win/expWinInt.h: + * win/expWinLog.c: + * win/expWinProcess.c: + * win/expWinSlaveMain.cpp: + Got error codes working. + + * win/slavedrv.mc: + * win/slavedrvmc.mc: + Needed to rename this. + + * win/slavedrv.dsp: + * win/slavedrv.rc: + resource script for the slave driver. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + * win/expWinSlaveTrapDbg.cpp: + links once more, but isn't yet working again. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSlaveTrapDbg.cpp: + Started on the app-level message queue. + + * win/expWinConsoleDebugger.hpp: + more little stuff. + +2002-03-08 davygrvy + * win/expWinSlave.hpp: + * win/expWinSlaveTrapDbg.cpp: + not close to done, but a good launch point. + + * win/expWinProcess.c: + When is a pid not a pid? When it's a process handle, so stop + lying about it. + + * win/slavedrv.mc: + fixed file header comments. + + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + more cleanup. + + * win/slavedrv.mc: + multi-lingual message catalog used for error messages in the + slave driver. + + * win/expWinSlaveMain.cpp: + name change for the event loop function. + + * win/expWinPort.h: + stopped including the IntPlat stuff from here. + +2002-03-07 davygrvy + * win/expWinConsoleDebugger.cpp: + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + C++ rewrite of the debugger code is coming along well. + + * generic/exp.decls: + * generic/exp.h: + * generic/expInt.h: + * generic/expIntPlatDecls.h: + changed some win protos. + + * win/expWinConsoleDebugger.hpp: + ++ rewrite of expWinSlaveDbg.c (mostly done.. good time to save + it) + + * win/expWinConsoleDebugger.hpp: + * win/expWinConsoleDebuggerBreakPoints.cpp: + breakpoints completed. module compiles cleanly, but does not yet function. + The hook-in for posting work has not been established. + +2002-03-06 davygrvy + * generic/exp.h: + small changes that are minor. + + * win/expWinInt.h: + * win/expWinSlave.hpp: + * win/expWinSlaveMain.cpp: + * win/expWinSpawnMailboxCli.cpp: + * win/slavedrv.dsp: + Our main() for the slave driver is getting a deep rewrite. This shell has a + good structure. The outer edges are in process. slavedrv.exe currently + won't link at this time. + +2002-02-16 davygrvy + * win/expWinInit.c: + * win/winDllMain.c: + A static build issue. + +2002-02-13 davygrvy + * generic/exp.decls: + * generic/expCommand.c: + * generic/expInt.h: + * generic/expIntDecls.h: + * generic/exp_main_sub.c: + Changed a few functions to be CONST char* and some general reformatting + to improve readability. + +2002-02-11 davygrvy + * win/expWinCommand.c: + * win/expWinInit.c: + * win/expWinPort.h: + * win/expect.dsp: + Can now build for Stubs and provide a Stubs table, too, WeeHoo.. + + * generic/exp_command.h: + * generic/exp_event.h: + * generic/exp_int.h: + * generic/exp_log.h: + * generic/exp_port.h: + * generic/exp_printify.h: + * generic/exp_prog.h: + * generic/exp_regexp.h: + * generic/exp_rename.h: + * generic/exp_tstamp.h: + * generic/exp_tty.h: + * generic/exp_win.h: + * generic/getopt.h: + Old header files not used have been removed + + * generic/exp.h: + * generic/exp_main_sub.c: + small changes for Stubs + +2002-02-10 davygrvy + * generic/exp.h: + * generic/expStubLib.c: + small lint + + * generic/exp.h: + fixed some preprocessor logic that was in error. + + * generic/exp_memmove.c: + already in compat/ + + * generic/exp.decls: + * generic/exp.h: + * generic/expDecls.h: + * generic/expIntDecls.h: + * generic/expIntPlatDecls.h: + * generic/expStubInit.c: + * generic/exp_main_sub.c: + More modifications have been done to support providing a Stubs table. + This isn't complete, but close. + + * win/etest.tcl: + * win/expect.dsp: + * win/testa2.c: + * win/testcalc.c: + * win/testcalc.h: + * win/testcat.c: + * win/testcat.mak: + * win/testclib.c: + * win/testclib2.c: + * win/testconsout.c: + * win/testcrash.c: + * win/testmodem.c: + * win/tests/etest.tcl: + * win/tests/testa2.c: + * win/tests/testcalc.c: + * win/tests/testcalc.h: + * win/tests/testcat.c: + * win/tests/testcat.mak: + * win/tests/testconsout.c: + * win/tests/testcrash.c: + * win/tests/testmodem.c: + * win/tests/testsig.c: + * win/tests/testwprog.c: + * win/tests/testwstation.c: + * win/tests/testwstation.tcl: + * win/testsig.c: + * win/testwprog.c: + * win/testwstation.c: + * win/testwstation.tcl: + moved all test related files out of the source dir + + * generic/exp_clib.c: + This file shall not be part of the porting job I am doing. After Expect becomes + a "friendly" extension, we can then get creative and put the "C" API lib back. + + * win/msjexhnd.cpp: + * win/msjexhnd.h: + These are not part of the extension and have no place here, at + this time. + + * compat/exp_strf.c: + * generic/exp.decls: + * generic/exp.h: + * generic/expChan.c: + * generic/expCommand.c: + * generic/expDecls.h: + * generic/expInt.h: + * generic/expIntDecls.h: + * generic/expIntPlatDecls.h: + * generic/expPlatDecls.h: + * generic/expPort.h: + * generic/expSpawnChan.c: + * generic/expStubInit.c: + * generic/expStubLib.c: + * generic/expTrap.c: + * generic/exp_clib.c: + * generic/exp_command.h: + * generic/exp_event.c: + * generic/exp_glob.c: + * generic/exp_inter.c: + * generic/exp_log.c: + * generic/exp_main_sub.c: + * generic/exp_port.h: + * generic/exp_printify.c: + * generic/exp_strf.c: + * generic/expect.c: + * generic/expect.h: + * generic/expect_comm.h: + * generic/expect_tcl.h: + * unix/expUnixCommand.c: + * unix/expUnixTty.c: + * unix/exp_clib_orig.c: + * unix/exp_command.c: + * unix/exp_pty.c: + * unix/exp_trap.c: + * unix/pty_termios.c: + * unix/pty_unicos.c: + * win/ExpWinInit.c: + * win/ExpWinInit.c: + * win/MsvcDbgControl.cpp: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinDynloadTclStubs.c: + * win/expWinInt.h: + * win/expWinInt.h: + * win/expWinLog.c: + * win/expWinPort.h: + * win/expWinProcess.c: + * win/expWinSlaveDbg.c: + * win/expWinSlaveDrv.c: + * win/expWinSlaveKey.c: + * win/expWinSpawnChan.c: + * win/expWinTty.c: + * win/expect.dsp: + * win/slavedrv.dsp: + moved all header files over to a more core style with the beginnings of a + Stubs table. This work is far from complete. + + * win/expect.dsp: + * win/expect.rc: + even more rc script problems repaired. + + * generic/exp_version.h: + * win/expWin.h: + not needed anymore + + * win/expect.dsp: + * win/expect.rc: + rc script problems repaired + + * win/expect.rc: + more rc script problems repaired. + + * win/ExpWinInit.c: + * win/expWinInit.c: + * win/expect.dsp: + * win/slavedrv.dsp: + fixing filename case problem + + * generic/exp.decls: + * generic/exp.h: + * generic/expChan.c: + * generic/expCommand.c: + * generic/expDecls.h: + * generic/expInt.h: + * generic/expIntDecls.h: + * generic/expIntPlatDecls.h: + * generic/expPlatDecls.h: + * generic/expSpawnChan.c: + * generic/expStubInit.c: + * generic/expTrap.c: + * generic/exp_closetcl.c: + * generic/exp_event.c: + * generic/exp_glob.c: + * generic/exp_inter.c: + * generic/exp_log.c: + * generic/exp_main_sub.c: + * generic/exp_printify.c: + * generic/exp_strf.c: + * generic/expect.c: + * win/MsvcDbgControl.cpp: + * win/MsvcDbgControl.h: + * win/expWinCommand.c: + * win/expWinInit.c: + * win/expWinInt.h: + * win/expWinLog.c: + * win/expWinPort.h: + * win/expWinProcess.c: + * win/expWinSpawnChan.c: + * win/expWinTty.c: + * win/expect.rc: + * win/winDllMain.c: + All file comments have the same form. + + * generic/exp.decls: + * generic/exp.h: + * generic/expCommand.c: + * generic/expInt.h: + * generic/expIntDecls.h: + * generic/expStubInit.c: + * generic/exp_strf.c: + * win/expect.dsp: + More rounds of edits getting the new Stubs table more towards + perfection. + + * win/expect.dsp: + updated settings for a release build. + +2001-12-22 davygrvy + * win/MsvcDbgControl.cpp: + * win/MsvcDbgControl.h: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinSlaveDrv.c: + * win/slavedrv.dsp: + * win/winDllMain.c: + Got the spawndrv.exe using Stubs. Tried to get the extension, but more work + needs to be done first. Most Expect commands are now in the ::exp + namespace. + + * win/expect.dsp: + Took-out link references to tcl84(d).lib. we'll let winDllmain.c handle + it through #pragmas + + * win/expWinDynloadTclStubs.c: + re-added from the original branch + +2001-12-21 davygrvy + * win/ExpWinInit.c: + * win/ExpWinVCDbgLaunch.cpp: + * win/MsvcDbgControl.cpp: + * win/MsvcDbgControl.h: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinSlaveDrv.c: + * win/expect.dsp: + * win/expect.dsp: + * win/slavedrv.dsp: + Second shot (and final) of automating VC++ for the debugger friendly + replacement to CreateProcess(). What a nightmare... + +2001-12-19 davygrvy + * win/ExpWinInit.c: + * win/ExpWinVCDbgLaunch.cpp: + * win/expWin.h: + * win/expWinProcess.c: + * win/expWinSlaveDrv.c: + * win/slavedrv.dsp: + * win/winDllMain.c: + Moved expWinProc initting to a new file. Also realized COM control over the + slavedrv debugger is much more work than antisipated to get right. + + * win/expWinCommand.c: + removed -iomode fconfigure option, as there isn't one of that type found in the + stock pipe driver. + +2001-12-18 davygrvy + * win/ExpWinVCDbgLaunch.cpp: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinProcess.c: + * win/expect.dsp: + * win/expect.dsw: + * win/slavedrv.dsw: + * win/winDllMain.c: + First shot at trying to automate VC++ so I can run slavedrv.exe and get + around the "can't debug child processes" issue. + + * win/expWinCLib.c: + * win/expectlib.rc: + * win/makefile: + * win/tclHash.c: + not used anymore + + * generic/exp_main_sub.c: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinProcess.c: + * win/expWinSlaveDrv.c: + OutputDebugString added to the winprocs for the Tchar thing that + Tcl_WinUtfToTChar() does. + +2001-12-17 davygrvy + * win/expWin.h: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinProcess.c: + * win/expWinSlaveDbg.c: + * win/expWinSlaveDrv.c: + * win/expect.dsp: + * win/slavedrv.dsp: + Changed ExpWinCreateProcess() to support unicode (aka TCHAR at + run-time through Tcl_WinUtfToTchar()) + +2001-11-23 davygrvy + * win/.cvsignore: + added an ignore file for a cleaner appearing workspace. + +2001-11-22 davygrvy + * win/Mcl/.cvsignore: + * win/Mcl/ChangeLog: + * win/Mcl/Mcl.dsp: + * win/Mcl/Mcl.dsw: + * win/Mcl/help/MCL.HLP: + * win/Mcl/help/MCL4MFC.HLP: + * win/Mcl/help/Mcl C++ Class Library.chm: + * win/Mcl/help/Mcl4Mfc C++ Class Library.chm: + * win/Mcl/help/mcl.CNT: + * win/Mcl/help/mcl4mfc.CNT: + * win/Mcl/include/CMcl.h: + * win/Mcl/include/CMclAutoLock.h: + * win/Mcl/include/CMclAutoPtr.h: + * win/Mcl/include/CMclCritSec.h: + * win/Mcl/include/CMclEvent.h: + * win/Mcl/include/CMclGlobal.h: + * win/Mcl/include/CMclKernel.h: + * win/Mcl/include/CMclLinkedLists.h: + * win/Mcl/include/CMclMailbox.h: + * win/Mcl/include/CMclMonitor.h: + * win/Mcl/include/CMclMutex.h: + * win/Mcl/include/CMclSemaphore.h: + * win/Mcl/include/CMclSharedMemory.h: + * win/Mcl/include/CMclThread.h: + * win/Mcl/include/CMclWaitableCollection.h: + * win/Mcl/include/CMclWaitableObject.h: + * win/Mcl/readme.txt: + * win/Mcl/src/CMclAutoLock.cpp: + * win/Mcl/src/CMclAutoPtr.cpp: + * win/Mcl/src/CMclCritSec.cpp: + * win/Mcl/src/CMclEvent.cpp: + * win/Mcl/src/CMclGlobal.cpp: + * win/Mcl/src/CMclKernel.cpp: + * win/Mcl/src/CMclMailbox.cpp: + * win/Mcl/src/CMclMonitor.cpp: + * win/Mcl/src/CMclMutex.cpp: + * win/Mcl/src/CMclSemaphore.cpp: + * win/Mcl/src/CMclSharedMemory.cpp: + * win/Mcl/src/CMclThread.cpp: + * win/Mcl/src/CMclWaitableCollection.cpp: + Merged Mcl into the take2 branch + + * win/expWinSlaveDrv.c: + Oopps.. left some bad debugging cruft around + + * generic/expSpawnChan.c: + removed some left-over C++ style comments. + + * win/expWinCommand.c: + removed some small cruft. + + * win/expAlloc.c: + * win/expDString.c: + not used anymore + + * win/panic.c: + this is not needed + + * generic/exp_main_sub.c: + Oopps.. removed a small namespacing left-over of an experiment. + + * expTcl.c: + * expTcl.h: + * exp_chan.c: + * exp_clib.c: + * exp_closetcl.c: + * exp_command.c: + * exp_command.h: + * exp_console.c: + * exp_event.c: + * exp_event.h: + * exp_glob.c: + * exp_int.h: + * exp_inter.c: + * exp_log.c: + * exp_log.h: + * exp_main_exp.c: + * exp_main_sub.c: + * exp_main_tk.c: + * exp_noevent.c: + * exp_poll.c: + * exp_prog.h: + * exp_pty.c: + * exp_pty.h: + * exp_regexp.c: + * exp_regexp.h: + * exp_rename.h: + * exp_simple.c: + * exp_trap.c: + * exp_tstamp.h: + * exp_tty.c: + * exp_tty.h: + * exp_tty_comm.c: + * exp_tty_in.h: + * exp_win.c: + * exp_win.h: + * expect.c: + * expect.h: + * expect_cf.h.in: + * expect_comm.h: + * expect_tcl.h: + * fixcat: + * fixline1: + * generic/expChan.c: + * generic/expCommand.c: + * generic/expSpawnChan.c: + * generic/expTrap.c: + * generic/exp_command.h: + * generic/exp_event.c: + * generic/exp_inter.c: + * generic/exp_log.h: + * generic/exp_main_exp.c: + * generic/exp_main_sub.c: + * generic/expect.c: + * generic/expect.h: + * generic/expect_tcl.h: + * win/expWin.h: + * win/expWinCommand.c: + * win/expWinPort.h: + * win/expWinSlave.h: + * win/expWinSlaveDbg.c: + * win/expWinSlaveDrv.c: + * win/expWinSpawnChan.c: + * win/expWinTty.c: + * win/expect.dsp: + * win/expect.dsw: + * win/makefile: + * win/slavedrv.dsp: + A working set of code against Tcl8.4! + +2001-11-15 davygrvy + * win/expWinSlaveTrapPipe.cpp: + file expWinSlaveTrapPipe.cpp was initially added on branch + telco-tec-win32-branch. + + * win/expWinSlaveEvents.cpp: + file expWinSlaveEvents.cpp was initially added on branch telco + tec-win32-branch. + + * win/expWinSlaveEvents.cpp: + * win/expWinSlaveTrap.cpp: + * win/expWinSlaveTrapPipe.cpp: + * win/expWinSpawnCliTransport.cpp: + * win/expWinSpawnSocketCli.cpp: + * win/expWinSpawnTransport.cpp: + unfinished work committed anyway. + + * mkconfig.mif: + * win/makefile.vc32: + * win/mkbc32.mif: + * win/mkfiles.mif: + * win/mkmgw32.mif: + * win/mkprepvc32.mif: + * win/mkvc32.mif: + * win/mkwc32.mif: + old build files removed. + + * win/expWinSpawnSocketCli.cpp: + file expWinSpawnSocketCli.cpp was initially added on branch + telco-tec-win32-branch. + + * win/expWinSpawnCliTransport.cpp: + file expWinSpawnCliTransport.cpp was initially added on branch + telco-tec-win32-branch. + + * win/expWinSlaveTrap.cpp: + file expWinSlaveTrap.cpp was initially added on branch telco + tec-win32-branch. + +2001-11-09 davygrvy + * win/expWinSpawnTransport.cpp: + file expWinSpawnTransport.cpp was initially added on branch + telco-tec-win32-branch. + + * win/expSlaveDrvMain.c: + * win/expWinMailboxCli.cpp: + * win/expWinSpawnTransport.cpp: + beginning the C++ rewrite. + +2001-11-07 davygrvy + * win/expWinMailboxCli.cpp: + file expWinMailboxCli.cpp was initially added on branch telco + tec-win32-branch. + + * win/expSlaveDrvMain.c: + More trims for unicode, but I'm dropping the attempt to build for unicode. + Too much wierd stuff to handle along with tchar.h having a C++ bug + that I don't understand why overloading is problematic. + + * expect.dsw: + * win/buildfiles.dsp: + * win/genStubs.dsp: + Changed to an IDE project rather than a makefile project. + The makefiles will be disappearing. + + * win/expSlaveDrvMain.c: + file expSlaveDrvMain.c was initially added on branch telco-tec + win32-branch. + + * win/dllEntryPoint.c: + * win/expSlaveDrvMain.c: + * win/makefile.vc32: + * win/spawndrv.rc: + * win/spawndrvmc.mc: + Numerous changes + + * win/expWinMailboxCli.cpp: + * win/expWinMailboxSrv.cpp: + Small test beginnings of the IPC channel driver with client for + spawndrv.exe + + * win/expWinMailboxSrv.cpp: + file expWinMailboxSrv.cpp was initially added on branch telco + tec-win32-branch. + +2001-10-30 davygrvy + * win/makefile.vc32: + * win/mkfiles.mif: + * win/mkvc32.mif: + added a 'clean' target. + + * win/dllEntryPoint.c: + new) not neccessarily needed, but being explict is a good thing. + + * win/dllEntryPoint.c: + file dllEntryPoint.c was initially added on branch telco-tec + win32-branch. + + * README.win32.txt: + file README.win32.txt was initially added on branch telco-tec + win32-branch. + + * README.win32.txt: + (new) + +2001-10-29 davygrvy + * generic/expPlatIntDecls.h: + improper naming convention. Should be PlatInt not IntPlat + + * win/spawndrv.rc: + set use the newer exp.h + + * generic/expPlatIntDecls.h: + file expPlatIntDecls.h was initially added on branch telco-tec + win32-branch. + + * win/makefile.vc32: + added the 'genstubs' target + + * generic/expPlatIntDecls.h: + Whoops. should be IntPlat, not PlatInt. + + * mkconfig.mif: + had to put the !error directive back in place. + +2001-10-28 davygrvy + * win/genStubs.dsp: + file genStubs.dsp was initially added on branch telco-tec-win32 + branch. + + * expect.dsw: + * win/genStubs.dsp: + (new) IDE file for rebuilding the Stubs table. + + * win/buildfiles.dsp: + * win/makefile.vc32: + * win/mkfiles.mif: + build instruction changes + + * makefile.win: + extension target changed from 'release' to 'expect' + +2001-10-26 davygrvy + * win/buildfiles.dsp: + file buildfiles.dsp was initially added on branch telco-tec + win32-branch. + + * win/spawndrvmc.mc: + adding more calls to ExpSyslog() where needed. + + * win/spawndrvmc.mc: + ExpSyslog() is finally doing what I want. More work to do, but the + groundwork is now set. + + * expect.dsw: + * win/buildfiles.dsp: + a couple more IDE project files for MsDev + +2001-10-22 davygrvy + * win/makefile.vc32: + Needed to include the temp directory in the include path so spawndrvmc.h + is picked-up. + + * expect.dsw: + file expect.dsw was initially added on branch telco-tec-win32 + branch. + + * expect.dsw: + MSVC++ v6 workspace file for the IDE. + + * .cvsignore: + file .cvsignore was initially added on branch telco-tec-win32 + branch. + + * .cvsignore: + globs to ignore by CVS. + +2001-10-14 davygrvy + * win/spawndrv.rc: + * win/spawndrvmc.mc: + Added #define RESOURCE_INCLUDED because tcl.h doesn't + use RC_INVOKED. Which it should, but doesn't. + + * mkconfig.mif: + * win/makefile.vc32: + * win/mkfiles.mif: + * win/mkprepvc32.mif: + * win/mkvc32.mif: + Changed the build files to be run from the /win directory instead + of the top-root. This will help get MS project .dsp files working. + +2001-10-12 davygrvy + * win/spawndrv.rc: + file spawndrv.rc was initially added on branch telco-tec-win32 + branch. + + * win/spawndrv.rc: + * win/spawndrv.rc: + * win/spawndrvmc.mc: + spawndrv.exe needed a resource script and a message catalog. + + * win/spawndrv.rc: + * win/spawndrvmc.mc: + getting closer to building the message catalog. + + * win/spawndrvmc.mc: + corrected title block text. + + * win/spawndrvmc.mc: + file spawndrvmc.mc was initially added on branch telco-tec + win32-branch. + +2001-10-02 davygrvy + * generic/tcldbg.h: + Brought in 5.32.2 and fixed compiler warnings about + inappropriate casts. + + * generic/tcldbg.h: + file tcldbg.h was initially added on branch telco-tec-win32 + branch. + +2001-09-13 davygrvy + * exp_memmove.c: + * exp_select.c: + * exp_strf.c: + * expect.man: + * expectk.man: + * libexpect.man: + moved from root 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: 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,228 @@ This is the HISTORY file for Expect. Modifications made by Cygnus support are in ChangeLog. - Don Date Version Description ------- ------- ------------------------------------------------------ +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 +260,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 +463,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 +1834,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 +1867,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 +2157,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 +2179,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 +2420,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 +3138,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)) + +]) ADDED compat/exp_memmove.c Index: compat/exp_memmove.c ================================================================== --- /dev/null +++ compat/exp_memmove.c @@ -0,0 +1,25 @@ +/* memmove - some systems lack this */ + +#include "expect_cf.h" +#include "tcl.h" + +/* like memcpy but can handle overlap */ +#ifndef HAVE_MEMMOVE +char * +memmove(dest,src,n) +VOID *dest; +CONST VOID *src; +int n; +{ + char *d; + CONST char *s; + + d = dest; + s = src; + if (s +#include +#include + +#ifdef HAVE_SYS_WAIT_H +#include +#endif + +#ifdef HAVE_SYS_TIME_H +#include +#endif + +#ifdef HAVE_SYSSELECT_H +# include /* Intel needs this for timeval */ +#endif + +#ifdef HAVE_PTYTRAP +# include +#endif + +#ifdef HAVE_UNISTD_H +# include +#endif + +#ifdef _AIX +/* AIX has some unusual definition of FD_SET */ +#include +#endif + +#if !defined( FD_SET ) && defined( HAVE_SYS_BSDTYPES_H ) + /* like AIX, ISC has it's own definition of FD_SET */ +# include +#endif /* ! FD_SET && HAVE_SYS_BSDTYPES_H */ + +#include "tcl.h" +#include "exp_prog.h" +#include "exp_command.h" /* for struct exp_f defs */ +#include "exp_event.h" + +#ifdef HAVE_SYSCONF_H +#include +#endif + +#ifndef FD_SET +#define FD_SET(fd,fdset) (fdset)->fds_bits[0] |= (1<<(fd)) +#define FD_CLR(fd,fdset) (fdset)->fds_bits[0] &= ~(1<<(fd)) +#define FD_ZERO(fdset) (fdset)->fds_bits[0] = 0 +#define FD_ISSET(fd,fdset) (((fdset)->fds_bits[0]) & (1<<(fd))) +#ifndef AUX2 +typedef struct fd_set { + long fds_bits[1]; + /* any implementation so pathetic as to not define FD_SET will just */ + /* have to suffer with only 32 bits worth of fds */ +} fd_set; +#endif /* AUX2 */ +#endif + +static struct timeval zerotime = {0, 0}; +static struct timeval anytime = {0, 0}; /* can be changed by user */ + +/* returns status, one of EOF, TIMEOUT, ERROR or DATA */ +int +exp_get_next_event(interp,masters, n,master_out,timeout,key) +Tcl_Interp *interp; +int *masters; +int n; /* # of masters */ +int *master_out; /* 1st event master, not set if none */ +int timeout; /* seconds */ +int key; +{ + static rr = 0; /* round robin ptr */ + + int i; /* index into in-array */ + struct timeval *t; + + fd_set rdrs; + fd_set excep; +/* FIXME: This is really gross, but the folks at Lynx said their select is + * way hosed and to ignore all exceptions. + */ +#ifdef __Lynx__ +#define EXCEP 0 +#else +#define EXCEP &excep +#endif + + 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 (timeout >= 0) { + t = &anytime; + t->tv_sec = timeout; + } else { + t = NULL; + } + + restart: + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); + + /* anything in the environment could have changed */ + return EXP_RECONFIGURE; + } + + FD_ZERO(&rdrs); + FD_ZERO(&excep); + for (i = 0;i < n;i++) { + FD_SET(masters[i],&rdrs); + FD_SET(masters[i],&excep); + } + + /* The reason all fd masks are (seemingly) redundantly cast to */ + /* SELECT_MASK_TYPE is that the HP defines its mask in terms of */ + /* of int * and yet defines FD_SET in terms of fd_set. */ + + if (-1 == select(exp_fd_max+1, + (SELECT_MASK_TYPE *)&rdrs, + (SELECT_MASK_TYPE *)0, + (SELECT_MASK_TYPE *)EXCEP, + t)) { + /* window refreshes trigger EINTR, ignore */ + if (errno == EINTR) goto restart; + else if (errno == EBADF) { + /* someone is rotten */ + for (i=0;i= n) rr = 0; /* ">" catches previous readys that */ + /* used more fds then we're using now */ + + if (FD_ISSET(masters[rr],&rdrs)) { + *master_out = masters[rr]; + return(EXP_DATA_NEW); +/*#ifdef HAVE_PTYTRAP*/ + } else if (FD_ISSET(masters[rr], &excep)) { +#ifndef HAVE_PTYTRAP + *master_out = masters[rr]; + return(EXP_EOF); +#else + struct request_info ioctl_info; + if (ioctl(masters[rr],TIOCREQCHECK,&ioctl_info) < 0) { + 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) + 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 */ + } + } + return(EXP_TIMEOUT); +} + +/*ARGSUSED*/ +int +exp_get_next_event_info(interp,fd,ready_mask) +Tcl_Interp *interp; +int fd; +int ready_mask; +{ + /* this function is only used when running with Tk */ + /* hence, it is merely a stub in this file but to */ + /* pacify lint, return something */ + return 0; +} + +int /* returns TCL_XXX */ +exp_dsleep(interp,sec) +Tcl_Interp *interp; +double sec; +{ + struct timeval t; + + t.tv_sec = sec; + t.tv_usec = (sec - t.tv_sec) * 1000000L; + restart: + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return rc; + } + if (-1 == select(1, + (SELECT_MASK_TYPE *)0, + (SELECT_MASK_TYPE *)0, + (SELECT_MASK_TYPE *)0, + &t) + && errno == EINTR) + goto restart; + return TCL_OK; +} + +#if 0 +int /* returns TCL_XXX */ +exp_usleep(interp,usec) +Tcl_Interp *interp; +long usec; /* microseconds */ +{ + struct timeval t; + + t.tv_sec = usec/1000000L; + t.tv_usec = usec%1000000L; + restart: + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); + } + if (-1 == select(1, + (SELECT_MASK_TYPE *)0, + (SELECT_MASK_TYPE *)0, + (SELECT_MASK_TYPE *)0, + &t) + && errno == EINTR) + goto restart; + return TCL_OK; +} +#endif /*0*/ + +/* set things up for later calls to event handler */ +void +exp_init_event() +{ +#if 0 +#ifdef _SC_OPEN_MAX + maxfds = sysconf(_SC_OPEN_MAX); +#else + maxfds = getdtablesize(); +#endif +#endif + + exp_event_exit = 0; +} +#endif /* WHOLE FILE !!!! */ ADDED compat/exp_strf.c Index: compat/exp_strf.c ================================================================== --- /dev/null +++ compat/exp_strf.c @@ -0,0 +1,605 @@ +/* exp_strp.c - functions for exp_timestamp */ +/* + * strftime.c + * + * Public-domain implementation of ANSI C library routine. + * + * It's written in old-style C for maximal portability. + * However, since I'm used to prototypes, I've included them too. + * + * If you want stuff in the System V ascftime routine, add the SYSV_EXT define. + * For extensions from SunOS, add SUNOS_EXT. + * For stuff needed to implement the P1003.2 date command, add POSIX2_DATE. + * For VMS dates, add VMS_EXT. + * For complete POSIX semantics, add POSIX_SEMANTICS. + * + * The code for %c, %x, and %X now follows the 1003.2 specification for + * the POSIX locale. + * This version ignores LOCALE information. + * It also doesn't worry about multi-byte characters. + * So there. + * + * This file is also shipped with GAWK (GNU Awk), gawk specific bits of + * code are included if GAWK is defined. + * + * Arnold Robbins + * January, February, March, 1991 + * Updated March, April 1992 + * Updated April, 1993 + * Updated February, 1994 + * Updated May, 1994 + * Updated January 1995 + * Updated September 1995 + * + * Fixes from ado@elsie.nci.nih.gov + * February 1991, May 1992 + * Fixes from Tor Lillqvist tml@tik.vtt.fi + * May, 1993 + * Further fixes from ado@elsie.nci.nih.gov + * February 1994 + * %z code from chip@chinacat.unicom.com + * Applied September 1995 + * + * + * Modified by Don Libes for Expect, 10/93 and 12/95. + * Forced POSIX semantics. + * Replaced inline/min/max stuff with a single range function. + * Removed tzset stuff. + * Commented out tzname stuff. + * + * According to Arnold, the current version of this code can ftp'd from + * ftp.mathcs.emory.edu:/pub/arnold/strftime.shar.gz + * + */ + +#include "expect_cf.h" +#include "tcl.h" + +#include +#include +#include "string.h" + + + + +#include + +#define SYSV_EXT 1 /* stuff in System V ascftime routine */ +#define POSIX2_DATE 1 /* stuff in Posix 1003.2 date command */ + +#if defined(POSIX2_DATE) && ! defined(SYSV_EXT) +#define SYSV_EXT 1 +#endif + +#if defined(POSIX2_DATE) +#define adddecl(stuff) stuff +#else +#define adddecl(stuff) +#endif + +#ifndef __STDC__ +#define const + +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 */ +/* less portable ways */ +#if !defined(HAVE_STRFTIME) +# if defined(HAVE_SV_TIMEZONE) +extern char *tzname[2]; +extern int daylight; +# else +# if defined(HAVE_TIMEZONE) + +char * +zone_name (tp) +struct tm *tp; +{ + char *timezone (); + struct timeval tv; + struct timezone tz; + + gettimeofday (&tv, &tz); + + return timezone (tz.tz_minuteswest, tp->tm_isdst); +} + +# endif /* HAVE_TIMEZONE */ +# endif /* HAVE_SV_TIMEZONE */ +#endif /* HAVE_STRFTIME */ + +static int +range(low,item,hi) +int low, item, hi; +{ + if (item < low) return low; + if (item > hi) return hi; + return item; +} + +/* strftime --- produce formatted time */ + +void +/*size_t*/ +#ifndef __STDC__ +exp_strftime(/*s,*/ format, timeptr, dstring) +/*char *s;*/ +char *format; +const struct tm *timeptr; +Tcl_DString *dstring; +#else +/*exp_strftime(char *s, size_t maxsize, const char *format, const struct tm *timeptr)*/ +exp_strftime(char *format, const struct tm *timeptr,Tcl_DString *dstring) +#endif +{ + int copied; /* used to suppress copying when called recursively */ + +#if 0 + char *endp = s + maxsize; + char *start = s; +#endif + char *percentptr; + + char tbuf[100]; + int i; + + /* various tables, useful in North America */ + static char *days_a[] = { + "Sun", "Mon", "Tue", "Wed", + "Thu", "Fri", "Sat", + }; + static char *days_l[] = { + "Sunday", "Monday", "Tuesday", "Wednesday", + "Thursday", "Friday", "Saturday", + }; + static char *months_a[] = { + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + }; + static char *months_l[] = { + "January", "February", "March", "April", + "May", "June", "July", "August", "September", + "October", "November", "December", + }; + static char *ampm[] = { "AM", "PM", }; + +/* for (; *format && s < endp - 1; format++) {*/ + for (; *format ; format++) { + tbuf[0] = '\0'; + copied = 0; /* has not been copied yet */ + percentptr = strchr(format,'%'); + if (percentptr == 0) { + Tcl_DStringAppend(dstring,format,-1); + goto out; + } else if (percentptr != format) { + Tcl_DStringAppend(dstring,format,percentptr - format); + format = percentptr; + } +#if 0 + if (*format != '%') { + *s++ = *format; + continue; + } +#endif + again: + switch (*++format) { + case '\0': + Tcl_DStringAppend(dstring,"%",1); +#if 0 + *s++ = '%'; +#endif + goto out; + + case '%': + Tcl_DStringAppend(dstring,"%",1); + copied = 1; + break; +#if 0 + *s++ = '%'; + continue; +#endif + + case 'a': /* abbreviated weekday name */ + if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6) + strcpy(tbuf, "?"); + else + strcpy(tbuf, days_a[timeptr->tm_wday]); + break; + + case 'A': /* full weekday name */ + if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6) + strcpy(tbuf, "?"); + else + strcpy(tbuf, days_l[timeptr->tm_wday]); + break; + +#ifdef SYSV_EXT + case 'h': /* abbreviated month name */ +#endif + case 'b': /* abbreviated month name */ + if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11) + strcpy(tbuf, "?"); + else + strcpy(tbuf, months_a[timeptr->tm_mon]); + break; + + case 'B': /* full month name */ + if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11) + strcpy(tbuf, "?"); + else + strcpy(tbuf, months_l[timeptr->tm_mon]); + break; + + case 'c': /* appropriate date and time representation */ + sprintf(tbuf, "%s %s %2d %02d:%02d:%02d %d", + days_a[range(0, timeptr->tm_wday, 6)], + months_a[range(0, timeptr->tm_mon, 11)], + range(1, timeptr->tm_mday, 31), + range(0, timeptr->tm_hour, 23), + range(0, timeptr->tm_min, 59), + range(0, timeptr->tm_sec, 61), + timeptr->tm_year + 1900); + break; + + case 'd': /* day of the month, 01 - 31 */ + i = range(1, timeptr->tm_mday, 31); + sprintf(tbuf, "%02d", i); + break; + + case 'H': /* hour, 24-hour clock, 00 - 23 */ + i = range(0, timeptr->tm_hour, 23); + sprintf(tbuf, "%02d", i); + break; + + case 'I': /* hour, 12-hour clock, 01 - 12 */ + i = range(0, timeptr->tm_hour, 23); + if (i == 0) + i = 12; + else if (i > 12) + i -= 12; + sprintf(tbuf, "%02d", i); + break; + + case 'j': /* day of the year, 001 - 366 */ + sprintf(tbuf, "%03d", timeptr->tm_yday + 1); + break; + + case 'm': /* month, 01 - 12 */ + i = range(0, timeptr->tm_mon, 11); + sprintf(tbuf, "%02d", i + 1); + break; + + case 'M': /* minute, 00 - 59 */ + i = range(0, timeptr->tm_min, 59); + sprintf(tbuf, "%02d", i); + break; + + case 'p': /* am or pm based on 12-hour clock */ + i = range(0, timeptr->tm_hour, 23); + if (i < 12) + strcpy(tbuf, ampm[0]); + else + strcpy(tbuf, ampm[1]); + break; + + case 'S': /* second, 00 - 61 */ + i = range(0, timeptr->tm_sec, 61); + sprintf(tbuf, "%02d", i); + break; + + case 'U': /* week of year, Sunday is first day of week */ + sprintf(tbuf, "%02d", weeknumber(timeptr, 0)); + break; + + case 'w': /* weekday, Sunday == 0, 0 - 6 */ + i = range(0, timeptr->tm_wday, 6); + sprintf(tbuf, "%d", i); + break; + + case 'W': /* week of year, Monday is first day of week */ + sprintf(tbuf, "%02d", weeknumber(timeptr, 1)); + break; + + case 'x': /* appropriate date representation */ + sprintf(tbuf, "%s %s %2d %d", + days_a[range(0, timeptr->tm_wday, 6)], + months_a[range(0, timeptr->tm_mon, 11)], + range(1, timeptr->tm_mday, 31), + timeptr->tm_year + 1900); + break; + + case 'X': /* appropriate time representation */ + sprintf(tbuf, "%02d:%02d:%02d", + range(0, timeptr->tm_hour, 23), + range(0, timeptr->tm_min, 59), + range(0, timeptr->tm_sec, 61)); + break; + + case 'y': /* year without a century, 00 - 99 */ + i = timeptr->tm_year % 100; + sprintf(tbuf, "%02d", i); + break; + + case 'Y': /* year with century */ + sprintf(tbuf, "%d", 1900 + timeptr->tm_year); + break; + + case 'Z': /* time zone name or abbrevation */ +#if defined(HAVE_STRFTIME) + strftime(tbuf,sizeof tbuf,"%Z",timeptr); +#else +# if defined(HAVE_SV_TIMEZONE) + i = 0; + if (daylight && timeptr->tm_isdst) + i = 1; + strcpy(tbuf, tzname[i]); +# else + strcpy(tbuf, zone_name (timeptr)); +# if defined(HAVE_TIMEZONE) +# endif /* HAVE_TIMEZONE */ + /* no timezone available */ + /* feel free to add others here */ +# endif /* HAVE_SV_TIMEZONE */ +#endif /* HAVE STRFTIME */ + break; + +#ifdef SYSV_EXT + case 'n': /* same as \n */ + tbuf[0] = '\n'; + tbuf[1] = '\0'; + break; + + case 't': /* same as \t */ + tbuf[0] = '\t'; + tbuf[1] = '\0'; + break; + + case 'D': /* date as %m/%d/%y */ + exp_strftime("%m/%d/%y", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%m/%d/%y", timeptr);*/ + break; + + case 'e': /* day of month, blank padded */ + sprintf(tbuf, "%2d", range(1, timeptr->tm_mday, 31)); + break; + + case 'r': /* time as %I:%M:%S %p */ + exp_strftime("%I:%M:%S %p", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%I:%M:%S %p", timeptr);*/ + break; + + case 'R': /* time as %H:%M */ + exp_strftime("%H:%M", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%H:%M", timeptr);*/ + break; + + case 'T': /* time as %H:%M:%S */ + exp_strftime("%H:%M:%S", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%H:%M:%S", timeptr);*/ + break; +#endif + +#ifdef POSIX2_DATE + case 'C': + sprintf(tbuf, "%02d", (timeptr->tm_year + 1900) / 100); + break; + + + case 'E': + case 'O': + /* POSIX locale extensions, ignored for now */ + goto again; + case 'V': /* week of year according ISO 8601 */ + sprintf(tbuf, "%02d", iso8601wknum(timeptr)); + break; + + case 'u': + /* ISO 8601: Weekday as a decimal number [1 (Monday) - 7] */ + sprintf(tbuf, "%d", timeptr->tm_wday == 0 ? 7 : + timeptr->tm_wday); + break; +#endif /* POSIX2_DATE */ + default: + tbuf[0] = '%'; + tbuf[1] = *format; + tbuf[2] = '\0'; + break; + } + if (!copied) + Tcl_DStringAppend(dstring,tbuf,-1); +#if 0 + i = strlen(tbuf); + if (i) { + if (s + i < endp - 1) { + strcpy(s, tbuf); + s += i; + } else + return 0; +#endif + } +out:; +#if 0 + if (s < endp && *format == '\0') { + *s = '\0'; + return (s - start); + } else + return 0; +#endif +} + +/* isleap --- is a year a leap year? */ + +#ifndef __STDC__ +static int +isleap(year) +int year; +#else +static int +isleap(int year) +#endif +{ + return ((year % 4 == 0 && year % 100 != 0) || year % 400 == 0); +} + +#ifdef POSIX2_DATE +/* iso8601wknum --- compute week number according to ISO 8601 */ + +#ifndef __STDC__ +static int +iso8601wknum(timeptr) +const struct tm *timeptr; +#else +static int +iso8601wknum(const struct tm *timeptr) +#endif +{ + /* + * From 1003.2: + * If the week (Monday to Sunday) containing January 1 + * has four or more days in the new year, then it is week 1; + * otherwise it is the highest numbered week of the previous + * (52 or 53) year, and the next week is week 1. + * + * ADR: This means if Jan 1 was Monday through Thursday, + * it was week 1, otherwise week 53. + * + * XPG4 erroneously included POSIX.2 rationale text in the + * main body of the standard. Thus it requires week 53. + */ + + int weeknum, jan1day; + + /* get week number, Monday as first day of the week */ + weeknum = weeknumber(timeptr, 1); + + /* + * With thanks and tip of the hatlo to tml@tik.vtt.fi + * + * What day of the week does January 1 fall on? + * We know that + * (timeptr->tm_yday - jan1.tm_yday) MOD 7 == + * (timeptr->tm_wday - jan1.tm_wday) MOD 7 + * and that + * jan1.tm_yday == 0 + * and that + * timeptr->tm_wday MOD 7 == timeptr->tm_wday + * from which it follows that. . . + */ + jan1day = timeptr->tm_wday - (timeptr->tm_yday % 7); + if (jan1day < 0) + jan1day += 7; + + /* + * If Jan 1 was a Monday through Thursday, it was in + * week 1. Otherwise it was last year's highest week, which is + * this year's week 0. + * + * What does that mean? + * If Jan 1 was Monday, the week number is exactly right, it can + * never be 0. + * If it was Tuesday through Thursday, the weeknumber is one + * less than it should be, so we add one. + * Otherwise, Friday, Saturday or Sunday, the week number is + * OK, but if it is 0, it needs to be 52 or 53. + */ + switch (jan1day) { + case 1: /* Monday */ + break; + case 2: /* Tuesday */ + case 3: /* Wednesday */ + case 4: /* Thursday */ + weeknum++; + break; + case 5: /* Friday */ + case 6: /* Saturday */ + case 0: /* Sunday */ + if (weeknum == 0) { +#ifdef USE_BROKEN_XPG4 + /* XPG4 (as of March 1994) says 53 unconditionally */ + weeknum = 53; +#else + /* get week number of last week of last year */ + struct tm dec31ly; /* 12/31 last year */ + dec31ly = *timeptr; + dec31ly.tm_year--; + dec31ly.tm_mon = 11; + dec31ly.tm_mday = 31; + dec31ly.tm_wday = (jan1day == 0) ? 6 : jan1day - 1; + dec31ly.tm_yday = 364 + isleap(dec31ly.tm_year + 1900); + weeknum = iso8601wknum(& dec31ly); +#endif + } + break; + } + + if (timeptr->tm_mon == 11) { + /* + * The last week of the year + * can be in week 1 of next year. + * Sigh. + * + * This can only happen if + * M T W + * 29 30 31 + * 30 31 + * 31 + */ + int wday, mday; + + wday = timeptr->tm_wday; + mday = timeptr->tm_mday; + if ( (wday == 1 && (mday >= 29 && mday <= 31)) + || (wday == 2 && (mday == 30 || mday == 31)) + || (wday == 3 && mday == 31)) + weeknum = 1; + } + + return weeknum; +} +#endif + +/* weeknumber --- figure how many weeks into the year */ + +/* With thanks and tip of the hatlo to ado@elsie.nci.nih.gov */ + +#ifndef __STDC__ +static int +weeknumber(timeptr, firstweekday) +const struct tm *timeptr; +int firstweekday; +#else +static int +weeknumber(const struct tm *timeptr, int firstweekday) +#endif +{ + int wday = timeptr->tm_wday; + int ret; + + if (firstweekday == 1) { + if (wday == 0) /* sunday */ + wday = 6; + else + wday--; + } + ret = ((timeptr->tm_yday + 7 - wday) / 7); + if (ret < 0) + ret = 0; + return ret; +} 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=32 +EXP_MICRO_VERSION=2 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=32 +EXP_MICRO_VERSION=2 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) ADDED doc/expect.man Index: doc/expect.man ================================================================== --- /dev/null +++ doc/expect.man @@ -0,0 +1,2591 @@ +.TH EXPECT 1 "29 December 1994" +.SH NAME +expect \- programmed dialogue with interactive programs, Version 5 +.SH SYNOPSIS +.B expect +[ +.B \-dDinN +] +[ +.B \-c +.I cmds +] +[ +.BR \- [ f | b ] +] +.I cmdfile +] +[ +.I args +] +.SH INTRODUCTION +.B Expect +is a program that "talks" to other interactive programs according to a +script. Following the script, +.B Expect +knows what can be expected from +a program and what the correct response should be. An interpreted +language provides branching and high-level control structures to +direct the dialogue. In addition, the user can take control +and interact directly when desired, afterward returning control to the +script. +.PP +.B Expectk +is a mixture of +.B Expect +and +.BR Tk . +It behaves just like +.B Expect +and +.BR Tk 's +.BR wish . +.B Expect +can also be used directly in C or C++ (that is, without Tcl). +See libexpect(3). +.PP +The name "Expect" comes from the idea of +.I send/expect +sequences popularized +by uucp, kermit and other modem control programs. +However unlike uucp, +.B Expect +is generalized so that it can be run as a user-level command +with any program and task in mind. +.B Expect +can actually talk to several programs at the same time. +.PP +For example, here are some things +.B Expect +can do: +.RS +.TP 4 +\(bu +Cause your computer to dial you back, +so that you can login without paying for the call. +.TP +\(bu +Start a game (e.g., rogue) and if the optimal configuration doesn't appear, +restart it (again and again) until it does, +then hand over control to you. +.TP +\(bu +Run fsck, and in response to its questions, answer "yes", "no" or give control back to you, +based on predetermined criteria. +.TP +\(bu +Connect to another network or BBS (e.g., MCI Mail, CompuServe) and +automatically retrieve your mail so that it appears as if +it was originally sent to your local system. +.TP +\(bu +Carry environment variables, current directory, +or any kind of information across rlogin, telnet, tip, su, chgrp, etc. +.RE +.PP +There are a variety of reasons why the shell cannot perform these tasks. +(Try, you'll see.) +All are possible with +.BR Expect . +.PP +In general, +.B Expect +is useful for running any program which requires +interaction between the program and the user. +All that is necessary is that the interaction can be characterized +programmatically. +.B Expect +can also give the user back control +(without halting the program being controlled) if desired. +Similarly, the user can return control to the script at any time. +.SH USAGE +.B Expect +reads +.I cmdfile +for a list of commands to execute. +.B Expect +may also be invoked implicitly on systems which support the #! notation +by marking the script executable, and making the first line in your script: + + #!/usr/local/bin/expect \-f + +Of course, the path must accurately describe where +.B Expect +lives. /usr/local/bin is just an example. + +The +.B \-c +flag prefaces a command to be executed before any in the script. +The command should be quoted to prevent being broken up by the shell. +This option may be used multiple times. +Multiple commands may be +executed with a single +.B \-c +by separating them with semicolons. +Commands are executed in the order they appear. +(When using Expectk, this option is specified as +.BR \-command .) +.PP +The +.B \-d +flag enables some diagnostic output, which +primarily reports internal activity of commands such as +.B expect +and +.BR interact . +This flag has the same effect as "exp_internal 1" at the beginning of an Expect +script, plus the version of +.B Expect +is printed. +(The +.B strace +command is useful for tracing statements, and the +.B trace +command is useful for tracing variable assignments.) +(When using Expectk, this option is specified as +.BR \-diag .) +.PP +The +.B \-D +flag enables an interactive debugger. An integer value should follow. +The debugger will take control before the next Tcl procedure +if the value is non-zero +or if a ^C is pressed (or a breakpoint is hit, or other appropriate debugger +command appears in the script). See the README file or SEE ALSO (below) +for more information on the debugger. +(When using Expectk, this option is specified as +.BR \-Debug .) +.PP +The +.B \-f +flag prefaces a file from which to read commands from. +The flag itself is optional as it is only useful when using +the #! notation (see above), +so that other arguments may be supplied on the command line. +(When using Expectk, this option is specified as +.BR \-file .) +.PP +By default, the command file is read into memory and executed in its entirety. +It is occasionally desirable to read files one line at a time. For example, +stdin is read this way. In order to force arbitrary files to be handled this +way, use the +.B \-b +flag. +(When using Expectk, this option is specified as +.BR \-buffer .) +.PP +If the string "\-" is supplied as a filename, standard input is read instead. +(Use "./\-" to read from a file actually named "\-".) +.PP +The +.B \-i +flag causes +.B Expect +to interactively prompt for commands instead of reading +them from a file. +Prompting is terminated via the +.B exit +command or upon EOF. +See +.B interpreter +(below) for more information. +.B \-i +is assumed if neither a command file nor +.B \-c +is used. +(When using Expectk, this option is specified as +.BR \-interactive .) +.PP +.B \-\- +may be used to delimit the end of the options. This is useful if +you want to pass an option-like argument to your script without it being +interpreted by +.BR Expect . +This can usefully be placed in the #! line to prevent any flag-like +interpretation by Expect. For example, the following will leave the +original arguments (including the script name) in the variable +.IR argv . + + #!/usr/local/bin/expect \-\- + +Note that the usual getopt(3) and execve(2) conventions must be observed +when adding arguments to the #! line. +.PP +The file $exp_library/expect.rc is sourced automatically if present, unless +the +.B \-N +flag is used. +(When using Expectk, this option is specified as +.BR \-NORC .) +Immediately after this, +the file ~/.expect.rc is sourced automatically, unless the +.B \-n +flag is used. If the environment variable DOTDIR is defined, +it is treated as a directory and .expect.rc is read from there. +(When using Expectk, this option is specified as +.BR \-norc .) +This sourcing occurs only after executing any +.B \-c +flags. +.PP +.B \-v +causes Expect to print its version number and exit. (The corresponding flag +in Expectk, which uses long flag names, is \-version.) +.PP +Optional +.I args +are constructed into a list and stored in the variable named +.IR argv . +.I argc +is initialized to the length of argv. +.PP +.I argv0 +is defined to be the name of the script (or binary if no script is used). +For example, +the following prints out the name of the script and the first three arguments: +.nf + + send_user "$argv0 [lrange $argv 0 2]\\n" + +.fi +.SH COMMANDS +.B Expect +uses +.I Tcl +(Tool Command Language). +Tcl provides control flow (e.g., if, for, break), +expression evaluation and several other features such as recursion, +procedure definition, etc. +Commands used here but not defined (e.g., +.BR set , +.BR if , +.BR exec ) +are Tcl commands (see tcl(3)). +.B Expect +supports additional commands, described below. +Unless otherwise specified, commands return the empty string. +.PP +Commands are listed alphabetically so that they can be quickly located. +However, new users may find it easier to start by reading the descriptions +of +.BR spawn , +.BR send , +.BR expect , +and +.BR interact , +in that order. + +Note that the best introduction to the language (both Expect and Tcl) +is provided in the book "Exploring Expect" (see SEE ALSO below). +Examples are included in this man page but they are very limited since +this man page is meant primarily as reference material. + +Note that in the text of this man page, "Expect" with an uppercase "E" +refers to the +.B Expect +program while "expect" with a lower-case "e" refers to the +.B expect +command within the +.B Expect +program.) +.I +.TP 6 +.BI close " [-slave] [\-onexec 0|1] [\-i spawn_id]" +closes the connection to the current process. +Most interactive programs will detect EOF on their stdin and exit; +thus +.B close +usually suffices to kill the process as well. +The +.B \-i +flag declares the process to close corresponding to the named spawn_id. + +Both +.B expect +and +.B interact +will detect when the current process exits and implicitly do a +.BR close . +But if you kill the process by, say, "exec kill $pid", +you will need to explicitly call +.BR close . + +The +.BR \-onexec +flag determines whether the spawn id will be closed in any new spawned +processes or if the process is overlayed. To leave a spawn id open, +use the value 0. A non-zero integer value will force the spawn closed +(the default) in any new processes. + +The +.B \-slave +flag closes the slave associated with the spawn id. (See "spawn -pty".) +When the connection is closed, the slave is automatically closed as +well if still open. + +No matter whether the connection is closed implicitly or explicitly, +you should call +.B wait +to clear up the corresponding kernel process slot. +.B close +does not call +.B wait +since there is no guarantee that closing a process connection will cause +it to exit. +See +.B wait +below for more info. +.TP +.BI debug " [[-now] 0|1]" +controls a Tcl debugger allowing you to step through statements, set +breakpoints, etc. + +With no arguments, a 1 is returned if the debugger is not running, otherwise +a 0 is returned. + +With a 1 argument, the debugger is started. With a 0 argument, the +debugger is stopped. If a 1 argument is preceded by the +.B \-now +flag, the debugger is started immediately (i.e., in the middle of the +.B debug +command itself). Otherwise, the debugger is started with the next +Tcl statement. + +The +.B debug +command does not change any traps. Compare this to starting Expect with the +.B -D +flag (see above). + +See the README file or SEE ALSO (below) +for more information on the debugger. +.TP +.B disconnect +disconnects a forked process from the terminal. It continues running in the +background. The process is given its own process group (if possible). +Standard I/O is redirected to /dev/null. +.IP +The following fragment uses +.B disconnect +to continue running the script in the background. +.nf + + if {[fork]!=0} exit + disconnect + . . . + +.fi +The following script reads a password, and then runs a program +every hour that demands a password each time it is run. The script supplies +the password so that you only have to type it once. +(See the +.B stty +command which demonstrates how to turn off password echoing.) +.nf + + send_user "password?\\ " + expect_user -re "(.*)\\n" + for {} 1 {} { + if {[fork]!=0} {sleep 3600;continue} + disconnect + spawn priv_prog + expect Password: + send "$expect_out(1,string)\\r" + . . . + exit + } + +.fi +An advantage to using +.B disconnect +over the shell asynchronous process feature (&) is that +.B Expect +can +save the terminal parameters prior to disconnection, and then later +apply them to new ptys. With &, +.B Expect +does not have a chance +to read the terminal's parameters since the terminal is already +disconnected by the time +.B Expect +receives control. +.TP +.BI exit " [\-opts] [status]" +causes +.B Expect +to exit or otherwise prepare to do so. + +The +.B \-onexit +flag causes the next argument to be used as an exit handler. +Without an argument, the current exit handler is returned. + +The +.B \-noexit +flag causes +.B Expect +to prepare to exit but stop short of actually returning control to the +operating system. The user-defined exit handler is run as well as Expect's +own internal handlers. +No further Expect commands should be executed. +This is useful if you are running Expect with other Tcl extensions. +The current interpreter (and main window if in the Tk environment) remain +so that other Tcl extensions can clean up. If Expect's +.B exit +is called again (however this might occur), the handlers are not rerun. + +Upon exiting, +all connections to spawned processes are closed. Closure will be detected +as an EOF by spawned processes. +.B exit +takes no other actions beyond what the normal _exit(2) procedure does. +Thus, spawned processes that do not check for EOF may continue to run. +(A variety of conditions are important to determining, for example, what +signals a spawned process will be sent, but these are system-dependent, +typically documented under exit(3).) +Spawned processes that continue to run will be inherited by init. + +.I status +(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 +The command +.B exp_continue +allows +.B expect +itself to continue +executing rather than returning as it normally would. +(See +.B expect +for more information.) +.TP +.BI exp_internal " [\-f file] value" +causes further commands to send diagnostic information internal to +.B Expect +to stderr if +.I value +is non-zero. This output is disabled if +.I value +is 0. The diagnostic information includes every character received, +and every attempt made to match the current output against the patterns. +.IP +If the optional +.I file +is supplied, all normal and debugging output is written to that file +(regardless of the value of +.IR value ). +Any previous diagnostic output file is closed. + +The +.B \-info +flag causes exp_internal to return a description of the +most recent non-info arguments given. +.TP +.BI exp_open " [args] [\-i spawn_id]" +returns a Tcl file identifier that corresponds to the original spawn id. +The file identifier can then be used as if it were opened by Tcl's +.B open +command. (The spawn id should no longer be used. A +.B wait +should not be executed. + +The +.B \-leaveopen +flag leaves the spawn id open for access through +Expect commands. A +.B wait +must be executed on the spawn id. +.TP +.BI exp_pid " [\-i spawn_id]" +returns the process id corresponding to the currently spawned process. +If the +.B \-i +flag is used, the pid returned corresponds to that of the given spawn id. +.TP +.B exp_send +is an alias for +.BR send . +.TP +.B exp_send_error +is an alias for +.BR send_error . +.TP +.B exp_send_log +is an alias for +.BR send_log . +.TP +.B exp_send_tty +is an alias for +.BR send_tty . +.TP +.B exp_send_user +is an alias for +.BR send_user . +.TP +.BI exp_version " [[\-exit] version]" +is useful for assuring that the script is compatible with the current +version of Expect. +.IP +With no arguments, the current version of +.B Expect +is returned. This version +may then be encoded in your script. If you actually know that you are not +using features of recent versions, you can specify an earlier version. +.IP +Versions consist of three numbers separated by dots. First +is the major number. Scripts written for versions of +.B Expect +with a +different major number will almost certainly not work. +.B exp_version +returns an error if the major numbers do not match. +.IP +Second is the minor number. Scripts written for a version with a +greater minor number than the current version +may depend upon some new feature and might not run. +.B exp_version +returns an error if the major numbers match, but the script minor number +is greater than that of the running +.BR Expect . +.IP +Third is a number that plays no part in the version comparison. +However, it is incremented when the +.B Expect +software +distribution is changed in any way, such as by additional documentation +or optimization. It is reset to 0 upon each new minor version. +.IP +With the +.B \-exit +flag, +.B Expect +prints an error and exits if the version is out of date. +.TP +.BI expect " [[\-opts] pat1 body1] ... [\-opts] patn [bodyn]" +waits until one of the patterns matches the output of a spawned process, +a specified time period has passed, or an end-of-file is seen. +If the final body is empty, it may be omitted. +.IP +Patterns from the most recent +.B expect_before +command are implicitly used before any other patterns. +Patterns from the most recent +.B expect_after +command are implicitly used after any other patterns. +.IP +If the arguments to the entire +.B expect +statement require more than one line, +all the arguments may be "braced" into one so as to avoid terminating each +line with a backslash. In this one case, the usual Tcl substitutions will +occur despite the braces. +.IP +If a pattern is the keyword +.BR eof , +the corresponding body is executed upon end-of-file. +If a pattern is the keyword +.BR timeout , +the corresponding body is executed upon timeout. If no timeout keyword +is used, an implicit null action is executed upon timeout. +The default timeout period is 10 seconds but may be set, for example to 30, +by the command "set timeout 30". An infinite timeout may be designated +by the value \-1. +If a pattern is the keyword +.BR default , +the corresponding body is executed upon either timeout or end-of-file. +.IP +If a pattern matches, then the corresponding body is executed. +.B expect +returns the result of the body (or the empty string if no pattern matched). +In the event that multiple patterns match, the one appearing first is +used to select a body. +.IP +Each time new output arrives, it is compared to each pattern in the order +they are listed. Thus, you may test for absence of a match by making +the last pattern something guaranteed to appear, such as a prompt. +In situations where there is no prompt, you must use +.B timeout +(just like you would if you were interacting manually). +.IP +Patterns are specified in three ways. By default, +patterns are specified as with Tcl's +.B string match +command. (Such patterns are also similar to C-shell regular expressions +usually referred to as "glob" patterns). The +.B \-gl +flag may may +be used to protect patterns that might otherwise match +.B expect +flags from doing so. +Any pattern beginning with a "-" should be protected this way. (All strings +starting with "-" are reserved for future options.) + +.IP +For example, the following fragment looks for a successful login. +(Note that +.B abort +is presumed to be a procedure defined elsewhere in the script.) +.nf + +.ta \w' expect 'u +\w'invalid password 'u + expect { + busy {puts busy\\n ; exp_continue} + failed abort + "invalid password" abort + timeout abort + connected + } + +.fi +Quotes are necessary on the fourth pattern since it contains a space, which +would otherwise separate the pattern from the action. +Patterns with the same action (such as the 3rd and 4th) require listing the +actions again. This can be avoid by using regexp-style patterns (see below). +More information on forming glob-style patterns can be found in the Tcl manual. +.IP +Regexp-style patterns follow the syntax defined by Tcl's +.B regexp +(short for "regular expression") command. +regexp patterns are introduced with the flag +.BR \-re . +The previous example can be rewritten using a regexp as: +.nf + +.ta \w' expect 'u +\w'connected 'u + expect { + busy {puts busy\\n ; exp_continue} + \-re "failed|invalid password" abort + timeout abort + connected + } + +.fi +Both types of patterns are "unanchored". This means that patterns +do not have to match the entire string, but can begin and end the +match anywhere in the string (as long as everything else matches). +Use ^ to match the beginning of a string, and $ to match the end. +Note that if you do not wait for the end of a string, your responses +can easily end up in the middle of the string as they are echoed from +the spawned process. While still producing correct results, the output +can look unnatural. Thus, use of $ is encouraged if you can exactly +describe the characters at the end of a string. + +Note that in many editors, the ^ and $ match the beginning and end of +lines respectively. However, because expect is not line oriented, +these characters match the beginning and end of the data (as opposed +to lines) currently in the expect matching buffer. (Also, see the +note below on "system indigestion.") + +The +.B \-ex +flag causes the pattern to be matched as an "exact" string. No +interpretation of *, ^, etc is made (although the usual Tcl +conventions must still be observed). +Exact patterns are always unanchored. + +.IP +The +.B \-nocase +flag causes uppercase characters of the output to compare as if they were +lowercase characters. The pattern is not affected. +.IP +While reading output, +more than 2000 bytes can force earlier bytes to be "forgotten". +This may be changed with the function +.BR match_max . +(Note that excessively large values can slow down the pattern matcher.) +If +.I patlist +is +.BR full_buffer , +the corresponding body is executed if +.I match_max +bytes have been received and no other patterns have matched. +Whether or not the +.B full_buffer +keyword is used, the forgotten characters are written to +expect_out(buffer). + +If +.I patlist +is the keyword +.BR null , +and nulls are allowed (via the +.B remove_nulls +command), the corresponding body is executed if a single ASCII +0 is matched. +It is not possible to +match 0 bytes via glob or regexp patterns. + +Upon matching a pattern (or eof or full_buffer), +any matching and previously unmatched output is saved in the variable +.IR expect_out(buffer) . +Up to 9 regexp substring matches are saved in the variables +.I expect_out(1,string) +through +.IR expect_out(9,string) . +If the +.B -indices +flag is used before a pattern, +the starting and ending indices (in a form suitable for +.BR lrange ) +of the +10 strings are stored in the variables +.I expect_out(X,start) +and +.I expect_out(X,end) +where X is a digit, corresponds to the substring position in the buffer. +0 refers to strings which matched the entire pattern +and is generated for glob patterns as well as regexp patterns. +For example, if a process has produced output of "abcdefgh\\n", the result of: +.nf + + expect "cd" + +.fi +is as if the following statements had executed: +.nf + + set expect_out(0,string) cd + set expect_out(buffer) abcd + +.fi +and "efgh\\n" is left in the output buffer. +If a process produced the output "abbbcabkkkka\\n", the result of: +.nf + + expect \-indices \-re "b(b*).*(k+)" + +.fi +is as if the following statements had executed: +.nf + + set expect_out(0,start) 1 + set expect_out(0,end) 10 + set expect_out(0,string) bbbcabkkkk + set expect_out(1,start) 2 + set expect_out(1,end) 3 + set expect_out(1,string) bb + set expect_out(2,start) 10 + set expect_out(2,end) 10 + set expect_out(2,string) k + set expect_out(buffer) abbbcabkkkk + +.fi +and "a\\n" is left in the output buffer. The pattern "*" (and -re ".*") will +flush the output buffer without reading any more output from the +process. +.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). + +The spawn id associated with the matching output (or eof or +full_buffer) is stored in +.IR expect_out(spawn_id) . + +The +.B \-timeout +flag causes the current expect command to use the following value +as a timeout instead of using the value of the timeout variable. + +By default, +patterns are matched against output from the current process, however the +.B \-i +flag declares the output from the named spawn_id list be matched against +any following patterns (up to the next +.BR \-i ). +The spawn_id list should either be a whitespace separated list of spawn_ids +or a variable referring to such a list of spawn_ids. + +For example, the following example waits for +"connected" from the current process, or "busy", "failed" or "invalid +password" from the spawn_id named by $proc2. +.nf + + expect { + \-i $proc2 busy {puts busy\\n ; exp_continue} + \-re "failed|invalid password" abort + timeout abort + connected + } + +.fi +The value of the global variable +.I any_spawn_id +may be used to match patterns to any spawn_ids that are named +with all other +.B \-i +flags in the current +.B expect +command. +The spawn_id from a +.B \-i +flag with no associated pattern (i.e., followed immediately +by another +.BR \-i ) +is made available to any other patterns +in the same +.B expect +command associated with +.I any_spawn_id. + +The +.B \-i +flag may also name a global variable in which case the variable is read +for a list of spawn ids. The variable is reread whenever it changes. +This provides a way of changing the I/O source while the command is in +execution. Spawn ids provided this way are called "indirect" spawn ids. + +Actions such as +.B break +and +.B continue +cause control structures (i.e., +.BR for , +.BR proc ) +to behave in the usual way. +The command +.B exp_continue +allows +.B expect +itself to continue +executing rather than returning as it normally would. +.IP +This is useful for avoiding explicit loops or repeated expect statements. +The following example is part of a fragment to automate rlogin. The +.B exp_continue +avoids having to write a second +.B expect +statement (to look for the prompt again) if the rlogin prompts for a password. +.nf + + expect { + Password: { + stty -echo + send_user "password (for $user) on $host: " + expect_user -re "(.*)\\n" + send_user "\\n" + send "$expect_out(1,string)\\r" + stty echo + exp_continue + } incorrect { + send_user "invalid password or account\\n" + exit + } timeout { + send_user "connection to $host timed out\\n" + exit + } eof { + send_user \\ + "connection to host failed: $expect_out(buffer)" + exit + } -re $prompt + } + +.fi +For example, the following fragment might help a user guide +an interaction that is already totally automated. In this case, the terminal +is put into raw mode. If the user presses "+", a variable is incremented. +If "p" is pressed, several returns are sent to the process, +perhaps to poke it in some way, and "i" lets the user interact with the +process, effectively stealing away control from the script. +In each case, the +.B exp_continue +allows the current +.B expect +to continue pattern matching after executing the +current action. +.nf + + stty raw \-echo + expect_after { + \-i $user_spawn_id + "p" {send "\\r\\r\\r"; exp_continue} + "+" {incr foo; exp_continue} + "i" {interact; exp_continue} + "quit" exit + } + +.fi +.IP +By default, +.B exp_continue +resets the timeout timer. The timer is not restarted, if +.B exp_continue +is called with the +.B \-continue_timer +flag. +.TP +.BI expect_after " [expect_args]" +works identically to the +.B expect_before +except that if patterns from both +.B expect +and +.B expect_after +can match, the +.B expect +pattern is used. See the +.B expect_before +command for more information. +.TP +.BI expect_background " [expect_args]" +takes the same arguments as +.BR expect , +however it returns immediately. +Patterns are tested whenever new input arrives. +The pattern +.B timeout +and +.B default +are meaningless to +.BR expect_background +and are silently discarded. +Otherwise, the +.B expect_background +command uses +.B expect_before +and +.B expect_after +patterns just like +.B expect +does. + +When +.B expect_background +actions are being evaluated, background processing for the same +spawn id is blocked. Background processing is unblocked when +the action completes. While background processing is blocked, +it is possible to do a (foreground) +.B expect +on the same spawn id. + +It is not possible to execute an +.B expect +while an +.B expect_background +is unblocked. +.B expect_background +for a particular spawn id is deleted by +declaring a new expect_background with the same spawn id. Declaring +.B expect_background +with no pattern removes the given spawn id +from the ability to match patterns in the background. +.TP +.BI expect_before " [expect_args]" +takes the same arguments as +.BR expect , +however it returns immediately. +Pattern-action pairs from the most recent +.B expect_before +with the same spawn id are implicitly added to any following +.B expect +commands. If a pattern matches, it is treated as if it had been +specified in the +.B expect +command itself, and the associated body is executed in the context +of the +.B expect +command. +If patterns from both +.B expect_before +and +.B expect +can match, the +.B expect_before +pattern is used. + +If no pattern is specified, the spawn id is not checked for any patterns. + +Unless overridden by a +.B \-i +flag, +.B expect_before +patterns match against the spawn id defined at the time that the +.B expect_before +command was executed (not when its pattern is matched). + +The \-info flag causes +.B expect_before +to return the current specifications of what patterns it will match. +By default, it reports on the current spawn id. An optional spawn id specification may be given for information on that spawn id. For example +.nf + + expect_before -info -i $proc + +.fi +At most one spawn id specification may be given. The flag \-indirect +suppresses direct spawn ids that come only from indirect specifications. + +Instead of a spawn id specification, the flag "-all" will cause +"-info" to report on all spawn ids. + +The output of the \-info flag can be reused as the argument to expect_before. +.TP +.BI expect_tty " [expect_args]" +is like +.B expect +but it reads characters from /dev/tty (i.e. keystrokes from the user). +By default, reading is performed in cooked mode. +Thus, lines must end with a return in order for +.B expect +to see them. +This may be changed via +.B stty +(see the +.B stty +command below). +.TP +.BI expect_user " [expect_args]" +is like +.B expect +but it reads characters from stdin (i.e. keystrokes from the user). +By default, reading is performed in cooked mode. +Thus, lines must end with a return in order for +.B expect +to see them. +This may be changed via +.B stty +(see the +.B stty +command below). +.TP +.B fork +creates a new process. The new process is an exact copy of the current +.B Expect +process. On success, +.B fork +returns 0 to the new (child) process and returns the process ID of the child +process to the parent process. +On failure (invariably due to lack of resources, e.g., swap space, memory), +.B fork +returns \-1 to the parent process, and no child process is created. +.IP +Forked processes exit via the +.B exit +command, just like the original process. +Forked processes are allowed to write to the log files. If you do not +disable debugging or logging in most of the processes, the result can be +confusing. +.IP +Some pty implementations may be confused by multiple readers and writers, +even momentarily. Thus, it is safest to +.B fork +before spawning processes. +.TP +.BI interact " [string1 body1] ... [stringn [bodyn]]" +gives control of the current process to the user, so that +keystrokes are sent to the current process, +and the stdout and stderr of the current process are returned. +.IP +String-body pairs may be specified as arguments, in which case the +body is executed when the corresponding string is entered. (By default, the +string is not sent to the current process.) The +.B interpreter +command is assumed, if the final body is missing. +.IP +If the arguments to the entire +.B interact +statement require more than one line, +all the arguments may be "braced" into one so as to avoid terminating each +line with a backslash. In this one case, the usual Tcl substitutions will +occur despite the braces. +.IP +For example, the following command runs interact with the following +string-body pairs defined: When ^Z is pressed, +.B Expect +is suspended. +(The +.B \-reset +flag restores the terminal modes.) +When ^A is pressed, the user sees "you typed a control-A" and the +process is sent a ^A. When $ is pressed, the user sees the date. +When ^C is pressed, +.B Expect +exits. If "foo" is entered, the user sees "bar". +When ~~ is pressed, the +.B Expect +interpreter runs interactively. +.nf + +.ta \w' interact 'u +\w'$CTRLZ 'u +\w'{'u + set CTRLZ \\032 + interact { + -reset $CTRLZ {exec kill \-STOP [pid]} + \\001 {send_user "you typed a control\-A\\n"; + send "\\001" + } + $ {send_user "The date is [exec date]."} + \\003 exit + foo {send_user "bar"} + ~~ + } + +.fi +.IP +In string-body pairs, strings are matched in the order they are listed +as arguments. Strings that partially match are not sent to the +current process in anticipation of the remainder coming. If +characters are then entered such that there can no longer possibly be +a match, only the part of the string will be sent to the process that cannot +possibly begin another match. Thus, strings that are substrings of +partial matches can match later, if the original strings that was attempting +to be match ultimately fails. +.IP +By default, string matching is exact with no wild cards. (In contrast, +the +.B expect +command uses glob-style patterns by default.) The +.B \-ex +flag may be used to protect patterns that might otherwise match +.B interact +flags from doing so. +Any pattern beginning with a "-" should be protected this way. (All strings +starting with "-" are reserved for future options.) + +The +.B \-re +flag forces the string to be interpreted as a regexp-style pattern. In this +case, matching substrings are stored in the variable +.I interact_out +similarly to the way +.B expect +stores its output in the variable +.BR expect_out . +The +.B \-indices +flag is similarly supported. + +The pattern +.B eof +introduces an action that is +executed upon end-of-file. A separate +.B eof +pattern may also follow the +.B \-output +flag in which case it is matched if an eof is detected while writing output. +The default +.B eof +action is "return", so that +.B interact +simply returns upon any EOF. + +The pattern +.B timeout +introduces a timeout (in seconds) and action that is executed +after no characters have been read for a given time. +The +.B timeout +pattern applies to the most recently specified process. +There is no default timeout. +The special variable "timeout" (used by the +.B expect +command) has no affect on this timeout. + +For example, the following statement could be used to autologout users who have +not typed anything for an hour but who still get frequent system +messages: +.nf + + interact -input $user_spawn_id timeout 3600 return -output \\ + $spawn_id + +.fi + +If the pattern is the keyword +.BR null , +and nulls are allowed (via the +.B remove_nulls +command), the corresponding body is executed if a single ASCII +0 is matched. +It is not possible to +match 0 bytes via glob or regexp patterns. + +Prefacing a pattern with the flag +.B \-iwrite +causes the variable +.I interact_out(spawn_id) +to be set to the spawn_id which matched the pattern +(or eof). + +Actions such as +.B break +and +.B continue +cause control structures (i.e., +.BR for , +.BR proc ) +to behave in the usual way. +However +.B return +causes interact to return to its caller, while +.B inter_return +causes +.B interact +to cause a return in its caller. For example, if "proc foo" called +.B interact +which then executed the action +.BR inter_return , +.B proc foo +would return. (This means that if +.B interact +calls +.B interpreter +interactively typing +.B return +will cause the interact to continue, while +.B inter_return +will cause the interact to return to its caller.) +.IP +During +.BR interact , +raw mode is used so that all characters may be passed to the current process. +If the current process does not catch job control signals, +it will stop if sent a stop signal (by default ^Z). +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. +.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 +For speed, actions execute in raw mode by default. The +.B \-reset +flag resets the terminal to the mode it had before +.B interact +was executed (invariably, cooked mode). +Note that characters entered when the mode is being switched may be lost +(an unfortunate feature of the terminal driver on some systems). +The only reason to use +.B \-reset +is if your action +depends on running in cooked mode. +.IP +The +.B \-echo +flag sends characters that match the following pattern back to the process +that generated them as each character is read. This may be useful +when the user needs to see feedback from partially typed patterns. +.IP +If a pattern is being echoed but eventually fails to match, +the characters are sent to the spawned process. If the spawned +process then echoes them, the user will see the characters twice. +.B \-echo +is probably only appropriate in situations where the user is +unlikely to not complete the pattern. For example, the following +excerpt is from rftp, the recursive-ftp script, where the user is +prompted to enter ~g, ~p, or ~l, to get, put, or list the current +directory recursively. These are so far away from the normal ftp +commands, that the user is unlikely to type ~ followed by anything +else, except mistakenly, in which case, they'll probably just ignore +the result anyway. +.nf + + interact { + -echo ~g {getcurdirectory 1} + -echo ~l {getcurdirectory 0} + -echo ~p {putcurdirectory} + } + +.fi +The +.B \-nobuffer +flag sends characters that match the following pattern on to +the output process as characters are read. + +This is useful when you wish to let a program echo back the pattern. +For example, the following might be used to monitor where a person is +dialing (a Hayes-style modem). Each time "atd" is seen the script +logs the rest of the line. +.nf + + proc lognumber {} { + interact -nobuffer -re "(.*)\\r" return + puts $log "[exec date]: dialed $interact_out(1,string)" + } + + interact -nobuffer "atd" lognumber + +.fi +.IP +During +.BR interact , +previous use of +.B log_user +is ignored. In particular, +.B interact +will force its output to be logged (sent to the standard output) +since it is presumed the user doesn't wish to interact blindly. +.IP +The +.B \-o +flag causes any following key-body pairs to be applied to the output of +the current process. +This can be useful, for example, when dealing with hosts that +send unwanted characters during a telnet session. +.IP +By default, +.B interact +expects the user to be writing stdin and reading stdout of the +.B Expect +process +itself. +The +.B \-u +flag (for "user") makes +.B interact +look for the user as the process named by its argument +(which must be a spawned id). +.IP +This allows two unrelated processes to be joined +together without using an explicit loop. To aid in debugging, Expect +diagnostics always go to stderr (or stdout for certain logging and +debugging information). For the same reason, the +.B interpreter +command will read interactively from stdin. +.IP +For example, the following fragment creates a login process. +Then it dials the user (not shown), and finally connects the two together. +Of course, any process may be substituted for login. +A shell, for example, would allow the user to work without supplying an +account and password. +.nf + + spawn login + set login $spawn_id + spawn tip modem + # dial back out to user + # connect user to login + interact \-u $login + +.fi +To send output to multiple processes, list each spawn id list prefaced by a +.B \-output +flag. Input for a group of output spawn ids may be determined +by a spawn id list prefaced by a +.B \-input +flag. (Both +.B \-input +and +.B \-output +may take lists in the same form as the +.B \-i +flag in the +.B expect +command, except that any_spawn_id is not meaningful in +.BR interact .) +All following flags and +strings (or patterns) apply to this input until another -input flag appears. +If no +.B \-input +appears, +.B \-output +implies "\-input $user_spawn_id \-output". +(Similarly, with patterns that do not have +.BR \-input .) +If one +.B \-input +is specified, it overrides $user_spawn_id. If a second +.B \-input +is specified, +it overrides $spawn_id. Additional +.B \-input +flags may be specified. + +The two implied input processes default to having their outputs specified as +$spawn_id and $user_spawn_id (in reverse). +If a +.B \-input +flag appears +with no +.B \-output +flag, characters from that process are discarded. + +The +.B \-i +flag introduces a replacement for the current spawn_id when no +other +.B \-input +or +.B \-output +flags are used. A \-i flag implies a \-o flag. + +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 +causes the user to be interactively prompted for +.B Expect +and Tcl commands. +The result of each command is printed. +.IP +Actions such as +.B break +and +.B continue +cause control structures (i.e., +.BR for , +.BR proc ) +to behave in the usual way. +However +.B return +causes interpreter to return to its caller, while +.B inter_return +causes +.B interpreter +to cause a return in its caller. For example, if "proc foo" called +.B interpreter +which then executed the action +.BR inter_return , +.B proc foo +would return. +Any other command causes +.B interpreter +to continue prompting for new commands. +.IP +By default, the prompt contains two integers. +The first integer describes the depth of +the evaluation stack (i.e., how many times Tcl_Eval has been called). The +second integer is the Tcl history identifier. The prompt can be set by +defining a procedure called "prompt1" whose return value becomes the next +prompt. If a statement has open quotes, parens, braces, or brackets, a +secondary prompt (by default "+> ") is issued upon newline. The secondary +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. +.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. +.B log_file +will stop recording if no argument is given. Any previous log file is closed. + +Instead of a filename, a Tcl file identifier may be provided by using the +.B \-open +or +.B \-leaveopen +flags. This is similar to the +.B spawn +command. (See +.B spawn +for more info.) + +The +.B \-a +flag forces output to be logged that was suppressed by the +.B log_user +command. + +By default, the +.B log_file +command +.I appends +to old files rather than truncating them, +for the convenience of being able to turn logging off and on multiple +times in one session. +To truncate files, use the +.B \-noappend +flag. + +The +.B -info +flag causes log_file to return a description of the +most recent non-info arguments given. +.TP +.BI log_user " -info|0|1" +By default, the send/expect dialogue is logged to stdout +(and a logfile if open). +The logging to stdout is disabled by the command "log_user 0" +and reenabled by "log_user 1". Logging to the logfile is unchanged. + +The +.B -info +flag causes log_user to return a description of the +most recent non-info arguments given. +.TP +.BI match_max " [\-d] [\-i spawn_id] [size]" +defines the size of the buffer (in bytes) used internally by +.BR expect . +With no +.I size +argument, the current size is returned. +.IP +With the +.B \-d +flag, the default size is set. (The initial default is 2000.) +With the +.B \-i +flag, the size is set for the named spawn id, otherwise it is set for +the current process. +.TP +.BI overlay " [\-# spawn_id] [\-# spawn_id] [...] program [args]" +executes +.IR "program args" +in place of the current +.B Expect +program, which terminates. +A bare hyphen argument forces a hyphen in front of the command name as if +it was a login shell. +All spawn_ids are closed except for those named as arguments. These +are mapped onto the named file identifiers. +.IP +Spawn_ids are mapped to file identifiers for the new program to inherit. +For example, the following line runs chess and allows it to be +controlled by the current process \- say, a chess master. +.nf + + overlay \-0 $spawn_id \-1 $spawn_id \-2 $spawn_id chess + +.fi +This is more efficient than +"interact \-u", however, it sacrifices the ability to do programmed +interaction since the +.B Expect +process is no longer in control. +.IP +Note that no controlling terminal is provided. Thus, if you +disconnect or remap standard input, programs that do +job control (shells, login, etc) will not function properly. +.TP +.BI parity " [\-d] [\-i spawn_id] [value]" +defines whether parity should be retained or stripped from the output of +spawned processes. If +.I value +is zero, parity is stripped, otherwise it is not stripped. +With no +.I value +argument, the current value is returned. +.IP +With the +.B \-d +flag, the default parity value is set. (The initial default is 1, i.e., +parity is not stripped.) +With the +.B \-i +flag, the parity value is set for the named spawn id, otherwise it is set for +the current process. +.TP +.BI remove_nulls " [\-d] [\-i spawn_id] [value]" +defines whether nulls are retained or removed from the output of +spawned processes before pattern matching +or storing in the variable +.I expect_out +or +.IR interact_out . +If +.I value +is 1, nulls are removed. If +.I value +is 0, nulls are not removed. +With no +.I value +argument, the current value is returned. +.IP +With the +.B \-d +flag, the default value is set. (The initial default is 1, i.e., +nulls are removed.) +With the +.B \-i +flag, the value is set for the named spawn id, otherwise it is set for +the current process. + +Whether or not nulls are removed, +.B Expect +will record null bytes to the log and stdout. +.TP +.BI send " [\-flags] string" +Sends +.IR string +to the current process. +For example, the command +.nf + + send "hello world\\r" + +.fi +sends the characters, h e l l o w o r l d to the +current process. +(Tcl includes a printf-like command (called +.BR format ) +which can build arbitrarily complex strings.) +.IP +Characters are sent immediately although programs with line-buffered input +will not read the characters until a return character is sent. A return +character is denoted "\\r". + +The +.B \-\- +flag forces the next argument to be interpreted as a string rather than a flag. +Any string can be preceded by "\-\-" whether or not it actually looks +like a flag. This provides a reliable mechanism to specify variable strings +without being tripped up by those that accidentally look like flags. +(All strings starting with "-" are reserved for future options.) + +The +.B \-i +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. +The +.B \-raw +flag disables this translation. + +The +.BR \-null +flag sends null characters (0 bytes). By default, one null is sent. +An integer may follow the +.BR \-null +to indicate how many nulls to send. + +The +.B \-break +flag generates a break condition. This only makes sense if the spawn +id refers to a tty device opened via "spawn -open". If you have +spawned a process such as tip, you should use tip's convention for +generating a break. + +The +.B \-s +flag forces output to be sent "slowly", thus avoid the common situation +where a computer outtypes an input buffer that was designed for a +human who would never outtype the same buffer. This output is +controlled by the value of the variable "send_slow" which takes a two +element list. The first element is an integer that describes the +number of bytes to send atomically. The second element is a real +number that describes the number of seconds by which the atomic sends +must be separated. For example, "set send_slow {10 .001}" would force +"send \-s" to send strings with 1 millisecond in between each 10 +characters sent. + +The +.B \-h +flag forces output to be sent (somewhat) like a human actually typing. +Human-like delays appear between the characters. (The algorithm is +based upon a Weibull distribution, with modifications to suit this +particular application.) This output is controlled by the value of +the variable "send_human" which takes a five element list. The first +two elements are average interarrival time of characters in seconds. +The first is used by default. The second is used at word endings, to +simulate the subtle pauses that occasionally occur at such +transitions. The third parameter is a measure of variability where .1 +is quite variable, 1 is reasonably variable, and 10 is quite +invariable. The extremes are 0 to infinity. The last two parameters +are, respectively, a minimum and maximum interarrival time. +The minimum and maximum are used last and "clip" the final time. +The ultimate average can be quite different from the given average +if the minimum and maximum clip enough values. + +As an +example, the following command emulates a fast and +consistent typist: +.nf + + set send_human {.1 .3 1 .05 2} + send \-h "I'm hungry. Let's do lunch." + +.fi +while the following might be more suitable after a hangover: +.nf + + set send_human {.4 .4 .2 .5 100} + send \-h "Goodd party lash night!" + +.fi +Note that errors are not simulated, although you can set up error +correction situations yourself by embedding mistakes and corrections +in a send argument. + +The flags for sending null characters, for sending breaks, for forcing slow +output and for human-style output are mutually exclusive. Only the one +specified last will be used. Furthermore, no +.I string +argument can be specified with the flags for sending null characters or breaks. + +It is a good idea to precede the first +.B send +to a process by an +.BR expect . +.B expect +will wait for the process to start, while +.B send +cannot. +In particular, if the first +.B send +completes before the process starts running, +you run the risk of having your data ignored. +In situations where interactive programs offer no initial prompt, +you can precede +.B send +by a delay as in: +.nf + + # To avoid giving hackers hints on how to break in, + # this system does not prompt for an external password. + # Wait for 5 seconds for exec to complete + spawn telnet very.secure.gov + sleep 5 + send password\\r + +.fi +.B exp_send +is an alias for +.BI send . +If you are using Expectk or some other variant of Expect in the Tk environment, +.B send +is defined by Tk for an entirely different purpose. +.B exp_send +is provided for compatibility between environments. +Similar aliases are provided for other Expect's other send commands. +.TP +.BI send_error " [\-flags] string" +is like +.BR send , +except that the output is sent to stderr rather than the current +process. +.TP +.BI send_log " [\--] string" +is like +.BR send , +except that the string is only sent to the log file (see +.BR log_file .) +The arguments are ignored if no log file is open. +.TP +.BI send_tty " [\-flags] string" +is like +.BR send , +except that the output is sent to /dev/tty rather than the current +process. +.TP +.BI send_user " [\-flags] string" +is like +.BR send , +except that the output is sent to stdout rather than the current +process. +.TP +.BI sleep " seconds" +causes the script to sleep for the given number of seconds. +Seconds may be a decimal number. Interrupts (and Tk events if you +are using Expectk) are processed while Expect sleeps. +.TP +.BI spawn " [args] program [args]" +creates a new process running +.IR "program args" . +Its stdin, stdout and stderr are connected to Expect, +so that they may be read and written by other +.B Expect +commands. +The connection is broken by +.B close +or if the process itself closes any of the file identifiers. +.IP +When a process is started by +.BR spawn , +the variable +.I spawn_id +is set to a descriptor referring to that process. +The process described by +.I spawn_id +is considered the +.IR "current process" . +.I spawn_id +may be read or written, in effect providing job control. +.IP +.I user_spawn_id +is a global variable containing a descriptor which refers to the user. +For example, when +.I spawn_id +is set to this value, +.B expect +behaves like +.BR expect_user . + +.I +.I error_spawn_id +is a global variable containing a descriptor which refers to the standard +error. +For example, when +.I spawn_id +is set to this value, +.B send +behaves like +.BR send_error . +.IP +.I tty_spawn_id +is a global variable containing a descriptor which refers to /dev/tty. +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]} { + # /dev/tty exists + } else { + # /dev/tty doesn't exist + # probably in cron, batch, or at script + } + +.fi +.IP +.B spawn +returns the UNIX process id. If no process is spawned, 0 is returned. +The variable +.I spawn_out(slave,name) +is set to the name of the pty slave device. +.IP +By default, +.B spawn +echoes the command name and arguments. The +.B \-noecho +flag stops +.B spawn +from doing this. +.IP +The +.B \-console +flag causes console output to be redirected to the spawned process. +This is not supported on all systems. + +Internally, +.B spawn +uses a pty, initialized the same way as the user's tty. This is further +initialized so that all settings are "sane" (according to stty(1)). +If the variable +.I stty_init +is defined, it is interpreted in the style of stty arguments +as further configuration. +For example, "set stty_init raw" will cause further spawned processes's +terminals to start in raw mode. +.B \-nottycopy +skips the initialization based on the user's tty. +.B \-nottyinit +skips the "sane" initialization. +.IP +Normally, +.B spawn +takes little time to execute. If you notice spawn taking a +significant amount of time, it is probably encountering ptys that are +wedged. A number of tests are run on ptys to avoid entanglements with +errant processes. (These take 10 seconds per wedged pty.) Running +Expect with the +.B \-d +option will show if +.B Expect +is encountering many ptys in odd states. If you cannot kill +the processes to which these ptys are attached, your only recourse may +be to reboot. + +If +.I program +cannot be spawned successfully because exec(2) fails (e.g. when +.I program +doesn't exist), an error message will be returned by the next +.B interact +or +.B expect +command as if +.I program +had run and produced the error message as output. +This behavior is a natural consequence of the implementation of +.BR spawn . +Internally, spawn forks, after which the spawned process has no +way to communicate with the original +.B Expect +process except by communication +via the spawn_id. + +The +.B \-open +flag causes the next argument to be interpreted as a Tcl file identifier +(i.e., returned by +.BR open .) +The spawn id can then be used as if it were a spawned process. (The file +identifier should no longer be used.) +This lets you treat raw devices, files, and +pipelines as spawned processes without using a pty. 0 is returned to +indicate there is no associated process. When the connection to +the spawned process is closed, so is the Tcl file identifier. +The +.B \-leaveopen +flag is similar to +.B \-open +except that +.B \-leaveopen +causes the file identifier to be left open even after the spawn id is closed. + +The +.B \-pty +flag causes a pty to be opened but no process spawned. 0 is returned +to indicate there is no associated process. Spawn_id is set as usual. + +The variable +.I spawn_out(slave,fd) +is set to a file identifier corresponding to the pty slave. +It can be closed using "close -slave". + +The +.B \-ignore +flag names a signal to be ignored in the spawned process. +Otherwise, signals get the default behavior. +Signals are named as in the +.B trap +command, except that each signal requires a separate flag. +.TP +.BI strace " level" +causes following statements to be printed before being executed. +(Tcl's trace command traces variables.) +.I level +indicates how far down in the call stack to trace. +For example, +the following command runs +.B Expect +while tracing the first 4 levels of calls, +but none below that. +.nf + + expect \-c "strace 4" script.exp + +.fi + +The +.B -info +flag causes strace to return a description of the +most recent non-info arguments given. +.TP +.BI stty " args" +changes terminal modes similarly to the external stty command. + +By default, the controlling terminal is accessed. Other terminals can +be accessed by appending "< /dev/tty..." to the command. (Note that +the arguments should not be grouped into a single argument.) + +Requests for status return it as the result of the command. If no status +is requested and the controlling terminal is accessed, the previous +status of the raw and echo attributes are returned in a form which can +later be used by the command. + +For example, the arguments +.B raw +or +.B \-cooked +put the terminal into raw mode. +The arguments +.B \-raw +or +.B cooked +put the terminal into cooked mode. +The arguments +.B echo +and +.B \-echo +put the terminal into echo and noecho mode respectively. +.IP +The following example illustrates how to temporarily disable echoing. +This could be used in otherwise-automatic +scripts to avoid embedding passwords in them. +(See more discussion on this under EXPECT HINTS below.) +.nf + + stty \-echo + send_user "Password: " + expect_user -re "(.*)\\n" + set password $expect_out(1,string) + stty echo + +.fi +.TP +.BI system " args" +gives +.I args +to sh(1) as input, +just as if it had been typed as a command from a terminal. +.B Expect +waits until the shell terminates. +The return status from sh is handled the same way that +.B exec +handles its return status. +.IP +In contrast to +.B exec +which redirects stdin and stdout to the script, +.B system +performs no redirection +(other than that indicated by the string itself). +Thus, it is possible to use programs which must talk directly to /dev/tty. +For the same reason, the results of +.B system +are not recorded in the log. +.TP +.BI timestamp " [args]" +returns a timestamp. +With no arguments, the number of +seconds since the epoch is returned. + +The +.B \-format +flag introduces a string which is returned but with +substitutions made according to the +POSIX rules for strftime. For example %a is replaced by an abbreviated +weekday name (i.e., Sat). Others are: +.nf + %a abbreviated weekday name + %A full weekday name + %b abbreviated month name + %B full month name + %c date-time as in: Wed Oct 6 11:45:56 1993 + %d day of the month (01-31) + %H hour (00-23) + %I hour (01-12) + %j day (001-366) + %m month (01-12) + %M minute (00-59) + %p am or pm + %S second (00-61) + %u day (1-7, Monday is first day of week) + %U week (00-53, first Sunday is first day of week one) + %V week (01-53, ISO 8601 style) + %w day (0-6) + %W week (00-53, first Monday is first day of week one) + %x date-time as in: Wed Oct 6 1993 + %X time as in: 23:59:59 + %y year (00-99) + %Y year as in: 1993 + %Z timezone (or nothing if not determinable) + %% a bare percent sign + +.fi +Other % specifications are undefined. Other characters will be passed +through untouched. Only the C locale is supported. + +The +.B \-seconds +flag introduces a number of seconds since the epoch to be used as a source +from which to format. Otherwise, the current time is used. + +The +.B \-gmt +flag forces timestamp output to use the GMT timezone. With no flag, +the local timezone is used. +.TP +.BI trap " [[command] signals]" +causes the given +.I command +to be executed upon future receipt of any of the given signals. +The command is executed in the global scope. +If +.I command +is absent, the signal action is returned. +If +.I command +is the string SIG_IGN, the signals are ignored. +If +.I command +is the string SIG_DFL, the signals are result to the system default. +.I signals +is either a single signal or a list of signals. Signals may be specified +numerically or symbolically as per signal(3). The "SIG" prefix may be omitted. + +With no arguments (or the argument \-number), +.B trap +returns the signal number of the trap command currently being executed. + +The +.B \-code +flag uses the return code of the command in place of whatever code Tcl +was about to return when the command originally started running. + +The +.B \-interp +flag causes the command to be evaluated using the interpreter +active at the time the command started running +rather than when the trap was declared. + +The +.B \-name +flag causes the +.B trap +command to return the signal name of the trap command currently being executed. + +The +.B \-max +flag causes the +.B trap +command to return the largest signal number that can be set. + +For example, the command "trap {send_user "Ouch!"} SIGINT" will print "Ouch!" +each time the user presses ^C. + +By default, SIGINT (which can usually be generated by pressing ^C) and +SIGTERM cause Expect to exit. This is due to the following trap, created +by default when Expect starts. +.nf + + trap exit {SIGINT SIGTERM} + +.fi +If you use the -D flag to start the debugger, SIGINT is redefined +to start the interactive debugger. This is due to the following trap: +.nf + + trap {exp_debug 1} SIGINT + +.fi +The debugger trap can be changed by setting the environment variable +EXPECT_DEBUG_INIT to a new trap command. + +You can, of course, override both of these just by adding trap +commands to your script. In particular, if you have your own "trap +exit SIGINT", this will override the debugger trap. This is useful +if you want to prevent users from getting to the debugger at all. + +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} + +.fi +Alternatively, you can trap to the debugger using some other signal. + +.B trap +will not let you override the action for SIGALRM as this is used internally +to +.BR Expect . +The disconnect command sets SIGALRM to SIG_IGN (ignore). You can reenable +this as long as you disable it during subsequent spawn commands. + +See signal(3) for more info. +.TP +.BI wait " [args]" +delays until a spawned process (or +the current process if none is named) terminates. +.IP +.B wait +normally returns a list of four integers. +The first integer is the pid of the process that was waited upon. +The second integer is the corresponding spawn id. +The third integer is -1 if an operating system error occurred, or 0 otherwise. +If the third integer was 0, the fourth integer is the status returned by +the spawned process. If the third integer was -1, the fourth integer is +the value of errno set by the operating system. The global variable +errorCode is also set. + +Additional elements may appear at the end of the return value from +.BR wait . +An optional fifth element identifies a class of information. +Currently, the only possible value for this element is CHILDKILLED in +which case the next two values are the C-style signal name and a short +textual description. +.IP +The +.B \-i +flag declares the process to wait corresponding to the named spawn_id +(NOT the process id). +Inside a SIGCHLD handler, +it is possible to wait for any spawned process by using the spawn id -1. + +The +.B \-nowait +flag causes the wait to return immediately with the indication of a +successful wait. When the process exits (later), it will automatically +disappear without the need for an explicit wait. + +The +.B wait +command may also be used wait for a forked process using the arguments +"-i -1". Unlike its use with spawned processes, this command can be +executed at any time. There is no control over which process is +reaped. However, the return value can be checked for the process id. + +.SH LIBRARIES +Expect automatically knows about two built-in libraries for Expect scripts. +These are defined by the directories named in the variables +exp_library and exp_exec_library. Both are meant to contain utility +files that can be used by other scripts. + +exp_library contains architecture-independent files. exp_exec_library +contains architecture-dependent files. Depending on your system, both +directories may be totally empty. The existence of the file +$exp_exec_library/cat-buffers describes whether your /bin/cat buffers +by default. +.SH PRETTY-PRINTING +A vgrind definition is available for pretty-printing +.B Expect +scripts. +Assuming the vgrind definition supplied with the +.B Expect +distribution is +correctly installed, you can use it as: +.nf + + vgrind \-lexpect file + +.fi +.SH EXAMPLES +It many not be apparent how to put everything together that the man page +describes. I encourage you to read and try out the examples in +the example directory of the +.B Expect +distribution. +Some of them are real programs. Others are simply illustrative +of certain techniques, and of course, a couple are just quick hacks. +The INSTALL file has a quick overview of these programs. +.PP +The +.B Expect +papers (see SEE ALSO) are also useful. While some papers +use syntax corresponding to earlier versions of Expect, the accompanying +rationales are still valid and go into a lot more detail than this +man page. +.SH CAVEATS +Extensions may collide with Expect's command names. For example, +.B send +is defined by Tk for an entirely different purpose. +For this reason, most of the +.B Expect +commands are also available as "exp_XXXX". +Commands and variables beginning with "exp", "inter", "spawn", +and "timeout" do not have aliases. +Use the extended command names if you need this compatibility between environments. + +.B Expect +takes a rather liberal view of scoping. +In particular, variables read by commands specific to the +.B Expect +program will be sought first from the local scope, and if not found, in the +global scope. For example, this +obviates the need to place "global timeout" in every +procedure you write that uses +.BR expect . +On the other hand, variables written are always in the local scope (unless +a "global" command has been issued). The most common problem this causes +is when spawn is executed in a procedure. Outside the procedure, +.I spawn_id +no longer exists, so the spawned process is no longer accessible +simply because of scoping. Add a "global spawn_id" to such a procedure. + +If you cannot enable the multispawning capability +(i.e., your system supports neither select (BSD *.*), poll (SVR>2), +nor something equivalent), +.B Expect +will only be able to control a single process at a time. +In this case, do not attempt to set +.IR spawn_id , +nor should you execute processes via exec while a spawned process +is running. Furthermore, you will not be able to +.B expect +from multiple processes (including the user as one) at the same time. + +Terminal parameters can have a big effect on scripts. For example, if +a script is written to look for echoing, it will misbehave if echoing +is turned off. For this reason, Expect forces sane terminal +parameters by default. Unfortunately, this can make things unpleasant +for other programs. As an example, the emacs shell wants to change +the "usual" mappings: newlines get mapped to newlines instead of +carriage-return newlines, and echoing is disabled. This allows one to +use emacs to edit the input line. Unfortunately, Expect cannot +possibly guess this. + +You can request that Expect not override its default setting of +terminal parameters, but you must then be very careful when writing +scripts for such environments. In the case of emacs, avoid depending +upon things like echoing and end-of-line mappings. + +The commands that accepted arguments braced into a single list (the +.B expect +variants and +.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 "\-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. + +On some systems, when a shell is spawned, it complains about not being +able to access the tty but runs anyway. This means your system has a +mechanism for gaining the controlling tty that +.B Expect +doesn't know about. Please find out what it is, and send this information +back to me. + +Ultrix 4.1 (at least the latest versions around here) considers +timeouts of above 1000000 to be equivalent to 0. + +Digital UNIX 4.0A (and probably other versions) refuses to allocate +ptys if you define a SIGCHLD handler. See grantpt page for more info. + +IRIX 6.0 does not handle pty permissions correctly so that if Expect +attempts to allocate a pty previously used by someone else, it fails. +Upgrade to IRIX 6.1. + +Telnet (verified only under SunOS 4.1.2) hangs if TERM is not set. +This is a problem under cron, at and in cgi scripts, which do not +define TERM. Thus, you must set it explicitly - to what type is +usually irrelevant. It just has to be set to something! The +following probably suffices for most cases. +.nf + + set env(TERM) vt100 + +.fi + +Tip (verified only under BSDI BSD/OS 3.1 i386) hangs if SHELL and HOME +are not set. This is a problem under cron, at and in cgi scripts, +which do not define these environment variables. Thus, you must set +them explicitly - to what type is usually irrelevant. It just has to +be set to something! The following probably suffices for most cases. +.nf + + set env(SHELL) /bin/sh + set env(HOME) /usr/local/bin + +.fi + + +Some implementations of ptys are designed so that the kernel throws +away any unread output after 10 to 15 seconds (actual number is +implementation-dependent) after the process has closed the file +descriptor. Thus +.B Expect +programs such as +.nf + + spawn date + sleep 20 + expect + +.fi +will fail. To avoid this, invoke non-interactive programs with +.B exec +rather than +.BR spawn . +While such situations are conceivable, in practice I have never +encountered a situation in which the final output of a truly +interactive program would be lost due to this behavior. + +On the other hand, Cray UNICOS ptys throw away any unread output +immediately after the process has closed the file descriptor. I have +reported this to Cray and they are working on a fix. + +Sometimes a delay is required between a prompt and a response, such as +when a tty interface is changing UART settings or matching baud rates +by looking for start/stop bits. Usually, all this is require is to +sleep for a second or two. A more robust technique is to retry until +the hardware is ready to receive input. The following example uses +both strategies: +.nf + + send "speed 9600\\r"; + sleep 1 + expect { + timeout {send "\\r"; exp_continue} + $prompt + } + +.fi + +.SH EXPECT HINTS +There are a couple of things about +.B Expect +that may be non-intuitive. +This section attempts to address some of these things with a couple of +suggestions. + +A common expect problem is how to recognize shell prompts. Since +these are customized differently by differently people and different +shells, portably automating rlogin can be difficult without knowing +the prompt. A reasonable convention is to have users store a regular +expression describing their prompt (in particular, the end of it) in +the environment variable EXPECT_PROMPT. Code like the following +can be used. If EXPECT_PROMPT doesn't exist, the code still has a good chance of functioning correctly. +.nf + + set prompt "(%|#|\\\\$) $" ;# default prompt + catch {set prompt $env(EXPECT_PROMPT)} + + expect -re $prompt + +.fi +I encourage you to write +.B expect +patterns that include the end of whatever +you expect to see. This avoids the possibility of answering a question +before seeing the entire thing. In addition, while you may well be +able to answer questions before seeing them entirely, if you answer +early, your answer may appear echoed back in the middle of the question. +In other words, the resulting dialogue will be correct but look scrambled. + +Most prompts include a space character at the end. +For example, the prompt from ftp is 'f', 't', 'p', '>' and . +To match this prompt, you must account for each of these characters. +It is a common mistake not to include the blank. +Put the blank in explicitly. + +If you use a pattern of the form X*, the * will match all the output +received from the end of X to the last thing received. +This sounds intuitive but can be somewhat confusing because the phrase +"last thing received" can vary depending upon the speed of the computer +and the processing of I/O both by the kernel and the device driver. +.PP +In particular, humans tend to see program output arriving in huge chunks +(atomically) when in reality most programs produce output one +line at a time. Assuming this is the case, the * in the pattern of the +previous paragraph may only match the end of the current line even though +there seems to be more, because at the time of the match that was all +the output that had been received. +.PP +.B expect +has no way of knowing that further output is coming unless your +pattern specifically accounts for it. +.PP +Even depending on line-oriented buffering is unwise. Not only do programs +rarely make promises about the type of buffering they do, but system +indigestion can break output lines up so that lines break at seemingly +random places. Thus, if you can express the last few characters +of a prompt when writing patterns, it is wise to do so. + +If you are waiting for a pattern in the last output of a program +and the program emits something else instead, you will not be able to +detect that with the +.B timeout +keyword. The reason is that +.B expect +will not timeout \- instead it will get an +.B eof +indication. +Use that instead. Even better, use both. That way if that line +is ever moved around, you won't have to edit the line itself. + +Newlines are usually converted to carriage return, linefeed sequences +when output by the terminal driver. Thus, if you want a pattern that +explicitly matches the two lines, from, say, printf("foo\\nbar"), +you should use the pattern "foo\\r\\nbar". +.PP +A similar translation occurs when reading from the user, via +.BR expect_user . +In this case, when you press return, it will be +translated to a newline. If +.B Expect +then passes that to a program +which sets its terminal to raw mode (like telnet), there is going to +be a problem, as the program expects a true return. (Some programs +are actually forgiving in that they will automatically translate +newlines to returns, but most don't.) Unfortunately, there is no way to find +out that a program put its terminal into raw mode. +.PP +Rather than manually replacing newlines with returns, the solution is to +use the command "stty raw", which will stop the translation. +Note, however, that this means that you will no longer get the cooked +line-editing features. +.PP +.B interact +implicitly sets your terminal to raw mode so this problem will not arise then. + +It is often useful to store passwords (or other private information) +in +.B Expect +scripts. This is not recommended since anything that is +stored on a computer is susceptible to being accessed by anyone. +Thus, interactively prompting for passwords from a script is a smarter +idea than embedding them literally. Nonetheless, sometimes such embedding +is the only possibility. +.PP +Unfortunately, the UNIX file system has no direct way of creating +scripts which are executable but unreadable. Systems which support +setgid shell scripts may indirectly simulate this as follows: +.PP +Create the +.B Expect +script (that contains the secret data) as usual. +Make its permissions be 750 (\-rwxr\-x\-\-\-) and owned by a trusted group, +i.e., a group which is allowed to read it. If necessary, create a new +group for this purpose. Next, create a /bin/sh script with +permissions 2751 (\-rwxr\-s\-\-x) owned by the same group as before. +.PP +The result is a script which may be executed (and read) by anyone. +When invoked, it runs the +.B Expect +script. +.SH SEE ALSO +.BR Tcl (3), +.BR libexpect (3) +.br +.I +"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" +\fRby Don Libes, pp. 602, ISBN 1-56592-090-2, O'Reilly and Associates, 1995. +.br +.I +"expect: Curing Those Uncontrollable Fits of Interactivity" \fRby Don Libes, +Proceedings of the Summer 1990 USENIX Conference, +Anaheim, California, June 11-15, 1990. +.br +.I +"Using +.B expect +to Automate System Administration Tasks" \fRby Don Libes, +Proceedings of the 1990 USENIX Large Installation Systems Administration +Conference, Colorado Springs, Colorado, October 17-19, 1990. +.br +.I +"Tcl: An Embeddable Command Language" \fRby John Ousterhout, +Proceedings of the Winter 1990 USENIX Conference, +Washington, D.C., January 22-26, 1990. +.br +.I +"expect: Scripts for Controlling Interactive Programs" \fRby Don Libes, +Computing Systems, Vol. 4, No. 2, University of California Press Journals, +November 1991. +.br +.I +"Regression Testing and Conformance Testing Interactive Programs", \fRby Don +Libes, Proceedings of the Summer 1992 USENIX Conference, pp. 135-144, +San Antonio, TX, June 12-15, 1992. +.br +.I +"Kibitz \- Connecting Multiple Interactive Programs Together", \fRby Don Libes, +Software \- Practice & Experience, John Wiley & Sons, West Sussex, England, +Vol. 23, No. 5, May, 1993. +.br +.I +"A Debugger for Tcl Applications", \fRby Don Libes, +Proceedings of the 1993 Tcl/Tk Workshop, Berkeley, CA, June 10-11, 1993. +.SH AUTHOR +Don Libes, National Institute of Standards and Technology +.SH ACKNOWLEDGMENTS +Thanks to John Ousterhout for Tcl, and Scott Paisley for inspiration. +Thanks to Rob Savoye for Expect's autoconfiguration code. +.PP +The HISTORY file documents much of the evolution of +.BR expect . +It makes interesting reading and might give you further insight to this +software. Thanks to the people mentioned in it who sent me bug fixes +and gave other assistance. +.PP +Design and implementation of +.B Expect +was paid for in part by the U.S. government and is therefore in the public +domain. +However the author and NIST would like credit +if this program and documentation or portions of them are used. ADDED doc/expectk.man Index: doc/expectk.man ================================================================== --- /dev/null +++ doc/expectk.man @@ -0,0 +1,42 @@ +.TH EXPECTK 1 "15 February 1993" +.SH NAME +expectk \- Expect with Tk support +.SH SYNOPSIS +.B expectk +[ +.I args +] +.SH INTRODUCTION +.B Expectk +is a combination of Expect with Tk. (See their respective man pages for a more comprehensive explanation +of either.) +.B Expectk +should run any +.B wish +or +.B Expect +script (with minor changes - see below). +.PP +The differences between the Expectk and Expect environment follows. +.PP +The +.B send +command is Tk's. Expect's +.B send +command can be invoked by the name +.BR exp_send . +(For compatibility, Expect allows either +.B send +or +.B exp_send +to be used.) +.PP +Scripts may be invoked implicitly on systems which support the #! notation +by marking the script executable, and making the first line in your script: + + #!/usr/local/bin/expectk \-f + +Of course, the path must accurately describe where +.B Expectk +lives. /usr/local/bin is just an example. + ADDED doc/libexpect.man Index: doc/libexpect.man ================================================================== --- /dev/null +++ doc/libexpect.man @@ -0,0 +1,690 @@ +.TH LIBEXPECT 3 "12 December 1991" +.SH NAME +libexpect \- programmed dialogue with interactive programs \- C functions +.SH DESCRIPTION +This library contains functions that allow Expect to be used as +a Tcl extension or to be used directly from C or C++ (without Tcl). +Adding Expect as a Tcl extension is very short and simple, so that will be +covered first. +.SH SYNOPSIS +.nf + +.B #include "expect_tcl.h" +.B Expect_Init(interp); + +.B cc files... \-lexpect5.20 \-ltcl7.5 \-lm + +.fi +Note: library versions may differ in the actual release. + +The Expect_Init function adds expect commands to the named +interpreter. It avoids overwriting commands that already exist, +however aliases beginning with "exp_" are always created for expect +commands. So for example, "send" can be used as "exp_send". + +Generally, you should only call Expect commands via Tcl_Eval. +Certain auxiliary functions may be called directly. They are summarized +below. They may be useful in constructing your own main. Look +at the file exp_main_exp.c in the Expect distribution as +a prototype main. Another prototype is tclAppInit.c in the +Tcl source distribution. A prototype for working with Tk is in +exp_main_tk.c in the Expect distribution. +.nf + +int exp_cmdlinecmds; +int exp_interactive; +FILE *exp_cmdfile; +char *exp_cmdfilename; +int exp_tcl_debugger_available; + +void exp_parse_argv(Tcl_Interp *,int argc,char **argv); +int exp_interpreter(Tcl_Interp *); +void exp_interpret_cmdfile(Tcl_Interp *,FILE *); +void exp_interpret_cmdfilename(Tcl_Interp *,char *); +void exp_interpret_rcfiles(Tcl_Interp *,int my_rc,int sys_rc); +char * exp_cook(char *s,int *len); +void (*exp_app_exit)EXP_PROTO((Tcl_Interp *); +void exp_exit(Tcl_Interp *,int status); +void exp_exit_handlers(Tcl_Interp *); +void exp_error(Tcl_Interp,char *,...); + +.fi +.B exp_cmdlinecmds +is 1 if Expect has been invoked with commands on the program command-line (using "-c" for example). +.B exp_interactive +is 1 if Expect has been invoked with the -i flag or if no commands or script is being invoked. +.B exp_cmdfile +is a stream from which Expect will read commands. +.B exp_cmdfilename +is the name of a file which Expect will open and read commands from. +.B exp_tcl_debugger_available +is 1 if the debugger has been armed. + +.B exp_parse_argv +reads the representation of the command line. +Based on what is found, any of the other variables listed here +are initialized appropriately. +.B exp_interpreter +interactively prompts the user for commands and evaluates them. +.B exp_interpret_cmdfile +reads the given stream and evaluates any commands found. +.B exp_interpret_cmdfilename +opens the named file and evaluates any commands found. +.B exp_interpret_rcfiles +reads and evalutes the .rc files. If my_rc is zero, +then ~/.expectrc is skipped. If sys_rc is zero, then the system-wide +expectrc file is skipped. +.B exp_cook +returns a static buffer containing the argument reproduced with +newlines replaced by carriage-return linefeed sequences. +The primary purpose of this is to allow messages to be produced +without worrying about whether the terminal is in raw mode or +cooked mode. +If length is zero, it is computed via strlen. +.B exp_error is a printf-like function that writes the result +to interp->result. +.SH SYNOPSIS +.nf +.B #include + +.B int +.B "exp_spawnl(file, arg0 [, arg1, ..., argn] (char *)0);" +.B char *file; +.B char *arg0, *arg1, ... *argn; + +.B int +.B exp_spawnv(file,argv); +.B char *file, *argv[ ]; + +.B int +.B exp_spawnfd(fd); +.B int fd; + +.B FILE * +.B exp_popen(command); +.B char *command; + +.B extern int exp_pid; +.B extern int exp_ttyinit; +.B extern int exp_ttycopy; +.B extern int exp_console; +.B extern char *exp_stty_init; +.B extern void (*exp_close_in_child)(); +.B extern void (*exp_child_exec_prelude)(); +.B extern void exp_close_tcl_files(); + +.B cc files... \-lexpect \-ltcl \-lm +.fi + +.SH DESCRIPTION +.B exp_spawnl +and +.B exp_spawnv +fork a new process so that its stdin, +stdout, and stderr can be written and read by the current process. +.I file +is the name of a file to be executed. The +.I arg +pointers are +null-terminated strings. Following the style of execve(), +.I arg0 +(or +.IR argv[0] ) +is customarily a duplicate of the name of the file. +.PP +Four interfaces are available, +.B exp_spawnl +is useful when the number of +arguments is known at compile time. +.B exp_spawnv +is useful when the number of arguments is not known at compile time. +.B exp_spawnfd +is useful when an open file descriptor is already available as a source. +.B exp_popen +is explained later on. +.PP +If the process is successfully created, a file descriptor is returned +which corresponds to the process's stdin, stdout and stderr. +A stream may be associated with the file descriptor by using fdopen(). +(This should almost certainly be followed by setbuf() to unbuffer the I/O.) +.PP +Closing the file descriptor will typically be detected by the +process as an EOF. Once such a process exits, it should be waited +upon (via wait) in order to free up the kernel process slot. (Some systems +allow you to avoid this if you ignore the SIGCHLD signal). +.PP +.B exp_popen +is yet another interface, styled after popen(). It takes a Bourne +shell command line, and returns a stream that corresponds to the process's +stdin, stdout and stderr. The actual implementation of +.B exp_popen +below demonstrates +.BR exp_spawnl . +.nf + +FILE * +exp_popen(program) +char *program; +{ + FILE *fp; + int ec; + + if (0 > (ec = exp_spawnl("sh","sh","-c",program,(char *)0))) + return(0); + if (NULL == (fp = fdopen(ec,"r+")) return(0); + setbuf(fp,(char *)0); + return(fp); +} +.fi + +After a process is started, the variable +.B exp_pid +is set to the process-id of the new process. The variable +.B exp_pty_slave_name +is set to the name of the slave side of the pty. + +The spawn functions uses a pty to communicate with the process. By +default, the pty is initialized the same way as the user's tty (if +possible, i.e., if the environment has a controlling terminal.) This +initialization can be skipped by setting exp_ttycopy to 0. + +The pty is further initialized to some system wide defaults if +exp_ttyinit is non-zero. The default is generally comparable to "stty sane". + +The tty setting can be further modified by setting the variable +.BR exp_stty_init . +This variable is interpreted in the style of stty arguments. For +example, exp_stty_init = "sane"; repeats the default initialization. + +On some systems, it is possible to redirect console output to ptys. +If this is supported, you can force the next spawn to obtain the +console output by setting the variable +.B exp_console +to 1. + +Between the time a process is started and the new program is given +control, the spawn functions can clean up the environment by closing +file descriptors. By default, the only file descriptors closed are +ones internal to Expect and any marked "close-on-exec". + +If needed, you can close additional file descriptors by creating +an appropriate function and assigning it to exp_close_in_child. +The function will be called after the fork and before the exec. +(This also modifies the behavior of the spawn command in Expect.) + +If you are also using Tcl, it may be convenient to use the function +exp_close_tcl_files which closes all files between the default +standard file descriptors and the highest descriptor known to Tcl. +(Expect does this.) + +The function exp_child_exec_prelude is the last function called prior +to the actual exec in the child. You can redefine this for effects +such as manipulating the uid or the signals. + +.SH "IF YOU WANT TO ALLOCATE YOUR OWN PTY" +.nf + +.B extern int exp_autoallocpty; +.B extern int exp_pty[2]; +.fi + +The spawn functions use a pty to communicate with the process. By +default, a pty is automatically allocated each time a process is spawned. +If you want to allocate ptys yourself, before calling one of the spawn +functions, set +.B exp_autoallocpty +to 0, +.B exp_pty[0] +to the master pty file descriptor and +.B exp_pty[1] +to the slave pty file descriptor. +The expect library will not do any pty initializations (e.g., exp_stty_init will not be used). +The slave pty file descriptor will be +automatically closed when the process is spawned. After the process is +started, all further communication takes place with the master pty file +descriptor. +.PP +.B exp_spawnl +and +.B exp_spawnv +duplicate the shell's actions +in searching for an executable file in a list of directories. The +directory list is obtained from the environment. +.SH EXPECT PROCESSING +While it is possible to use read() to read information from a process +spawned by +.B exp_spawnl +or +.BR exp_spawnv , +more convenient functions are provided. They are as +follows: +.nf + +.B int +.B exp_expectl(fd,type1,pattern1,[re1,],value1,type2,...,exp_end); +.B int fd; +.B enum exp_type type; +.B char *pattern1, *pattern2, ...; +.B regexp *re1, *re2, ...; +.B int value1, value2, ...; +.B + +.B int +.B exp_fexpectl(fp,type1,pattern1,[re1,]value1,type2,...,exp_end); +.B FILE *fp; +.B enum exp_type type; +.B char *pattern1, *pattern2, ...; +.B regexp *re1, *re2, ...; +.B int value1, value2, ...; + +.B enum exp_type { +.B exp_end, +.B exp_glob, +.B exp_exact, +.B exp_regexp, +.B exp_compiled, +.B exp_null, +.B }; + +.B struct exp_case { +.B char *pattern; +.B regexp *re; +.B enum exp_type type; +.B int value; +.B }; + +.B int +.B exp_expectv(fd,cases); +.B int fd; +.B struct exp_case *cases; + +.B int +.B exp_fexpectv(fp,cases); +.B FILE *fp; +.B struct exp_case *cases; + +.B extern int exp_timeout; +.B extern char *exp_match; +.B extern char *exp_match_end; +.B extern char *exp_buffer; +.B extern char *exp_buffer_end; +.B extern int exp_match_max; +.B extern int exp_full_buffer; +.B extern int exp_remove_nulls; +.fi + +The functions wait until the output from a process matches one of the +patterns, a specified time period has passed, or an EOF is seen. +.PP +The first argument to each function is either a file descriptor or a stream. +Successive sets of arguments describe patterns and associated integer values +to return when the pattern matches. +.PP +The type argument is one of four values. exp_end indicates that no more +patterns appear. +exp_glob indicates that the pattern is a glob-style string pattern. +exp_exact indicates that the pattern is an exact string. +exp_regexp indicates that the pattern is a regexp-style string pattern. +exp_compiled indicates that the pattern is a regexp-style string pattern, +and that its compiled form is also provided. +exp_null indicates that the pattern is a null (for debugging purposes, +a string pattern must also follow). +.PP +If the compiled form is not provided with the functions +.B exp_expectl +and +.BR exp_fexpectl , +any pattern compilation done internally is +thrown away after the function returns. The functions +.B exp_expectv +and +.B exp_fexpectv +will automatically compile patterns and will not throw them away. +Instead, they must be discarded by the user, by calling free on each +pattern. It is only necessary to discard them, the last time the +cases are used. +.PP +Regexp subpatterns matched are stored in the compiled regexp. +Assuming "re" contains a compiled regexp, the matched string can be +found in re->startp[0]. The match substrings (according to the parentheses) +in the original pattern can be found in re->startp[1], re->startp[2], and +so on, up to re->startp[9]. The corresponding strings ends are re->endp[x] +where x is that same index as for the string start. + +The type exp_null matches if a null appears in the input. The +variable exp_remove_nulls must be set to 0 to prevent nulls from +being automatically stripped. By default, exp_remove_nulls is set +to 1 and nulls are automatically stripped. + +.B exp_expectv +and +.B exp_fexpectv +are useful when the number of patterns is +not known in advance. In this case, the sets are provided in an array. +The end of the array is denoted by a struct exp_case with type exp_end. +For the rest +of this discussion, these functions will be referred to generically as +.IR expect. +.PP +If a pattern matches, then the corresponding integer value is returned. +Values need not be unique, however they should be positive to avoid +being mistaken for EXP_EOF, EXP_TIMEOUT, or EXP_FULLBUFFER. +Upon EOF or timeout, the value +.B EXP_EOF +or +.B EXP_TIMEOUT +is returned. The +default timeout period is 10 seconds but may be changed by setting the +variable +.BR exp_timeout . +A value of -1 +disables a timeout from occurring. +A value of 0 causes the expect function to return immediately (i.e., poll) +after one read(). +However it must be preceded by a function such as select, poll, or +an event manager callback to guarantee that there is data to be read. + +If the variable exp_full_buffer is 1, then EXP_FULLBUFFER is returned +if exp_buffer fills with no pattern having matched. + +When the expect function returns, +.B exp_buffer +points to the buffer +of characters that was being considered for matching. +.B exp_buffer_end +points to one past the last character in exp_buffer. +If a match occurred, +.B exp_match +points into +.B exp_buffer +where the match began. +.B exp_match_end +points to one character past where the match ended. +.PP +Each time new input arrives, it is compared to each pattern in the +order they are listed. Thus, you may test for absence of a match by +making the last pattern something guaranteed to appear, such as a +prompt. In situations where there is no prompt, you must check for +.B EXP_TIMEOUT +(just like you would if you were interacting manually). More philosophy +and strategies on specifying +.B expect +patterns can be found in the +documentation on the +.B expect +program itself. See SEE ALSO below. +.PP +Patterns are the usual C-shell-style regular expressions. For +example, the following fragment looks for a successful login, such +as from a telnet dialogue. +.nf + + switch (exp_expectl( + exp_glob,"connected",CONN, + exp_glob,"busy",BUSY, + exp_glob,"failed",ABORT, + exp_glob,"invalid password",ABORT, + exp_end)) { + case CONN: /* logged in successfully */ + break; + case BUSY: /* couldn't log in at the moment */ + break; + case EXP_TIMEOUT: + case ABORT: /* can't log in at any moment! */ + break; + default: /* problem with expect */ + } +.fi + +Asterisks (as in the +example above) are a useful shorthand for omitting line-termination +characters and other detail. +Patterns must match the entire output of the current process (since +the previous read on the descriptor or stream). +More than 2000 bytes of output can +force earlier bytes to be "forgotten". This may be changed by setting +the variable +.BR exp_match_max . +Note that excessively large values can slow down the pattern matcher. +.SH RUNNING IN THE BACKGROUND +.nf + +.B extern int exp_disconnected; +.B int exp_disconnect(); + +.fi +It is possible to move a process into the background after it has +begun running. A typical use for this is to read passwords and then +go into the background to sleep before using the passwords to do real +work. +.PP +To move a process into the background, fork, call exp_disconnect() in the +child process and exit() in the parent process. This disassociates +your process from the controlling terminal. If you wish to move a +process into the background in a different way, you must set the +variable exp_disconnected to 1. This allows processes spawned after +this point to be started correctly. +.SH MULTIPLEXING +By default, the expect functions block inside of a read on a single file +descriptor. If you want to wait on patterns from multiple file +descriptors, +use select, poll, or an event manager. +They will tell you what file descriptor is ready to read. + +When a file descriptor is ready to read, you can use the expect +functions to do one and only read by setting timeout to 0. +.SH SLAVE CONTROL + +.nf + +.B void +.B exp_slave_control(fd,enable) +.B int fd; +.B int enable; + +.fi + +Pty trapping is normally done automatically by the expect functions. +However, if you want to issue an ioctl, for example, directly on the +slave device, you should temporary disable trapping. + +Pty trapping can be controlled with exp_slave_control. The first +argument is the file descriptor corresponding to the spawned process. +The second argument is a 0 if trapping is to be disabled and 1 if it +is to be enabled. + +.SH ERRORS +All functions indicate errors by returning \-1 and setting errno. +.PP +Errors that occur after the spawn functions fork (e.g., attempting to +spawn a non-existent program) are written to the process's stderr, +and will be read by the first +.BR expect . +.SH SIGNALS +.nf +.B extern int exp_reading; +.B extern jmp_buf exp_readenv; +.fi + +.B expect +uses alarm() to timeout, thus if you generate alarms during +.BR expect , +it will timeout prematurely. +.PP +Internally, +.B expect +calls read() which can be interrupted by signals. If +you define signal handlers, you can choose to restart or abort +.BR expect 's +internal read. The variable, +.BR exp_reading , +is true if (and only if) +.BR expect 's +read has been interrupted. longjmp(exp_readenv,EXP_ABORT) will abort +the read. longjmp(exp_readenv,EXP_RESTART) will restart the read. +.SH LOGGING +.nf + +.B extern int exp_loguser; +.B extern int exp_logfile_all +.B extern FILE *exp_logfile; +.fi + +If +.B exp_loguser +is nonzero, +.B expect +sends any output from the spawned process to +stdout. Since interactive programs typically echo their input, this +usually suffices to show both sides of the conversation. If +.B exp_logfile +is also nonzero, this same output is written to the stream defined by +.BR exp_logfile . +If +.B exp_logfile_all +is non-zero, +.B exp_logfile +is written regardless of the value of +.BR exp_loguser . + +.SH DEBUGGING +While I consider the library to be easy to use, I think that the +standalone expect program is much, much, easier to use than working +with the C compiler and its usual edit, compile, debug cycle. Unlike +typical C programs, most of the debugging isn't getting the C compiler +to accept your programs - rather, it is getting the dialogue correct. +Also, translating scripts from expect to C is usually not necessary. +For example, the speed of interactive dialogues is virtually never an +issue. So please try the standalone 'expect' program first. I +suspect it is a more appropriate solution for most people than the +library. +.PP +Nonetheless, if you feel compelled to debug in C, +here are some tools to help you. +.nf + +.B extern int exp_is_debugging; +.B extern FILE *exp_debugfile; +.fi + +While expect dialogues seem very intuitive, trying to codify them in a +program can reveal many surprises in a program's interface. Therefore +a variety of debugging aids are available. They are controlled by the +above variables, all 0 by default. + +Debugging information internal to +.B expect +is sent to stderr when +.B exp_is_debugging +is non-zero. The debugging information includes +every character received, and every attempt made to match the current +input against the patterns. In addition, non-printable characters are +translated to a printable form. For example, a control-C appears as a +caret followed by a C. If +.B exp_logfile +is non-zero, this information +is also written to that stream. +.PP +If +.B exp_debugfile +is non-zero, all normal and debugging information is +written to that stream, regardless of the value of +.BR exp_is_debugging . +.SH CAVEATS +The stream versions of the +.B expect +functions are much slower than the +file descriptor versions because there is no way to portably read +an unknown number of bytes without the potential of timing out. +Thus, characters are read one at a time. You are therefore strongly +encouraged to use the file descriptor versions of +.B expect +(although, +automated versions of interactive programs don't usually demand high speed +anyway). +.PP +You can actually get the best of both worlds, writing with the usual +stream functions and reading with the file descriptor versions of +.B expect +as long as you don't attempt to intermix other stream input +functions (e.g., fgetc). +To do this, pass fileno(stream) as the file descriptor each time. +Fortunately, there is little reason to use anything but the +.B expect +functions when reading from interactive programs. +.PP +There is no matching exp_pclose to exp_popen (unlike popen and pclose). +It only takes two functions to close down a connection (fclose() followed +by waiting on the pid), but it is not uncommon to separate these two +actions by large time intervals, so the function seems of little value. +.PP +If you are running on a Cray running Unicos (all I know for sure from +experience), you must run your compiled program as root or setuid. The +problem is that the Cray only allows root processes to open ptys. +You should observe as much precautions as possible: If you don't need +permissions, setuid(0) only immediately before calling one of the spawn +functions and immediately set it back afterwards. +.PP +Normally, +.B spawn +takes little time to execute. If you notice spawn taking a +significant amount of time, it is probably encountering ptys that are +wedged. A number of tests are run on ptys to avoid entanglements with +errant processes. (These take 10 seconds per wedged pty.) Running +expect with the \-d option will show if +.B expect +is encountering many ptys in odd states. If you cannot kill +the processes to which these ptys are attached, your only recourse may +be to reboot. +.SH BUGS +The +.B exp_fexpect +functions don't work at all under HP-UX - it appears to be a bug in getc. +Follow the +advice (above) about using the +.B exp_expect +functions (which doesn't need to call getc). If you fix the problem (before +I do - please check the latest release) let me know. +.SH SEE ALSO +An alternative to this library is the +.B expect +program. +.B expect +interprets scripts written in a high-level language +which direct the dialogue. +In addition, the user can take control and interact directly when desired. +If it is not absolutely necessary to write your own C program, it is much +easier to use +.B expect +to perform the entire interaction. +It is described further in the following references: +.PP +.I +"expect: Curing Those Uncontrollable Fits of Interactivity" \fRby Don Libes, +Proceedings of the Summer 1990 USENIX Conference, +Anaheim, California, June 11-15, 1990. +.PP +.I +"Using expect to Automate System Administration Tasks" \fRby Don Libes, +Proceedings of the 1990 USENIX Large Installation Systems Administration +Conference, Colorado Springs, Colorado, October 17-19, 1990. +.PP +expect(1), alarm(3), read(2), write(2), fdopen(3), execve(2), execvp(3), +longjmp(3), pty(4). +.PP +There are several examples C programs in the test directory of +.BR expect 's +source distribution which use the expect library. +.PP +.SH AUTHOR +Don Libes, libes@nist.gov, National Institute of Standards and Technology +.SH ACKNOWLEDGEMENTS +Thanks to John Ousterhout (UCBerkeley) for supplying the pattern +matcher. +.PP +Design and implementation of the +.B expect +library was paid for by the U.S. government and is therefore in the public +domain. +However the author and NIST would like credit +if this program and documentation or portions of them are used. 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/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 DELETED exp_clib.c Index: exp_clib.c ================================================================== --- exp_clib.c +++ /dev/null @@ -1,1198 +0,0 @@ -/* exp_clib.c - top-level functions in the expect C library, libexpect.a - -Written by: Don Libes, libes@cme.nist.gov, 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. -*/ - -#include "expect_cf.h" -#include -#include -#ifdef HAVE_INTTYPES_H -# include -#endif -#include -#include - -#ifdef TIME_WITH_SYS_TIME -# include -# include -#else -# if HAVE_SYS_TIME_H -# include -# else -# include -# endif -#endif - -#ifdef CRAY -# ifndef TCSETCTTY -# if defined(HAVE_TERMIOS) -# include -# else -# include -# endif -# endif -#endif - -#ifdef HAVE_SYS_FCNTL_H -# include -#else -# include -#endif - -#ifdef HAVE_STRREDIR_H -#include -# ifdef SRIOCSREDIR -# undef TIOCCONS -# endif -#endif - -#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" -#else -#include /* for malloc */ -#endif - -#define EXP_MATCH_MAX 2000 -/* public */ -char *exp_buffer = 0; -char *exp_buffer_end = 0; -char *exp_match = 0; -char *exp_match_end = 0; -int exp_match_max = EXP_MATCH_MAX; /* bytes */ -int exp_full_buffer = FALSE; /* don't return on full buffer */ -int exp_remove_nulls = TRUE; -int exp_timeout = 10; /* seconds */ -int exp_pty_timeout = 5; /* seconds - see CRAY below */ -int exp_autoallocpty = TRUE; /* if TRUE, we do allocation */ -int exp_pty[2]; /* master is [0], slave is [1] */ -int exp_pid; -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; - -jmp_buf exp_readenv; /* for interruptable read() */ -int exp_reading = FALSE; /* whether we can longjmp or not */ - -void debuglog(); -int getptymaster(); -int getptyslave(); -int Exp_StringMatch(); - -#define sysreturn(x) return(errno = x, -1) - -void exp_init_pty(); - -/* - The following functions are linked from the Tcl library. They - don't cause anything else in the library to be dragged in, so it - shouldn't cause any problems (e.g., bloat). - - 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; - -static int fd_alloc_max = -1; /* max fd allocated */ - -/* translate fd or fp to fd */ -static struct f * -fdfp2f(fd,fp) -int fd; -FILE *fp; -{ - if (fd == -1) return(fs + fileno(fp)); - else return(fs + fd); -} - -static struct f * -fd_new(fd) -int fd; -{ - int i, low; - struct f *fp; - struct f *newfs; /* temporary, so we don't lose old fs */ - - if (fd > fd_alloc_max) { - if (!fs) { /* no fd's yet allocated */ - newfs = (struct f *)malloc(sizeof(struct f)*(fd+1)); - low = 0; - } else { /* enlarge fd table */ - newfs = (struct f *)realloc((char *)fs,sizeof(struct f)*(fd+1)); - low = fd_alloc_max+1; - } - fs = newfs; - fd_alloc_max = fd; - for (i = low; i <= fd_alloc_max; i++) { /* init new entries */ - fs[i].valid = FALSE; - } - } - - fp = fs+fd; - - if (!fp->valid) { - /* initialize */ - fp->buffer = malloc((unsigned)(bufsiz+1)); - if (!fp->buffer) return 0; - fp->msize = bufsiz; - fp->valid = TRUE; - } - fp->buffer_end = fp->buffer; - fp->match_end = fp->buffer; - return fp; - -} - -/* returns fd of master side of pty */ -int -exp_spawnv(file,argv) -char *file; -char *argv[]; /* some compiler complains about **argv? */ -{ - int cc; - 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]; - char sync_byte; -#ifdef PTYTRAP_DIES - int slave_write_ioctls = 1; - /* by default, slave will be write-ioctled this many times */ -#endif - - static int first_time = TRUE; - - if (first_time) { - first_time = FALSE; - exp_init_pty(); - exp_init_tty(); - } - - if (!file || !argv) sysreturn(EINVAL); - if (!argv[0] || strcmp(file,argv[0])) { - debuglog("expect: warning: file (%s) != argv[0] (%s)\n", - file, - argv[0]?argv[0]:""); - } - -#ifdef PTYTRAP_DIES -/* any extraneous ioctl's that occur in slave must be accounted for -when trapping, see below in child half of fork */ -#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300) - slave_write_ioctls++; -#endif -#endif /*PTYTRAP_DIES*/ - - if (exp_autoallocpty) { - if (0 > (exp_pty[0] = getptymaster())) sysreturn(ENODEV); - } - fcntl(exp_pty[0],F_SETFD,1); /* close on exec */ -#ifdef PTYTRAP_DIES - exp_slave_control(exp_pty[0],1);*/ -#endif - - if (!fd_new(exp_pty[0])) { - errno = ENOMEM; - return -1; - } - - if (-1 == (pipe(sync_fds))) { - return -1; - } - if (-1 == (pipe(sync2_fds))) { - return -1; - } - - if ((exp_pid = fork()) == -1) return(-1); - if (exp_pid) { - /* parent */ - close(sync_fds[1]); - close(sync2_fds[0]); - if (!exp_autoallocpty) close(exp_pty[1]); - -#ifdef PTYTRAP_DIES -#ifdef HAVE_PTYTRAP - if (exp_autoallocpty) { - /* 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 */ - - while (slave_write_ioctls) { - int cc; - - cc = exp_wait_for_slave_open(exp_pty[0]); -#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) { - printf("failed to trap slave pty"); - return -1; - } - } - } -#endif -#endif /*PTYTRAP_DIES*/ - - /* - * wait for slave to initialize pty before allowing - * user to send to it - */ - - 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); - } - - /* 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"); - cc = write(sync2_fds[1]," ",1); - if (cc == -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]); - - return(exp_pty[0]); - } - - /* child process - do not return from here! all errors must exit() */ - - close(sync_fds[0]); - close(sync2_fds[1]); - -#ifdef CRAY - (void) close(exp_pty[0]); -#endif - -/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */ -/* is called. setpgrp works though. */ -#if defined(POSIX) && !defined(ultrix) -#define DO_SETSID -#endif -#ifdef __convex__ -#define DO_SETSID -#endif - -#ifdef DO_SETSID - setsid(); -#else -#ifdef SYSV3 -#ifndef CRAY - 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 */ - -#ifdef TIOCNOTTY - ttyfd = open("/dev/tty", O_RDWR); - if (ttyfd >= 0) { - (void) ioctl(ttyfd, TIOCNOTTY, (char *)0); - (void) close(ttyfd); - } -#endif /* TIOCNOTTY */ - -#endif /* SYSV3 */ -#endif /* DO_SETSID */ - - /* save error fd while we're setting up new one */ - errorfd = fcntl(2,F_DUPFD,3); - /* and here is the macro to restore it */ -#define restore_error_fd {close(2);fcntl(errorfd,F_DUPFD,2);} - - if (exp_autoallocpty) { - - close(0); - 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, - 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", - exp_pty[1]); - exit(-1); - } - } else { - if (exp_pty[1] != 0) { - close(0); fcntl(exp_pty[1],F_DUPFD,0); - } - close(1); fcntl(0,F_DUPFD,1); - close(2); fcntl(0,F_DUPFD,1); - close(exp_pty[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 */ -/* is no documented define for the 720!) */ - -#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) { -#else - if (ioctl(0,TIOCSCTTY,(char *)0) < 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); - (void) close(0); - if (open("/dev/tty", O_RDWR) < 0) { - restore_error_fd - fprintf(stderr,"open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno)); - exit(-1); - } - (void) close(1); - (void) close(2); - (void) dup(0); - (void) dup(0); - setptyutmp(); /* create a utmp entry */ - - /* _CRAY2 code from Hal Peterson , Cray Research, Inc. */ -#ifdef _CRAY2 - /* - * Interpose a process between expect and the spawned child to - * keep the slave side of the pty open to allow time for expect - * to read the last output. This is a workaround for an apparent - * bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at - * least). - */ - if ((pid = fork()) == -1) { - restore_error_fd - fprintf(stderr,"second fork: %s\r\n",Tcl_ErrnoMsg(errno)); - exit(-1); - } - - if (pid) { - /* Intermediate process. */ - int status; - int timeout; - char *t; - - /* How long should we wait? */ - timeout = exp_pty_timeout; - - /* Let the spawned process run to completion. */ - while (wait(&status) < 0 && errno == EINTR) - /* empty body */; - - /* Wait for the pty to clear. */ - sleep(timeout); - - /* Duplicate the spawned process's status. */ - if (WIFSIGNALED(status)) - kill(getpid(), WTERMSIG(status)); - - /* The kill may not have worked, but this will. */ - exit(WEXITSTATUS(status)); - } -#endif /* _CRAY2 */ -#endif /* CRAY */ - - if (exp_console) { -#ifdef SRIOCSREDIR - int fd; - - if ((fd = open("/dev/console", O_RDONLY)) == -1) { - restore_error_fd - fprintf(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]); - exit(-1); - } - if (ioctl(fd, SRIOCSREDIR, 0) == -1) { - restore_error_fd - fprintf(stderr, "spawn %s: cannot redirect console, check permissions of /dev/console\n",argv[0]); - } - close(fd); -#endif - -#ifdef TIOCCONS - int on = 1; - if (ioctl(0,TIOCCONS,(char *)&on) == -1) { - restore_error_fd - fprintf(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]); - exit(-1); - } -#endif /* TIOCCONS */ - } - - /* 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");*/ - 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)); - exit(-1); - } - close(sync2_fds[0]); - - /* 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 */ - if (exp_close_in_child) (*exp_close_in_child)(); - - /* 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)); - exit(-1); - /*NOTREACHED*/ -} - -/* returns fd of master side of pty */ -/*VARARGS*/ -int -exp_spawnl TCL_VARARGS_DEF(char *,arg1) -/*exp_spawnl(va_alist)*/ -/*va_dcl*/ -{ - va_list args; /* problematic line here */ - int i; - char *arg, **argv; - - arg = TCL_VARARGS_START(char *,arg1,args); - /*va_start(args);*/ - for (i=1;;i++) { - arg = va_arg(args,char *); - if (!arg) break; - } - va_end(args); - if (i == 0) sysreturn(EINVAL); - if (!(argv = (char **)malloc((i+1)*sizeof(char *)))) sysreturn(ENOMEM); - argv[0] = TCL_VARARGS_START(char *,arg1,args); - /*va_start(args);*/ - for (i=1;;i++) { - argv[i] = va_arg(args,char *); - if (!argv[i]) break; - } - i = exp_spawnv(argv[0],argv+1); - free((char *)argv); - return(i); -} - -/* allow user-provided fd to be passed to expect funcs */ -int -exp_spawnfd(fd) -int fd; -{ - if (!fd_new(fd)) { - errno = ENOMEM; - return -1; - } - return fd; -} - -/* 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;i 0) alarm(timeout); - - /* restart read if setjmp returns 0 (first time) or 2 (EXP_RESTART). */ - /* abort if setjmp returns 1 (EXP_ABORT). */ - if (EXP_ABORT != setjmp(exp_readenv)) { - exp_reading = TRUE; - if (fd == -1) { - int c; - c = getc(fp); - if (c == EOF) { -/*fprintf(stderr,"<>",c);fflush(stderr);*/ - if (feof(fp)) cc = 0; - else cc = -1; - } else { -/*fprintf(stderr,"<<%c>>",c);fflush(stderr);*/ - buffer[0] = c; - cc = 1; - } - } else { -#ifndef HAVE_PTYTRAP - cc = read(fd,buffer,length); -#else -# include - - fd_set rdrs; - fd_set excep; - - restart: - FD_ZERO(&rdrs); - FD_ZERO(&excep); - FD_SET(fd,&rdrs); - FD_SET(fd,&excep); - if (-1 == (cc = select(fd+1, - (SELECT_MASK_TYPE *)&rdrs, - (SELECT_MASK_TYPE *)0, - (SELECT_MASK_TYPE *)&excep, - (struct timeval *)0))) { - /* window refreshes trigger EINTR, ignore */ - if (errno == EINTR) goto restart; - } - if (FD_ISSET(fd,&rdrs)) { - cc = read(fd,buffer,length); - } else if (FD_ISSET(fd,&excep)) { - struct request_info ioctl_info; - ioctl(fd,TIOCREQCHECK,&ioctl_info); - if (ioctl_info.request == TIOCCLOSE) { - cc = 0; /* indicate eof */ - } else { - ioctl(fd, TIOCREQSET, &ioctl_info); - /* presumably, we trapped an open here */ - goto restart; - } - } -#endif /* HAVE_PTYTRAP */ - } -#if 0 - /* can't get fread to return early! */ - else { - if (!(cc = fread(buffer,1,length,fp))) { - if (ferror(fp)) cc = -1; - } - } -#endif - i_read_errno = errno; /* errno can be overwritten by the */ - /* time we return */ - } - exp_reading = FALSE; - - if (timeout > 0) alarm(0); - return(cc); -} - -/* I tried really hard to make the following two functions share the code */ -/* that makes the ecase array, but I kept running into a brick wall when */ -/* passing var args into the funcs and then again into a make_cases func */ -/* I would very much appreciate it if someone showed me how to do it right */ - -/* takes triplets of args, with a final "exp_last" arg */ -/* triplets are type, pattern, and then int to return */ -/* returns negative value if error (or EOF/timeout) occurs */ -/* some negative values can also have an associated errno */ - -/* the key internal variables that this function depends on are: - exp_buffer - exp_buffer_end - exp_match_end -*/ -static int -expectv(fd,fp,ecases) -int fd; -FILE *fp; -struct exp_case *ecases; -{ - int cc = 0; /* number of chars returned in a single read */ - int buf_length; /* numbers of chars in exp_buffer */ - int old_length; /* old buf_length */ - int first_time = TRUE; /* force old buffer to be tested before */ - /* additional reads */ - int polled = 0; /* true if poll has caused read() to occur */ - - struct exp_case *ec; /* points to current ecase */ - - time_t current_time; /* current time (when we last looked)*/ - time_t end_time; /* future time at which to give up */ - int remtime; /* remaining time in timeout */ - - struct f *f; - int return_val; - int sys_error = 0; -#define return_normally(x) {return_val = x; goto cleanup;} -#define return_errno(x) {sys_error = x; goto cleanup;} - - f = fdfp2f(fd,fp); - if (!f) return_errno(ENOMEM); - - exp_buffer = f->buffer; - exp_buffer_end = f->buffer_end; - exp_match_end = f->match_end; - - buf_length = exp_buffer_end - exp_match_end; - if (buf_length) { - /* - * take end of previous match to end of buffer - * and copy to beginning of buffer - */ - memmove(exp_buffer,exp_match_end,buf_length); - } - exp_buffer_end = exp_buffer + buf_length; - *exp_buffer_end = '\0'; - - if (!ecases) return_errno(EINVAL); - - /* compile if necessary */ - for (ec=ecases;ec->type != exp_end;ec++) { - if ((ec->type == exp_regexp) && !ec->re) { - TclRegError((char *)0); - if (!(ec->re = TclRegComp(ec->pattern))) { - fprintf(stderr,"regular expression %s is bad: %s",ec->pattern,TclGetRegError()); - return_errno(EINVAL); - } - } - } - - /* 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 */ - - bufsiz = 2*exp_match_max; - if (f->msize != bufsiz) { - /* if truncated, forget about some data */ - if (buf_length > bufsiz) { - /* copy end of buffer down */ - - /* copy one less than what buffer can hold to avoid */ - /* triggering buffer-full handling code below */ - /* which will immediately dump the first half */ - /* of the buffer */ - memmove(exp_buffer,exp_buffer+(buf_length - bufsiz)+1, - bufsiz-1); - buf_length = bufsiz-1; - } - exp_buffer = realloc(exp_buffer,bufsiz+1); - if (!exp_buffer) return_errno(ENOMEM); - exp_buffer[buf_length] = '\0'; - exp_buffer_end = exp_buffer + buf_length; - f->msize = bufsiz; - } - - /* some systems (i.e., Solaris) require fp be flushed when switching */ - /* directions - do this again afterwards */ - if (fd == -1) fflush(fp); - - if (exp_timeout != -1) signal(SIGALRM,sigalarm_handler); - - /* remtime and current_time updated at bottom of loop */ - remtime = exp_timeout; - - time(¤t_time); - end_time = current_time + remtime; - - for (;;) { - /* when buffer fills, copy second half over first and */ - /* 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_match = exp_buffer; - exp_match_end = exp_buffer + buf_length; - exp_buffer_end = exp_match_end; - return_normally(EXP_FULLBUFFER); - } - first_half = bufsiz/2; - second_half = bufsiz - first_half; - - memcpy(exp_buffer,exp_buffer+first_half,second_half); - buf_length = second_half; - exp_buffer_end = exp_buffer + second_half; - } - - /* - * always check first if pattern is already in buffer - */ - if (first_time) { - first_time = FALSE; - goto after_read; - } - - /* - * check for timeout - */ - if ((exp_timeout >= 0) && ((remtime < 0) || polled)) { - debuglog("expect: timeout\r\n"); - exp_match_end = exp_buffer; - return_normally(EXP_TIMEOUT); - } - - /* - * if timeout == 0, indicate a poll has - * occurred so that next time through loop causes timeout - */ - if (exp_timeout == 0) { - polled = 1; - } - - cc = i_read(fd,fp, - exp_buffer_end, - bufsiz - buf_length, - remtime); - - if (cc == 0) { - 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"); - return_normally(EXP_EOF); - } - 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_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 (loguser) fwrite(exp_buffer + old_length,1,cc,stdout); - if (debugfile) fwrite(exp_buffer + old_length,1,cc,debugfile); - - /* if we wrote to any logs, flush them */ - if (debugfile) fflush(debugfile); - if (loguser) { - fflush(stdout); - if (logfile) fflush(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 */ - if (exp_remove_nulls) { - buf_length -= rm_nulls(exp_buffer + old_length, cc); - } - /* cc should be decremented as well, but since it will not */ - /* be used before being set again, there is no need */ - 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)); - /* pattern supplied */ - for (ec=ecases;ec->type != exp_end;ec++) { - int matched = -1; - - 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; - exp_match_end = exp_match + matched; - } - } else if (ec->type == exp_exact) { - char *p = strstr(exp_buffer,ec->pattern); - if (p) { - matched = 1; - exp_match = p; - exp_match_end = p + strlen(ec->pattern); - } - } else if (ec->type == exp_null) { - char *p; - - for (p=exp_buffer;pre,exp_buffer,exp_buffer)) { - matched = 1; - exp_match = ec->re->startp[0]; - exp_match_end = ec->re->endp[0]; - } else if (TclGetRegError()) { - fprintf(stderr,"r.e. match (pattern %s) failed: %s",ec->pattern,TclGetRegError()); - } - } - - if (matched != -1) { - debuglog("yes\nexp_buffer is {%s}\n", - exp_printify(exp_buffer)); - return_normally(ec->value); - } else debuglog("no\n"); - } - - /* - * Update current time and remaining time. - * Don't bother if we are waiting forever or polling. - */ - if (exp_timeout > 0) { - time(¤t_time); - remtime = end_time - current_time; - } - } - cleanup: - f->buffer = exp_buffer; - f->buffer_end = exp_buffer_end; - f->match_end = exp_match_end; - - /* some systems (i.e., Solaris) require fp be flushed when switching */ - /* directions - do this before as well */ - if (fd == -1) fflush(fp); - - if (sys_error) { - errno = sys_error; - return -1; - } - return return_val; -} - -int -exp_fexpectv(fp,ecases) -FILE *fp; -struct exp_case *ecases; -{ - return(expectv(-1,fp,ecases)); -} - -int -exp_expectv(fd,ecases) -int fd; -struct exp_case *ecases; -{ - return(expectv(fd,(FILE *)0,ecases)); -} - -/*VARARGS*/ -int -exp_expectl TCL_VARARGS_DEF(int,arg1) -/*exp_expectl(va_alist)*/ -/*va_dcl*/ -{ - va_list args; - int fd; - struct exp_case *ec, *ecases; - int i; - enum exp_type type; - - fd = TCL_VARARGS_START(int,arg1,args); - /* va_start(args);*/ - /* fd = va_arg(args,int);*/ - /* first just count the arg sets */ - for (i=0;;i++) { - type = va_arg(args,enum exp_type); - if (type == exp_end) break; - - /* Ultrix 4.2 compiler refuses enumerations comparison!? */ - if ((int)type < 0 || (int)type >= (int)exp_bogus) { - fprintf(stderr,"bad type (set %d) in exp_expectl\n",i); - sysreturn(EINVAL); - } - - va_arg(args,char *); /* COMPUTED BUT NOT USED */ - if (type == exp_compiled) { - va_arg(args,regexp *); /* COMPUTED BUT NOT USED */ - } - va_arg(args,int); /* COMPUTED BUT NOT USED*/ - } - va_end(args); - - if (!(ecases = (struct exp_case *) - malloc((1+i)*sizeof(struct exp_case)))) - sysreturn(ENOMEM); - - /* now set up the actual cases */ - fd = TCL_VARARGS_START(int,arg1,args); - /*va_start(args);*/ - /*va_arg(args,int);*/ /*COMPUTED BUT NOT USED*/ - for (ec=ecases;;ec++) { - ec->type = va_arg(args,enum exp_type); - if (ec->type == exp_end) break; - ec->pattern = va_arg(args,char *); - if (ec->type == exp_compiled) { - ec->re = va_arg(args,regexp *); - } else { - ec->re = 0; - } - ec->value = va_arg(args,int); - } - va_end(args); - i = expectv(fd,(FILE *)0,ecases); - - for (ec=ecases;ec->type != exp_end;ec++) { - /* free only if regexp and we compiled it for user */ - if (ec->type == exp_regexp) { - free((char *)ec->re); - } - } - free((char *)ecases); - return(i); -} - -int -exp_fexpectl TCL_VARARGS_DEF(FILE *,arg1) -/*exp_fexpectl(va_alist)*/ -/*va_dcl*/ -{ - va_list args; - FILE *fp; - struct exp_case *ec, *ecases; - int i; - enum exp_type type; - - fp = TCL_VARARGS_START(FILE *,arg1,args); - /*va_start(args);*/ - /*fp = va_arg(args,FILE *);*/ - /* first just count the arg-pairs */ - for (i=0;;i++) { - type = va_arg(args,enum exp_type); - if (type == exp_end) break; - - /* Ultrix 4.2 compiler refuses enumerations comparison!? */ - if ((int)type < 0 || (int)type >= (int)exp_bogus) { - fprintf(stderr,"bad type (set %d) in exp_expectl\n",i); - sysreturn(EINVAL); - } - - va_arg(args,char *); /* COMPUTED BUT NOT USED */ - if (type == exp_compiled) { - va_arg(args,regexp *); /* COMPUTED BUT NOT USED */ - } - va_arg(args,int); /* COMPUTED BUT NOT USED*/ - } - va_end(args); - - if (!(ecases = (struct exp_case *) - malloc((1+i)*sizeof(struct exp_case)))) - sysreturn(ENOMEM); - -#if 0 - va_start(args); - va_arg(args,FILE *); /*COMPUTED, BUT NOT USED*/ -#endif - (void) TCL_VARARGS_START(FILE *,arg1,args); - - for (ec=ecases;;ec++) { - ec->type = va_arg(args,enum exp_type); - if (ec->type == exp_end) break; - ec->pattern = va_arg(args,char *); - if (ec->type == exp_compiled) { - ec->re = va_arg(args,regexp *); - } else { - ec->re = 0; - } - ec->value = va_arg(args,int); - } - va_end(args); - i = expectv(-1,fp,ecases); - - for (ec=ecases;ec->type != exp_end;ec++) { - /* free only if regexp and we compiled it for user */ - if (ec->type == exp_regexp) { - free((char *)ec->re); - } - } - free((char *)ecases); - return(i); -} - -/* like popen(3) but works in both directions */ -FILE * -exp_popen(program) -char *program; -{ - FILE *fp; - int ec; - - if (0 > (ec = exp_spawnl("sh","sh","-c",program,(char *)0))) return(0); - if (!(fp = fdopen(ec,"r+"))) return(0); - setbuf(fp,(char *)0); - return(fp); -} - -int -exp_disconnect() -{ - int ttyfd; - -#ifndef EALREADY -#define EALREADY 37 -#endif - - /* presumably, no stderr, so don't bother with error message */ - if (exp_disconnected) sysreturn(EALREADY); - exp_disconnected = TRUE; - - freopen("/dev/null","r",stdin); - freopen("/dev/null","w",stdout); - freopen("/dev/null","w",stderr); - -#ifdef POSIX - setsid(); -#else -#ifdef SYSV3 - /* put process in our own pgrp, and lose controlling terminal */ - 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 */ -/* 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); - } -#endif /* TIOCNOTTY */ -#endif /* SYSV3 */ -#endif /* POSIX */ - return(0); -} DELETED exp_closetcl.c Index: exp_closetcl.c ================================================================== --- exp_closetcl.c +++ /dev/null @@ -1,22 +0,0 @@ -/* 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 -#include -/*#include seems to not be present on SVR3 systems */ -/* and it's not used anyway as far as I can tell */ - -/* AIX insists that stropts.h be included before ioctl.h, because both */ -/* define _IO but only ioctl.h checks first. Oddly, they seem to be */ -/* defined differently! */ -#ifdef HAVE_STROPTS_H -# include -#endif -#include - -#ifdef HAVE_SYS_FCNTL_H -# include -#else -# include -#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 -#endif - -#ifdef HAVE_PTYTRAP -#include -#endif - -#ifdef CRAY -# ifndef TCSETCTTY -# if defined(HAVE_TERMIOS) -# include -# else -# include -# endif -# endif -#endif - -#ifdef HAVE_UNISTD_H -# include -#endif - -#include /* for log/pow computation in send -h */ -#include /* all this for ispunct! */ - -#include "tclInt.h" /* need OpenFile */ -/*#include tclInt.h drags in varargs.h. Since Pyramid */ -/* objects to including varargs.h twice, just */ -/* omit this one. */ - -#include "tcl.h" -#include "string.h" -#include "expect_tcl.h" -#include "exp_rename.h" -#include "exp_prog.h" -#include "exp_command.h" -#include "exp_log.h" -#include "exp_event.h" -#include "exp_pty.h" -#ifdef TCL_DEBUGGER -#include "tcldbg.h" -#endif - -#define SPAWN_ID_VARNAME "spawn_id" - -int getptymaster(); -int getptyslave(); - -int exp_forked = FALSE; /* whether we are child process */ - -/* the following are just 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 - * reexamine the state of the spawned process. - */ -int expect_key = 0; - -/* - * exp_configure_count is incremented whenever a spawned process is closed - * or an indirect list is modified. This forces any (stack of) expect or - * 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 */ - -#ifdef FULLTRAPS -static void -init_traps(traps) -RETSIGTYPE (*traps[])(); -{ - int i; - - for (i=1;iresult,fmt,args); - va_end(args); -} - -/* returns handle if fd is usable, 0 if not */ -struct exp_f * -exp_fd2f(interp,fd,opened,adjust,msg) -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); - 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"; - -/* zero out the wait status field */ -static void -exp_wait_zero(status) -WAIT_STATUS_TYPE *status; -{ - int i; - - 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; -} - -/*ARGSUSED*/ -void -exp_trap_on(master) -int master; -{ -#ifdef HAVE_PTYTRAP - if (master == -1) return; - exp_slave_control(master,1); -#endif /* HAVE_PTYTRAP */ -} - -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 - -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) -int fd; -{ - (void) fcntl(fd,F_SETFD,1); -} - -#define STTY_INIT "stty_init" - -#if 0 -static void -show_pgrp(fd,string) -int fd; -char *string; -{ - int pgrp; - - fprintf(stderr,"getting pgrp for %s\n",string); - if (-1 == ioctl(fd,TIOCGETPGRP,&pgrp)) perror("TIOCGETPGRP"); - else fprintf(stderr,"%s pgrp = %d\n",string,pgrp); - if (-1 == ioctl(fd,TIOCGPGRP,&pgrp)) perror("TIOCGPGRP"); - else fprintf(stderr,"%s pgrp = %d\n",string,pgrp); - if (-1 == tcgetpgrp(fd,pgrp)) perror("tcgetpgrp"); - else fprintf(stderr,"%s pgrp = %d\n",string,pgrp); -} - -static void -set_pgrp(fd) -int fd; -{ - int pgrp = getpgrp(0); - if (-1 == ioctl(fd,TIOCSETPGRP,&pgrp)) perror("TIOCSETPGRP"); - if (-1 == ioctl(fd,TIOCSPGRP,&pgrp)) perror("TIOCSPGRP"); - if (-1 == tcsetpgrp(fd,pgrp)) perror("tcsetpgrp"); -} -#endif - -/*ARGSUSED*/ -static void -set_slave_name(f,name) -struct exp_f *f; -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); - - entry = Tcl_CreateHashEntry(&slaveNames,exp_pty_slave_name,&newptr); - Tcl_SetHashValue(entry,(ClientData)f); -#endif /* HAVE_PTYTRAP */ -} - -/* arguments are passed verbatim to execvp() */ -/*ARGSUSED*/ -static int -Exp_SpawnCmd(clientData,interp,argc,argv) -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 */ - /* 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; - -#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])(); -#endif - 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; - /* by default, slave will be write-ioctled this many times */ - 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;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 */ - -#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); - -#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 */ - 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(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 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]); - - if (exp_dev_tty != -1) { - close(exp_dev_tty); - exp_dev_tty = -1; - } - -#ifdef CRAY - (void) close(master); -#endif - -/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */ -/* is called. setpgrp works though. */ -#if defined(POSIX) && !defined(ultrix) -#define DO_SETSID -#endif -#ifdef __convex__ -#define DO_SETSID -#endif - -#ifdef DO_SETSID - setsid(); -#else -#ifdef SYSV3 -#ifndef CRAY - 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 */ - -/* Pyramid lacks this defn */ -#ifdef TIOCNOTTY - ttyfd = open("/dev/tty", O_RDWR); - if (ttyfd >= 0) { - (void) ioctl(ttyfd, TIOCNOTTY, (char *)0); - (void) close(ttyfd); - } -#endif /* TIOCNOTTY */ - -#endif /* SYSV3 */ -#endif /* DO_SETSID */ - - /* save stderr elsewhere to avoid BSD4.4 bogosity that warns */ - /* if stty finds dev(stderr) != dev(stdout) */ - - /* save error fd while we're setting up new one */ - errorfd = fcntl(2,F_DUPFD,3); - /* and here is the macro to restore it */ -#define restore_error_fd {close(2);fcntl(errorfd,F_DUPFD,2);} - - close(0); - 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. */ - - if (0 > (slave = getptyslave(ttycopy,ttyinit,stty_init))) { - restore_error_fd - errorlog("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); - 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 */ -/* is no documented define for the 720!) */ - -/*#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hpux)*/ -#if defined(TIOCSCTTY) && !defined(sun) && !defined(hpux) - /* 4.3+BSD way to acquire controlling terminal */ - /* 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) { -#else - if (ioctl(0,TIOCSCTTY,(char *)0) < 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)); - exit(-1); - } - (void) close(1); - (void) close(2); - (void) dup(0); - (void) dup(0); - setptyutmp(); /* create a utmp entry */ - - /* _CRAY2 code from Hal Peterson , Cray Research, Inc. */ -#ifdef _CRAY2 - /* - * Interpose a process between expect and the spawned child to - * keep the slave side of the pty open to allow time for expect - * to read the last output. This is a workaround for an apparent - * 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)); - exit(-1); - } - - if (pid) { - /* Intermediate process. */ - int status; - int timeout; - char *t; - - /* How long should we wait? */ - if (t = exp_get_var(interp,"pty_timeout")) - timeout = atoi(t); - else if (t = exp_get_var(interp,"timeout")) - timeout = atoi(t)/2; - else - timeout = 5; - - /* Let the spawned process run to completion. */ - while (wait(&status) < 0 && errno == EINTR) - /* empty body */; - - /* Wait for the pty to clear. */ - sleep(timeout); - - /* Duplicate the spawned process's status. */ - if (WIFSIGNALED(status)) - kill(getpid(), WTERMSIG(status)); - - /* The kill may not have worked, but this will. */ - exit(WEXITSTATUS(status)); - } -#endif /* _CRAY2 */ -#endif /* CRAY */ - - if (console) exp_console_set(); - -#ifdef FULLTRAPS - for (i=1;i0;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; -} - -/*ARGSUSED*/ -static int -Exp_GetpidDeprecatedCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - debuglog("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; -int argc; -char **argv; -{ - argc--; argv++; - - if (argc != 1) { - exp_error(interp,"must have one arg: seconds"); - return TCL_ERROR; - } - - return(exp_dsleep(interp,(double)atof(*argv))); -} - -/* write exactly this many bytes, i.e. retry partial writes */ -/* returns 0 for success, -1 for failure */ -static int -exact_write(fd,buffer,rembytes) -int fd; -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); -} - -struct slow_arg { - int size; - double time; -}; - -/* returns 0 for success, -1 for failure */ -static int -get_slow_args(interp,x) -Tcl_Interp *interp; -struct slow_arg *x; -{ - int sc; /* return from scanf */ - char *s = exp_get_var(interp,"send_slow"); - if (!s) { - exp_error(interp,"send -s: send_slow has no value"); - return(-1); - } - if (2 != (sc = sscanf(s,"%d %lf",&x->size,&x->time))) { - exp_error(interp,"send -s: found %d value(s) in send_slow but need 2",sc); - return(-1); - } - if (x->size <= 0) { - exp_error(interp,"send -s: size (%d) in send_slow must be positive", x->size); - return(-1); - } - if (x->time <= 0) { - exp_error(interp,"send -s: time (%f) in send_slow must be larger",x->time); - return(-1); - } - return(0); -} - -/* returns 0 for success, -1 for failure, pos. for Tcl return value */ -static int -slow_write(interp,fd,buffer,rembytes,arg) -Tcl_Interp *interp; -int fd; -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); - rembytes -= arg->size; - buffer += arg->size; - - /* skip sleep after last write */ - if (rembytes > 0) { - rc = exp_dsleep(interp,arg->time); - if (rc>0) return rc; - } - } - return(0); -} - -struct human_arg { - float alpha; /* average interarrival time in seconds */ - float alpha_eow; /* as above but for eow transitions */ - float c; /* shape */ - float min, max; -}; - -/* returns -1 if error, 0 if success */ -static int -get_human_args(interp,x) -Tcl_Interp *interp; -struct human_arg *x; -{ - int sc; /* return from scanf */ - char *s = exp_get_var(interp,"send_human"); - - if (!s) { - exp_error(interp,"send -h: send_human has no value"); - return(-1); - } - if (5 != (sc = sscanf(s,"%f %f %f %f %f", - &x->alpha,&x->alpha_eow,&x->c,&x->min,&x->max))) { - if (sc == EOF) sc = 0; /* make up for overloaded return */ - exp_error(interp,"send -h: found %d value(s) in send_human but need 5",sc); - return(-1); - } - if (x->alpha < 0 || x->alpha_eow < 0) { - exp_error(interp,"send -h: average interarrival times (%f %f) must be non-negative in send_human", x->alpha,x->alpha_eow); - return(-1); - } - if (x->c <= 0) { - exp_error(interp,"send -h: variability (%f) in send_human must be positive",x->c); - return(-1); - } - x->c = 1/x->c; - - if (x->min < 0) { - exp_error(interp,"send -h: minimum (%f) in send_human must be non-negative",x->min); - return(-1); - } - if (x->max < 0) { - exp_error(interp,"send -h: maximum (%f) in send_human must be non-negative",x->max); - return(-1); - } - if (x->max < x->min) { - exp_error(interp,"send -h: maximum (%f) must be >= minimum (%f) in send_human",x->max,x->min); - return(-1); - } - return(0); -} - -/* Compute random numbers from 0 to 1, for expect's send -h */ -/* This implementation sacrifices beauty for portability */ -static float -unit_random() -{ - /* current implementation is pathetic but works */ - /* 99991 is largest prime in my CRC - can't hurt, eh? */ - return((float)(1+(rand()%99991))/99991.0); -} - -void -exp_init_unit_random() -{ - srand(getpid()); -} - -/* This function is my implementation of the Weibull distribution. */ -/* 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) -Tcl_Interp *interp; -int fd; -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);*/ - /* 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); -} - -struct exp_i *exp_i_pool = 0; -struct exp_fd_list *exp_fd_list_pool = 0; - -#define EXP_I_INIT_COUNT 10 -#define EXP_FD_INIT_COUNT 10 - -struct exp_i * -exp_new_i() -{ - int n; - struct exp_i *i; - - if (!exp_i_pool) { - /* none avail, generate some new ones */ - exp_i_pool = i = (struct exp_i *)ckalloc( - EXP_I_INIT_COUNT * sizeof(struct exp_i)); - for (n=0;nnext = i+1; - } - i->next = 0; - } - - /* now that we've made some, unlink one and give to user */ - - i = exp_i_pool; - exp_i_pool = exp_i_pool->next; - i->value = 0; - i->variable = 0; - i->fd_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; -} - -void -exp_free_fd(fd_first) -struct exp_fd_list *fd_first; -{ - struct exp_fd_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 */ - - /* 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; -} - -/* free a single fd */ -void -exp_free_fd_single(fd) -struct exp_fd_list *fd; -{ - fd->next = exp_fd_list_pool; - exp_fd_list_pool = fd; -} - -void -exp_free_i(interp,i,updateproc) -Tcl_Interp *interp; -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); - - if (i->direct == EXP_INDIRECT) { - Tcl_UntraceVar(interp,i->variable, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES, - updateproc,(ClientData)i); - } - - /* here's the long form - if duration & direct free(var) free(val) - PERM DIR 1 - PERM INDIR 1 1 - TMP DIR - TMP INDIR 1 - Also if i->variable was a bogus variable name, i->value might not be - set, so test i->value to protect this - TMP in this case does NOT mean from the "expect" command. Rather - it means "an implicit spawn id from any expect or expect_XXX - command". In other words, there was no variable name provided. - */ - if (i->value - && (((i->direct == EXP_DIRECT) && (i->duration == EXP_PERMANENT)) - || ((i->direct == EXP_INDIRECT) && (i->duration == EXP_TEMPORARY)))) { - ckfree(i->value); - } else if (i->duration == EXP_PERMANENT) { - if (i->value) ckfree(i->value); - if (i->variable) ckfree(i->variable); - } - - i->next = exp_i_pool; - exp_i_pool = i; -} - -/* generate a descriptor for a "-i" flag */ -/* cannot fail */ -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 */ - /* should only need do this in expect_before/after */ -Tcl_VarTraceProc *updateproc; /* proc to invoke if indirect is written */ -{ - struct exp_i *i; - char **stringp; - - i = exp_new_i(); - - i->direct = (isdigit(arg[0]) || (arg[0] == '-'))?EXP_DIRECT:EXP_INDIRECT; - if (i->direct == EXP_DIRECT) { - stringp = &i->value; - } else { - stringp = &i->variable; - } - - i->duration = duration; - if (duration == EXP_PERMANENT) { - *stringp = ckalloc(strlen(arg)+1); - strcpy(*stringp,arg); - } else { - *stringp = arg; - } - - i->fd_list = 0; - exp_i_update(interp,i); - - /* if indirect, ask Tcl to tell us when variable is modified */ - - if (i->direct == EXP_INDIRECT) { - Tcl_TraceVar(interp, i->variable, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES, - updateproc, (ClientData) i); - } - - 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); - } -} - -/* updates a single exp_i struct */ -void -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); -} - -struct exp_i * -exp_new_i_simple(fd,duration) -int fd; -int duration; /* if we have to copy the args */ - /* should only need do this in expect_before/after */ -{ - struct exp_i *i; - - i = exp_new_i(); - - i->direct = EXP_DIRECT; - i->duration = duration; - - exp_i_add_fd(i,fd); - - return i; -} - -/*ARGSUSED*/ -static int -Exp_SendLogCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - char *string; - int len; - - argv++; - argc--; - - if (argc) { - if (streq(*argv,"--")) { - argc--; argv++; - } - } - - 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); - - 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) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int m = -1; /* spawn id (master) */ - 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; - } - 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); - } - -#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; - finish: - 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; -} - -/*ARGSUSED*/ -static int -Exp_LogUserCmd(clientData, interp, argc, argv) -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); -} - -#ifdef TCL_DEBUGGER -/*ARGSUSED*/ -static int -Exp_DebugCmd(clientData, interp, argc, argv) -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 - -/*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); - usage: - exp_error(interp,"usage: [-f file] expr"); - error: - Tcl_DStringFree(&dstring); - return TCL_ERROR; -} - -char *exp_onexit_action = 0; - -/*ARGSUSED*/ -static int -Exp_ExitCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int value = 0; - - argv++; - - if (*argv) { - if (exp_flageq(*argv,"-onexit",3)) { - argv++; - if (*argv) { - int len = strlen(*argv); - if (exp_onexit_action) - ckfree(exp_onexit_action); - exp_onexit_action = ckalloc(len + 1); - strcpy(exp_onexit_action,*argv); - } else if (exp_onexit_action) { - Tcl_AppendResult(interp,exp_onexit_action,(char *)0); - } - return TCL_OK; - } else if (exp_flageq(*argv,"-noexit",3)) { - argv++; - exp_exit_handlers((ClientData)interp); - return TCL_OK; - } - } - - if (*argv) { - if (Tcl_GetInt(interp, *argv, &value) != TCL_OK) { - return TCL_ERROR; - } - } - - exp_exit(interp,value); - /*NOTREACHED*/ -} - -/* so cmd table later is more intuitive */ -#define Exp_CloseObjCmd Exp_CloseCmd - -/*ARGSUSED*/ -static int -Exp_CloseCmd(clientData, interp, argc, argv) -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)); -} - -/*ARGSUSED*/ -static void -tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv) -ClientData clientData; -Tcl_Interp *interp; -int level; -char *command; -int (*cmdProc)(); -ClientData cmdClientData; -int argc; -char *argv[]; -{ - int i; - - /* come out on stderr, by using errorlog */ - errorlog("%2d",level); - for (i = 0;i 1 && streq(argv[1],"-info")) { - sprintf(interp->result,"%d",trace_level); - return TCL_OK; - } - - if (argc != 2) { - exp_error(interp,"usage: trace level"); - return(TCL_ERROR); - } - /* tracing already in effect, undo it */ - if (trace_level > 0) Tcl_DeleteTrace(interp,trace_handle); - - /* get and save new trace level */ - trace_level = atoi(argv[1]); - if (trace_level > 0) - trace_handle = Tcl_CreateTrace(interp, - trace_level,tcl_tracer,(ClientData)0); - return(TCL_OK); -} - -/* following defn's are stolen from tclUnix.h */ - -/* - * The type of the status returned by wait varies from UNIX system - * to UNIX system. The macro below defines it: - */ - -#if 0 -#ifndef NO_UNION_WAIT -# define WAIT_STATUS_TYPE union wait -#else -# define WAIT_STATUS_TYPE int -#endif -#endif /* 0 */ - -/* - * following definitions stolen from tclUnix.h - * (should have been made public!) - - * Supply definitions for macros to query wait status, if not already - * defined in header files above. - */ - -#if 0 -#ifndef WIFEXITED -# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0) -#endif - -#ifndef WEXITSTATUS -# define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) -#endif - -#ifndef WIFSIGNALED -# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff))) -#endif - -#ifndef WTERMSIG -# define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) -#endif - -#ifndef WIFSTOPPED -# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177) -#endif - -#ifndef WSTOPSIG -# define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) -#endif -#endif /* 0 */ - -/* end of stolen definitions */ - -/* Describe the processes created with Expect's fork. -This allows us to wait on them later. - -This is maintained as a linked list. As additional procs are forked, -new links are added. As procs disappear, links are marked so that we -can reuse them later. -*/ - -struct forked_proc { - int pid; - WAIT_STATUS_TYPE wait_status; - enum {not_in_use, wait_done, wait_not_done} link_status; - struct forked_proc *next; -} *forked_proc_base = 0; - -void -fork_clear_all() -{ - struct forked_proc *f; - - for (f=forked_proc_base;f;f=f->next) { - f->link_status = not_in_use; - } -} - -void -fork_init(f,pid) -struct forked_proc *f; -int pid; -{ - f->pid = pid; - f->link_status = wait_not_done; -} - -/* make an entry for a new proc */ -void -fork_add(pid) -int pid; -{ - struct forked_proc *f; - - for (f=forked_proc_base;f;f=f->next) { - if (f->link_status == not_in_use) break; - } - - /* add new entry to the front of the list */ - if (!f) { - f = (struct forked_proc *)ckalloc(sizeof(struct forked_proc)); - f->next = forked_proc_base; - forked_proc_base = f; - } - fork_init(f,pid); -} - -/* Provide a last-chance guess for this if not defined already */ -#ifndef WNOHANG -#define WNOHANG WNOHANG_BACKUP_VALUE -#endif - -/* wait returns are a hodgepodge of things - If wait fails, something seriously has gone wrong, for example: - bogus arguments (i.e., incorrect, bogus spawn id) - no children to wait on - async event failed - If wait succeeeds, something happened on a particular pid - 3rd arg is 0 if successfully reaped (if signal, additional fields supplied) - 3rd arg is -1 if unsuccessfully reaped (additional fields supplied) -*/ -/*ARGSUSED*/ -static int -Exp_WaitCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int master_supplied = FALSE; - int m; /* master waited for */ - struct exp_f *f; /* ditto */ - struct forked_proc *fp = 0; /* handle to a pure forked proc */ - - struct exp_f ftmp; /* temporary memory for either f or fp */ - - int nowait = FALSE; - int result = 0; /* 0 means child was successfully waited on */ - /* -1 means an error occurred */ - /* -2 means no eligible children to wait on */ -#define NO_CHILD -2 - - 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); - } - 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); -} - -/*ARGSUSED*/ -static int -Exp_ForkCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int rc; - if (argc > 1) { - exp_error(interp,"usage: fork"); - return(TCL_ERROR); - } - - rc = fork(); - if (rc == -1) { - exp_error(interp,"fork: %s",Tcl_PosixError(interp)); - return TCL_ERROR; - } else if (rc == 0) { - /* child */ - exp_forked = TRUE; - exp_getpid = getpid(); - fork_clear_all(); - } else { - /* parent */ - fork_add(rc); - } - - /* both child and parent follow remainder of code */ - sprintf(interp->result,"%d",rc); - debuglog("fork: returns {%s}\r\n",interp->result); - return(TCL_OK); -} - -/*ARGSUSED*/ -static int -Exp_DisconnectCmd(clientData, interp, argc, argv) -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); - -#ifdef DO_SETSID - setsid(); -#else -#ifdef SYSV3 - /* 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(); -#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 */ -#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 */ - -/* 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); - } -#endif /* TIOCNOTTY */ - -#endif /* SYSV3 */ -#endif /* DO_SETSID */ - return(TCL_OK); -} - -/*ARGSUSED*/ -static int -Exp_OverlayCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int newfd, oldfd; - int dash_name = 0; - char *command; - - argc--; argv++; - while (argc) { - if (*argv[0] != '-') break; /* not a flag */ - if (streq(*argv,"-")) { /* - by itself */ - argc--; argv++; - dash_name = 1; - continue; - } - newfd = atoi(argv[0]+1); - argc--; argv++; - if (argc == 0) { - 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); - if (oldfd != newfd) (void) dup2(oldfd,newfd); - else debuglog("warning: overlay: old fd == new fd (%d)\r\n",oldfd); - } - if (argc == 0) { - exp_error(interp,"need program name"); - return(TCL_ERROR); - } - command = argv[0]; - if (dash_name) { - argv[0] = ckalloc(1+strlen(command)); - sprintf(argv[0],"-%s",command); - } - - signal(SIGINT, SIG_DFL); - signal(SIGQUIT, SIG_DFL); - (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;i0;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; -} - -/* return 1 if a string is substring of a flag */ -/* this version is the code used by the macro that everyone calls */ -int -exp_flageq_code(flag,string,minlen) -char *flag; -char *string; -int minlen; /* at least this many chars must match */ -{ - for (;*flag;flag++,string++,minlen--) { - if (*string == '\0') break; - if (*string != *flag) return 0; - } - if (*string == '\0' && minlen <= 0) return 1; - return 0; -} - -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) - Tcl_CreateObjCommand(interp,c->name, - 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}, -{"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}, -{"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_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}, -{"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}}; - -void -exp_init_most_cmds(interp) -Tcl_Interp *interp; -{ - exp_create_commands(interp,cmd_data); - -#ifdef HAVE_PTYTRAP - Tcl_InitHashTable(&slaveNames,TCL_STRING_KEYS); -#endif /* HAVE_PTYTRAP */ - - exp_close_in_child = exp_close_tcl_files; -} DELETED exp_command.h Index: exp_command.h ================================================================== --- exp_command.h +++ /dev/null @@ -1,350 +0,0 @@ -/* command.h - definitions for expect commands - -Written by: Don Libes, NIST, 2/6/90 - -Design and implementation of this program was paid for by U.S. tax -dollars. Therefore it is public domain. However, the author and NIST -would appreciate credit if this program or parts of it are used. -*/ - -EXTERN struct exp_f * exp_update_master - _ANSI_ARGS_((Tcl_Interp *,int *,int,int)); -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_eval_with_one_arg _ANSI_ARGS_((ClientData, - Tcl_Interp *,char **)); -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) \ -(((string)[0] == (flag)[0]) && (exp_flageq_code(((flag)+1),((string)+1),((minlen)-1)))) - -/* 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_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_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 */ - /* wait for. For example: */ - /* 1) When fd opened by someone else, e.g., */ - /* Tcl's open */ - /* 2) When entry not in use */ - /* 3) To tell user pid of "spawn -open" */ - /* 4) stdin, out, error */ - -#define EXP_NOFD -1 - -/* these are occasionally useful to distinguish between various expect */ -/* commands and are also used as array indices into the per-fd eg[] arrays */ -#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 */ -#ifdef HAVE_PTYTRAP - 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 */ - /* 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; -}; - -extern int exp_fd_max; /* highest fd ever used */ - - -#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 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 *)); - -EXTERN void exp_strftime(); - -#define exp_deleteProc (void (*)())0 -#define exp_deleteObjProc (void (*)())0 - -EXTERN int expect_key; -EXTERN int exp_configure_count; /* # of times descriptors have been closed */ - /* or indirect lists have been changed */ -EXTERN int exp_nostack_dump; /* TRUE if user has requested unrolling of */ - /* stack with no trace */ - -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_id_vars _ANSI_ARGS_((Tcl_Interp *)); -EXTERN void exp_init_trap _ANSI_ARGS_((void)); -EXTERN void exp_init_unit_random _ANSI_ARGS_((void)); -EXTERN void exp_init_sig _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 *)); -EXTERN int exp_string_to_signal _ANSI_ARGS_((Tcl_Interp *,char *)); - -EXTERN char *exp_onexit_action; - -#define exp_new(x) (x *)malloc(sizeof(x)) - -struct exp_fd_list { - int fd; - struct exp_fd_list *next; -}; - -/* describes a -i flag */ -struct exp_i { - int cmdtype; /* EXP_CMD_XXX. When an indirect update is */ - /* triggered by Tcl, this helps tell us in what */ - /* exp_i list to look in. */ - int direct; /* if EXP_DIRECT, then the spawn ids have been given */ - /* literally, else indirectly through a variable */ - int duration; /* if EXP_PERMANENT, char ptrs here had to be */ - /* malloc'd because Tcl command line went away - */ - /* i.e., in expect_before/after */ - char *variable; - char *value; /* if type == direct, this is the string that the */ - /* user originally supplied to the -i flag. It may */ - /* lose relevance as the fd_list is manipulated */ - /* over time. If type == direct, this is the */ - /* cached value of variable use this to tell if it */ - /* 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_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 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 *, - 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; -}; - -EXTERN void exp_create_commands _ANSI_ARGS_((Tcl_Interp *, - struct exp_cmd_data *)); -EXTERN void exp_init_main_cmds _ANSI_ARGS_((Tcl_Interp *)); -EXTERN void exp_init_expect_cmds _ANSI_ARGS_((Tcl_Interp *)); -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(); - DELETED exp_console.c Index: exp_console.c ================================================================== --- exp_console.c +++ /dev/null @@ -1,68 +0,0 @@ -/* exp_console.c - grab console. This stuff is in a separate file to -avoid unpleasantness of AIX (3.2.4) .h files which provide no way to -reference TIOCCONS and include both sys/ioctl.h and sys/sys/stropts.h -without getting some sort of warning from the compiler. The problem -is that both define _IO but only ioctl.h checks to see if it is -defined first. This would suggest that it is sufficient to include -ioctl.h after stropts.h. Unfortunately, ioctl.h, having seen that _IO -is defined, then fails to define other important things (like _IOW). - -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 -#include -#include - -#ifdef HAVE_STRREDIR_H -#include -# ifdef SRIOCSREDIR -# undef TIOCCONS -# endif -#endif - -#ifdef HAVE_SYS_FCNTL_H -#include -#endif - -#include "tcl.h" -#include "exp_rename.h" -#include "exp_prog.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); -} - -void -exp_console_set() -{ -#ifdef SRIOCSREDIR - int fd; - - if ((fd = open("/dev/console", O_RDONLY)) == -1) { - exp_console_manipulation_failed("open"); - } - if (ioctl(fd, SRIOCSREDIR, 0) == -1) { - exp_console_manipulation_failed("redirect"); - } - close(fd); -#endif - -#ifdef TIOCCONS - int on = 1; - - if (ioctl(0,TIOCCONS,(char *)&on) == -1) { - exp_console_manipulation_failed("redirect"); - } -#endif /*TIOCCONS*/ -} DELETED exp_event.c Index: exp_event.c ================================================================== --- exp_event.c +++ /dev/null @@ -1,455 +0,0 @@ -/* 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. - -*/ - - -#include "expect_cf.h" -#include -#include -#include - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#ifdef HAVE_PTYTRAP -# include -#endif - -#include "tcl.h" -#include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f 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; -} - -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; - } -} - -/* 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; -{ - switch (exp_fs[m].bg_status) { - case blocked: - case disarm_req_while_blocked: - case armed: - exp_fs[m].bg_status = unarmed; - exp_event_disarm(m); - break; - case unarmed: - /* 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; -{ - switch (exp_fs[m].bg_status) { - case blocked: - exp_arm_background_filehandler_force(m); - break; - case disarm_req_while_blocked: - exp_disarm_background_filehandler_force(m); - 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_fs[m].bg_status = blocked; - exp_event_disarm_fast(m,exp_background_filehandler); -} - - -/*ARGSUSED*/ -static void -exp_timehandler(clientData) -ClientData clientData; -{ - *(int *)clientData = TRUE; -} - -static void exp_filehandler(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 -} - -/* 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) -Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 1st ready master, 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;j= 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 */ - 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; -} - -/* 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) -*/ - -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 == '*') { -#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) { - 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 - 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; - } - -/* 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; - } - - /* 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++; - } -} - DELETED exp_int.h Index: exp_int.h ================================================================== --- exp_int.h +++ /dev/null @@ -1,34 +0,0 @@ -/* exp_int.h - private symbols common to both expect program and library - -Written by: Don Libes, libes@cme.nist.gov, 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. -*/ - -#ifndef _EXPECT_INT_H -#define _EXPECT_INT_H - -#ifndef TRUE -#define FALSE 0 -#define TRUE 1 -#endif - -#ifndef HAVE_MEMCPY -#define memcpy(x,y,len) bcopy(y,x,len) -#endif - -#include - -int Exp_StringMatch(); -int Exp_StringMatch2(); -void exp_console_set _ANSI_ARGS_((void)); - -#ifdef NO_STDLIB_H -# include "../compat/stdlib.h" -#else -# include /* for malloc */ -#endif /*NO_STDLIB_H*/ - -#endif /* _EXPECT_INT_H */ DELETED exp_inter.c Index: exp_inter.c ================================================================== --- exp_inter.c +++ /dev/null @@ -1,2256 +0,0 @@ -/* interact (using select) - give user keyboard control - -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 -#ifdef HAVE_INTTYPES_H -# include -#endif -#include -#ifdef HAVE_UNISTD_H -# include -#endif - -#ifdef TIME_WITH_SYS_TIME -# include -# include -#else -# if HAVE_SYS_TIME_H -# include -# else -# include -# endif -#endif - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#include - -#include "tcl.h" -#include "string.h" - -#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" - -extern char *TclGetRegError(); -extern void TclRegError(); - -#define INTER_OUT "interact_out" - -/* - * tests if we are running this using a real tty - * - * these tests are currently only used to control what gets written to the - * logfile. Note that removal of the test of "..._is_tty" means that stdin - * or stdout could be redirected and yet stdout would still be logged. - * However, it's not clear why anyone would use log_file when these are - * redirected in the first place. On the other hand, it is reasonable to - * run expect as a daemon in which case, stdin/out do not appear to be - * ttys, yet it makes sense for them to be logged with log_file as if they - * were. - */ -#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 new(x) (x *)ckalloc(sizeof(x)) - -struct action { - char *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; - 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 */ - struct action action; - struct keymap *next; -}; - -struct output { - struct exp_i *i_list; - struct action *action_eof; - struct output *next; -}; - -struct input { - struct exp_i *i_list; - struct output *output; - struct action *action_eof; - struct action *action_timeout; - struct keymap *keymap; - int timeout_nominal; /* timeout nominal */ - int timeout_remaining; /* timeout remaining */ - struct input *next; -}; - -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, -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 -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. - -The basic idea of how this works is it does a smart sequential search. -At each position of the input string, we attempt to match each of the -keymaps. If at least one matches, the first match is returned. - -If there is a CANMATCH and there are more keymaps to try, we continue -trying. If there are no more keymaps to try, we stop trying and -return with an indication of the first keymap that can match. - -Note that I've hacked up the regexp pattern matcher in two ways. One -is to force the pattern to always be anchored at the front. That way, -it doesn't waste time attempting to match later in the string (before -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_searchnext) { - char *s; /* current character being examined */ - - if (km->null) { - if (*start_search == 0) { - *skip = start_search-string; - *match_length = 1; /* s - start_search == 1 */ - *km_match = km; - return(EXP_MATCH); - } - } else if (!km->re) { - /* 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; - } - } 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) { - 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);*/ -#endif - return(EXP_CANMATCH); - } - - *skip = start_search-string; - return(EXP_CANTMATCH); -} - -#ifdef SIMPLE_EVENT - -/* - -The way that the "simple" interact works is that the original Expect -process reads from the tty and writes to the spawned process. A child -process is forked to read from the spawned process and write to the -tty. It looks like this: - - user - --> tty >-- - / \ - ^ v - child original - process Expect - ^ process - | v - \ / - < spawned < - process - -*/ - - - -#ifndef WEXITSTATUS -#define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) -#endif - -#include - -static jmp_buf env; /* for interruptable read() */ -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; -} - -#define EXP_CHILD_EOF -100 - -/* interruptable read */ -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); -} - -/* 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; -} -#endif /*SIMPLE_EVENT*/ - -static int -update_interact_fds(interp,fd_count,fd_to_input,fd_list,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; -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; - int count; - - int real_tty = FALSE; - - *config_count = exp_configure_count; - - count = 0; - for (inp = input_base;inp;inp=inp->next) { - - if (do_indirect) { - /* do not update "direct" entries (again) */ - /* they were updated upon creation */ - if (inp->i_list->direct == EXP_INDIRECT) { - exp_i_update(interp,inp->i_list); - } - for (outp = inp->output;outp;outp=outp->next) { - if (outp->i_list->direct == EXP_INDIRECT) { - exp_i_update(interp,outp->i_list); - } - } - } - - /* 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); - } - - /* revalidate all output descriptors */ - for (outp = inp->output;outp;outp=outp->next) { - for (fdp = outp->i_list->fd_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 (!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)); - } 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)); - } - - 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; - - *real_tty_caller = real_tty; /* tell caller if we have found that */ - /* we are using real tty */ - - return TCL_OK; -} - -/*ARGSUSED*/ -static char * -inter_updateproc(clientData, interp, name1, name2, flags) -ClientData clientData; -Tcl_Interp *interp; /* Interpreter containing variable. */ -char *name1; /* Name of variable. */ -char *name2; /* Second part of variable name. */ -int flags; /* Information about what happened. */ -{ - exp_configure_count++; - return 0; -} - -#define finish(x) { status = x; goto done; } - -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); - } - } - } - -#else /* SIMPLE_EVENT */ -/* deferred_interrupt = FALSE;*/ -{ - 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 */ - 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 */ - - 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); - - m = fd_list[1]; /* get 2nd fd */ - input_count = 1; - - while (1) { - - /* 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) */ - } - - /* +1 so we can look at the "other" file descriptor */ - rc = exp_get_next_event(interp,fd_list+1,input_count,&m,timeout,key); - 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; - - 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. */ - case EXP_EOF: - action = inp->action_eof; - attempt_match = FALSE; - skip = u->size; - rc = EXP_EOF; - debuglog("interact: child received eof from spawn_id %d\r\n",m); - exp_close(interp,m); - 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); - } 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; - } - } - - /* 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; - } 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; - } - - 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; - - 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; - } - - /* 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); - } - } - - /* as long as buffer is still around, null terminate it */ - if (rc != EXP_EOF) { - u->buffer[u->size] = '\0'; - u->lower [u->size] = '\0'; - } - /* 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 (action) { - 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); - } - } - } - } else { /* parent - send user keystrokes to process */ -#include - -#if defined(SIGCLD) && !defined(SIGCHLD) -#define SIGCHLD SIGCLD -#endif - debuglog("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 */ - input_count = 1; - - while (1) { - /* 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) */ - } - - rc = exp_get_next_event(interp,fd_list,input_count,&m,timeout,key); - 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; - - 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)); - } - 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; - rc = EXP_EOF; - debuglog("interact: process died/eof\r\n"); - clean_up_after_child(interp,fd_list[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. */ - case EXP_EOF: - action = inp->action_eof; - attempt_match = FALSE; - skip = u->size; - rc = EXP_EOF; - debuglog("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); - } 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; - } - } - - /* 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; - } 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; - } - - 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)); - 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; - } - - /* 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); - } - } - - /* as long as buffer is still around, null terminate it */ - if (rc != EXP_EOF) { - u->buffer[u->size] = '\0'; - u->lower [u->size] = '\0'; - } - /* 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 (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); - } - } - } - } -} -#endif /* SIMPLE_EVENT */ - - done: -#ifdef SIMPLE_EVENT - /* 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); -} - -/* version of Tcl_Eval for interact */ -static int -inter_eval(interp,action,spawn_id) -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; -} - -static void -free_keymap(km) -struct keymap *km; -{ - if (km == 0) return; - free_keymap(km->next); - - ckfree((char *)km); -} - -static void -free_action(a) -struct action *a; -{ - struct action *next; - - while (a) { - next = a->next; - ckfree((char *)a); - a = next; - } -} - -static void -free_input(interp,i) -Tcl_Interp *interp; -struct input *i; -{ - if (i == 0) return; - free_input(interp,i->next); - - exp_free_i(interp,i->i_list,inter_updateproc); - free_output(interp,i->output); - free_keymap(i->keymap); - ckfree((char *)i); -} - -static struct action * -new_action(base) -struct action **base; -{ - struct action *o = new(struct action); - - /* stick new action into beginning of list of all actions */ - o->next = *base; - *base = o; - - return o; -} - -static void -free_output(interp,o) -Tcl_Interp *interp; -struct output *o; -{ - if (o == 0) return; - 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}, -{0}}; - -void -exp_init_interact_cmds(interp) -Tcl_Interp *interp; -{ - exp_create_commands(interp,cmd_data); -} DELETED exp_log.c Index: exp_log.c ================================================================== --- exp_log.c +++ /dev/null @@ -1,261 +0,0 @@ -/* exp_log.c - logging routines and other things common to both Expect - program and library. Note that this file must NOT have any - references to Tcl except for including tclInt.h -*/ - -#include "expect_cf.h" -#include -/*#include tclInt.h drags in varargs.h. Since Pyramid */ -/* objects to including varargs.h twice, just */ -/* omit this one. */ -#include "tclInt.h" -#include "expect_comm.h" -#include "exp_int.h" -#include "exp_rename.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. */ -/* 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. */ - -/* 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) -/*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); -} - -/* 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) -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); - } -#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); -} - -/* 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) -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 */ - - -void -exp_init_log() -{ - out_buffer = ckalloc(BUFSIZ); - out_buffer_size = BUFSIZ; - outp_last = out_buffer + BUFSIZ - 1; -} - -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 DELETED exp_log.h Index: exp_log.h ================================================================== --- exp_log.h +++ /dev/null @@ -1,28 +0,0 @@ -/* 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 */ DELETED exp_main_exp.c Index: exp_main_exp.c ================================================================== --- exp_main_exp.c +++ /dev/null @@ -1,49 +0,0 @@ -/* main.c - main() and some logging routines 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. -*/ - -#include "expect_cf.h" -#include -#include "tcl.h" -#include "expect_tcl.h" - -int -main(argc, argv) -int argc; -char *argv[]; -{ - int rc = 0; - Tcl_Interp *interp = Tcl_CreateInterp(); - - if (Tcl_Init(interp) == TCL_ERROR) { - fprintf(stderr,"Tcl_Init failed: %s\n",interp->result); - exit(1); - } - - if (Expect_Init(interp) == TCL_ERROR) { - fprintf(stderr,"Expect_Init failed: %s\n",interp->result); - exit(1); - } - - exp_parse_argv(interp,argc,argv); - - /* become interactive if requested or "nothing to do" */ - if (exp_interactive) - (void) exp_interpreter(interp); - 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); - /*NOTREACHED*/ - return 0; /* Needed only to prevent compiler warning. */ -} - DELETED exp_main_sub.c Index: exp_main_sub.c ================================================================== --- exp_main_sub.c +++ /dev/null @@ -1,892 +0,0 @@ -/* exp_main_sub.c - miscellaneous subroutines for Expect or Tk main() */ - -#include "expect_cf.h" -#include -#include -#ifdef HAVE_INTTYPES_H -# include -#endif -#include - -#ifdef HAVE_UNISTD_H -# include -#endif - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#include "tcl.h" -#include "tclInt.h" -#include "exp_rename.h" -#include "exp_prog.h" -#include "exp_command.h" -#include "exp_tty_in.h" -#include "exp_log.h" -#include "exp_event.h" -#ifdef TCL_DEBUGGER -#include "tcldbg.h" -#endif - -#ifdef __CENTERLINE__ -#undef EXP_VERSION -#define EXP_VERSION "5.0.3" /* I give up! */ - /* It is not necessary that number */ - /* be accurate. It is just here to */ - /* pacify Centerline which doesn't */ - /* seem to be able to get it from */ - /* the Makefile. */ -#undef SCRIPTDIR -#define SCRIPTDIR "example/" -#undef EXECSCRIPTDIR -#define EXECSCRIPTDIR "example/" -#endif -char exp_version[] = EXP_VERSION; -#define NEED_TCL_MAJOR 7 -#define NEED_TCL_MINOR 5 - -char *exp_argv0 = "this program"; /* default program name */ -void (*exp_app_exit)() = 0; -void (*exp_event_exit)() = 0; -FILE *exp_cmdfile = 0; -char *exp_cmdfilename = 0; -int exp_cmdlinecmds = FALSE; -int exp_interactive = FALSE; -int exp_buffer_command_input = FALSE;/* read in entire cmdfile at once */ -int exp_fgets(); - -Tcl_Interp *exp_interp; /* for use by signal handlers who can't figure out */ - /* the interpreter directly */ -int exp_tcl_debugger_available = FALSE; - -int exp_getpid; - -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); -} - -/* this clumsiness because pty routines don't know Tcl definitions */ -static -void -exp_pty_exit_for_tcl(clientData) -ClientData clientData; -{ - exp_pty_exit(); -} - -static -void -exp_init_pty_exit() -{ - 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) -ClientData clientData; -{ - extern int exp_forked; - - Tcl_Interp *interp = (Tcl_Interp *)clientData; - - /* use following checks to prevent recursion in exit handlers */ - /* if this code ever supports multiple interps, these should */ - /* 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"); - } - - 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"); - } - } - - if (!exp_disconnected - && !exp_forked - && (exp_dev_tty != -1) - && isatty(exp_dev_tty) - && exp_ioctled_devtty) { - exp_tty_set(interp,&exp_tty_original,exp_dev_tty,0); - } - /* all other files either don't need to be flushed or will be - implicitly closed at exit. Spawned processes are free to continue - running, however most will shutdown after seeing EOF on stdin. - Some systems also deliver SIGHUP and other sigs to idle processes - which will blow them away if not prepared. - */ - - exp_close_all(interp); -} - -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 -} - -/* this stupidity because Tcl needs commands in writable space */ -static char prompt1[] = "prompt1"; -static char prompt2[] = "prompt2"; - -static char *prompt2_default = "+> "; -static char prompt1_default[] = "expect%d.%d> "; - -/*ARGSUSED*/ -int -Exp_Prompt1Cmd(clientData, interp, argc, argv) -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); -} - -/*ARGSUSED*/ -int -Exp_Prompt2Cmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - strcpy(interp->result,prompt2_default); - return(TCL_OK); -} - -/*ARGSUSED*/ -static int -ignore_procs(interp,s) -Tcl_Interp *interp; -char *s; /* function name */ -{ - return ((s[0] == 'p') && - (s[1] == 'r') && - (s[2] == 'o') && - (s[3] == 'm') && - (s[4] == 'p') && - (s[5] == 't') && - ((s[6] == '1') || - (s[6] == '2')) && - (s[7] == '\0') - ); -} - -/* handle an error from Tcl_Eval or Tcl_EvalFile */ -static void -handle_eval_error(interp,check_for_nostack) -Tcl_Interp *interp; -int check_for_nostack; -{ - char *msg; - - /* if errorInfo has something, print it */ - /* else use what's in interp->result */ - - msg = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY); - if (!msg) msg = interp->result; - else if (check_for_nostack) { - /* suppress errorInfo if generated via */ - /* error ... -nostack */ - if (0 == strncmp("-nostack",msg,8)) return; - - /* - * This shouldn't be necessary, but previous test fails - * because of recent change John made - see eval_trap_action() - * in exp_trap.c for more info - */ - if (exp_nostack_dump) { - exp_nostack_dump = FALSE; - return; - } - } - - /* 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)); -} - -/* user has pressed escape char from interact or somehow requested expect. -If a user-supplied command returns: - -TCL_ERROR, assume user is experimenting and reprompt -TCL_OK, ditto -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); -} - -/*ARGSUSED*/ -int -Exp_ExpVersionCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int emajor, umajor; - char *user_version; /* user-supplied version string */ - - if (argc == 1) { - Tcl_SetResult(interp,exp_version,TCL_STATIC); - return(TCL_OK); - } - if (argc > 3) { - exp_error(interp,"usage: expect_version [[-exit] version]"); - return(TCL_ERROR); - } - - user_version = argv[argc==2?1:2]; - emajor = atoi(exp_version); - umajor = atoi(user_version); - - /* first check major numbers */ - if (emajor == umajor) { - int u, e; - - /* now check minor numbers */ - char *dot = strchr(user_version,'.'); - if (!dot) { - exp_error(interp,"version number must include a minor version number"); - return TCL_ERROR; - } - - u = atoi(dot+1); - dot = strchr(exp_version,'.'); - e = atoi(dot+1); - if (e >= u) return(TCL_OK); - } - - 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", - exp_argv0,user_version,exp_version); - exp_exit(interp,1); - /*NOTREACHED*/ -} - -static char init_auto_path[] = "lappend auto_path $exp_library $exp_exec_library"; - -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); - - Tcl_SetVar(interp,"expect_library",SCRIPTDIR,0);/* deprecated */ - Tcl_SetVar(interp,"exp_library",SCRIPTDIR,0); - Tcl_SetVar(interp,"exp_exec_library",EXECSCRIPTDIR,0); - Tcl_Eval(interp,init_auto_path); - Tcl_ResetResult(interp); - -#ifdef TCL_DEBUGGER - Dbg_IgnoreFuncs(interp,ignore_procs); -#endif - - return TCL_OK; -} - -static char sigexit_init_default[] = "trap exit {SIGINT SIGTERM}"; -static char debug_init_default[] = "trap {exp_debug 1} SIGINT"; - -void -exp_parse_argv(interp,argc,argv) -Tcl_Interp *interp; -int argc; -char **argv; -{ - char argc_rep[10]; /* enough space for storing literal rep of argc */ - - int sys_rc = TRUE; /* read system rc file */ - int my_rc = TRUE; /* read personal rc file */ - - int c; - int rc; - - extern int optind; - extern char *optarg; - char *args; /* ptr to string-rep of all args */ - char *debug_init; - - exp_argv0 = argv[0]; - -#ifdef TCL_DEBUGGER - Dbg_ArgcArgv(argc,argv,1); -#endif - - /* initially, we must assume we are not interactive */ - /* this prevents interactive weirdness courtesy of unknown via -c */ - /* 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) { - 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 */ - /* in order to allow things like -n- on #! line */ - 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)); - } - break; - case 'd': exp_is_debugging = TRUE; - debuglog("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); - } - - /* 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"))) { - debug_init = debug_init_default; - } - Tcl_Eval(interp,debug_init); - if (rc == 1) Dbg_On(interp,0); - break; -#endif - case 'f': /* name of cmd file */ - exp_cmdfilename = optarg; - break; - case 'b': /* read cmdfile one part at a time */ - exp_cmdfilename = optarg; - exp_buffer_command_input = TRUE; - break; - case 'i': /* interactive */ - exp_interactive = TRUE; - break; - case 'n': /* don't read personal rc file */ - my_rc = FALSE; - break; - 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); - break; - default: usage(interp); - } - } - - abort_getopt: - - for (c = 0;cresult != 0) - errorlog("%s\r\n",interp->result); - exp_exit(interp,1); - } - close(fd); - } - } - if (my_rc) { - char file[200]; - char *home; - int fd; - char *getenv(); - - 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); - 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); - } - close(fd); - } - } - } -} - -int -exp_interpret_cmdfilename(interp,filename) -Tcl_Interp *interp; -char *filename; -{ - int rc; - - debuglog("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 */ - Tcl_AddErrorInfo(interp, ""); - handle_eval_error(interp,0); - } - return rc; -} - -int -exp_interpret_cmdfile(interp,fp) -Tcl_Interp *interp; -FILE *fp; -{ - int rc = 0; - int newcmd; - int eof; - - Tcl_DString dstring; - Tcl_DStringInit(&dstring); - - debuglog("executing commands from command file\r\n"); - - newcmd = TRUE; - 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; - eof = TRUE; - } - ccmd = Tcl_DStringAppend(&dstring,line,-1); - if (!Tcl_CommandComplete(ccmd) && !eof) { - newcmd = FALSE; - continue; /* continue collecting command */ - } - newcmd = TRUE; - - rc = Tcl_Eval(interp,ccmd); - Tcl_DStringFree(&dstring); - if (rc != TCL_OK) { - handle_eval_error(interp,0); - break; - } - if (eof) break; - } - 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}, -{0}}; - -void -exp_init_main_cmds(interp) -Tcl_Interp *interp; -{ - exp_create_commands(interp,cmd_data); -} DELETED exp_main_tk.c Index: exp_main_tk.c ================================================================== --- exp_main_tk.c +++ /dev/null @@ -1,445 +0,0 @@ -/* exp_main_tk.c - main for expectk - - This file consists of three pieces: - 1) AppInit for Expectk. This has been suitably modified to invoke - a modified version of Tk_Init. - 2) Tk_Init for Expectk. What's wrong with the normal Tk_Init is that - removes the -- in the cmd-line arg list, so Expect cannot know - whether args are flags to Expectk or data for the script. Sigh. - 3) Additions and supporting utilities to Tk's Argv parse table to - support Expectk's flags. - - Author: Don Libes, NIST, 2/20/96 - -*/ - -/* Expectk's AppInit */ - -/* - * tkAppInit.c -- - * - * Provides a default version of the Tcl_AppInit procedure for - * use in wish and similar Tk-based applications. - * - * Copyright (c) 1993 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. - */ - -#ifndef lint -static char sccsid[] = "@(#) tkAppInit.c 1.19 95/12/23 17:09:24"; -#endif /* not lint */ - -#include - -#include "tk.h" - -#include "expect_tcl.h" -#include "tcldbg.h" - -/* - * The following variable is a special hack that is needed in order for - * Sun shared libraries to be used for Tcl. - */ - -extern int matherr(); -int *tclDummyMathPtr = (int *) matherr; - -#ifdef TK_TEST -EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -#endif /* TK_TEST */ - -/* - *---------------------------------------------------------------------- - * - * main -- - * - * This is the main program for the application. - * - * Results: - * None: Tk_Main never returns here, so this procedure never - * returns either. - * - * Side effects: - * Whatever the application does. - * - *---------------------------------------------------------------------- - */ - -int -main(argc, argv) - int argc; /* Number of command-line arguments. */ - char **argv; /* Values of command-line arguments. */ -{ - Tk_Main(argc, argv, Tcl_AppInit); - return 0; /* Needed only to prevent compiler warning. */ -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_AppInit -- - * - * This procedure performs application-specific initialization. - * Most applications, especially those that incorporate additional - * packages, will have their own version of this procedure. - * - * Results: - * Returns a standard Tcl completion code, and leaves an error - * message in interp->result if an error occurs. - * - * Side effects: - * Depends on the startup script. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_AppInit(interp) - Tcl_Interp *interp; /* Interpreter for application. */ -{ - if (Tcl_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - - /* do Expect first so we can get access to Expect commands when */ - /* Tk_Init does the argument parsing of -c */ - if (Expect_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "Expect", Expect_Init, (Tcl_PackageInitProc *)NULL); - - if (Tk_Init2(interp) == TCL_ERROR) { /* DEL */ - return TCL_ERROR; - } - Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); - - /* - * Call the init procedures for included packages. Each call should - * look like this: - * - * if (Mod_Init(interp) == TCL_ERROR) { - * return TCL_ERROR; - * } - * - * where "Mod" is the name of the module. - */ - - /* - * Call Tcl_CreateCommand for application-specific commands, if - * they weren't already created by the init procedures called above. - */ - - /* - * Specify a user-specific startup file to invoke if the application - * is run interactively. Typically the startup file is "~/.apprc" - * where "app" is the name of the application. If this line is deleted - * then no user-specific startup file will be run under any conditions. - */ - - Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); - return TCL_OK; -} - - - - -/* - * Count of number of main windows currently open in this process. - */ - -static int numMainWindows; - -/* - * The variables and table below are used to parse arguments from - * the "argv" variable in Tk_Init. - */ - -static int synchronize; -static char *name; -static char *display; -static char *geometry; -static char *colormap; -static char *visual; -static int rest = 0; - -/* for Expect */ -int my_rc = 1; -int sys_rc = 1; -int optcmd_eval(); -#ifdef TCL_DEBUGGER -int optcmd_debug(); -#endif -int print_version = 0; - -static Tk_ArgvInfo argTable[] = { - {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap, - "Colormap for main window"}, - {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display, - "Display to use"}, - {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry, - "Initial geometry for window"}, - {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name, - "Name to use for application"}, - {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, - "Use synchronous mode for display server"}, - {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual, - "Visual for main window"}, - {"--", 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, - "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"}, - {"-version", TK_ARGV_CONSTANT, (char *) 1, (char *) &print_version, - "Print version and exit"}, -#if TCL_DEBUGGER - {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0, - "Enable debugger"}, -#endif - {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL, - (char *) NULL} -}; - -/* - *---------------------------------------------------------------------- - * - * Tk_Init -- - * - * This procedure is invoked to add Tk to an interpreter. It - * incorporates all of Tk's commands into the interpreter and - * creates the main window for a new Tk application. If the - * interpreter contains a variable "argv", this procedure - * extracts several arguments from that variable, uses them - * to configure the main window, and modifies argv to exclude - * the arguments (see the "wish" documentation for a list of - * the arguments that are extracted). - * - * Results: - * Returns a standard Tcl completion code and sets interp->result - * if there is an error. - * - * Side effects: - * Depends on various initialization scripts that get invoked. - * - *---------------------------------------------------------------------- - */ - -int -Tk_Init2(interp) - Tcl_Interp *interp; /* Interpreter to initialize. */ -{ - char *p; - int argc, code; - char **argv, *args[20]; - Tcl_DString class; - char buffer[30]; - - /* - * If there is an "argv" variable, get its value, extract out - * relevant arguments from it, and rewrite the variable without - * the arguments that we used. - */ - - synchronize = 0; - name = display = geometry = colormap = visual = NULL; - p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY); - argv = NULL; - if (p != NULL) { - if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) { - argError: - Tcl_AddErrorInfo(interp, - "\n (processing arguments in argv variable)"); - return TCL_ERROR; - } - if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, - argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS) - != TCL_OK) { - ckfree((char *) argv); - goto argError; - } - - if (print_version) { - extern char exp_version[]; - printf ("expectk version %s\n", exp_version); - exp_exit (interp, 0); - } - - p = Tcl_Merge(argc, argv); - Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY); - sprintf(buffer, "%d", argc); - Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY); - ckfree(p); - } - - /* - * Figure out the application's name and class. - */ - - if (name == NULL) { - name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); - if ((name == NULL) || (*name == 0)) { - name = "tk"; - } else { - p = (char *)strrchr(name, '/'); /* added cast - DEL */ - if (p != NULL) { - name = p+1; - } - } - } - Tcl_DStringInit(&class); - Tcl_DStringAppend(&class, name, -1); - p = Tcl_DStringValue(&class); - if (islower(*p)) { - *p = toupper((unsigned char) *p); - } - - /* - * Create an argument list for creating the top-level window, - * using the information parsed from argv, if any. - */ - - args[0] = "toplevel"; - args[1] = "."; - args[2] = "-class"; - args[3] = Tcl_DStringValue(&class); - argc = 4; - if (display != NULL) { - args[argc] = "-screen"; - args[argc+1] = display; - argc += 2; - - /* - * If this is the first application for this process, save - * the display name in the DISPLAY environment variable so - * that it will be available to subprocesses created by us. - */ - - if (numMainWindows == 0) { - Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); - } - } - if (colormap != NULL) { - args[argc] = "-colormap"; - args[argc+1] = colormap; - argc += 2; - } - if (visual != NULL) { - args[argc] = "-visual"; - args[argc+1] = visual; - argc += 2; - } - args[argc] = NULL; - code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name); - Tcl_DStringFree(&class); - if (code != TCL_OK) { - goto done; - } - Tcl_ResetResult(interp); - if (synchronize) { - XSynchronize(Tk_Display(Tk_MainWindow(interp)), True); - } - - /* - * Set the geometry of the main window, if requested. Put the - * requested geometry into the "geometry" variable. - */ - - if (geometry != NULL) { - Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); - code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL); - if (code != TCL_OK) { - goto done; - } - } - if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) { - code = TCL_ERROR; - goto done; - } - code = Tcl_PkgProvide(interp, "Tk", TK_VERSION); - if (code != TCL_OK) { - goto done; - } - - /* - * 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 -optcmd_eval(dst,interp,key,argc,argv) -char *dst; -Tcl_Interp *interp; -char *key; -int argc; -char **argv; -{ - int i; - int rc; - - exp_cmdlinecmds = 1; - - rc = Tcl_Eval(interp,argv[0]); - if (rc == TCL_ERROR) return -1; - - argc--; - for (i=0;iresult,"-Debug flag needs 1 or 0 argument"); - return -1; - } - - if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) { - return -1; - } - - if (i) { - Dbg_On(interp,0); - } - - argc--; - for (i=0;i -#include -#include - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#include "tcl.h" -#include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f defs */ -#include "exp_event.h" - -/*ARGSUSED*/ -void -exp_arm_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_disarm_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_disarm_background_filehandler_force(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_unblock_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_block_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_event_disarm(fd) -int fd; -{ -} - -/* returns status, one of EOF, TIMEOUT, ERROR or DATA */ -/*ARGSUSED*/ -int -exp_get_next_event(interp,masters, n,master_out,timeout,key) -Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 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); -} - -/*ARGSUSED*/ -int -exp_get_next_event_info(interp,fd,ready_mask) -Tcl_Interp *interp; -int fd; -int ready_mask; -{ -} - -/* There is no portable way to do sub-second sleeps on such a system, so */ -/* do the next best thing (without a busy loop) and fake it: sleep the right */ -/* amount of time over the long run. Note that while "subtotal" isn't */ -/* reinitialized, it really doesn't matter for such a gross hack as random */ -/* scheduling pauses will easily introduce occasional one second delays. */ -int /* returns TCL_XXX */ -exp_dsleep(interp,sec) -Tcl_Interp *interp; -double sec; -{ - static double subtotal = 0; - int seconds; - - subtotal += sec; - if (subtotal < 1) return TCL_OK; - seconds = subtotal; - subtotal -= seconds; - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(rc); - } - sleep(seconds); - return TCL_OK; -} - -#if 0 -/* There is no portable way to do sub-second sleeps on such a system, so */ -/* do the next best thing (without a busy loop) and fake it: sleep the right */ -/* amount of time over the long run. Note that while "subtotal" isn't */ -/* reinitialized, it really doesn't matter for such a gross hack as random */ -/* scheduling pauses will easily introduce occasional one second delays. */ -int /* returns TCL_XXX */ -exp_usleep(interp,usec) -Tcl_Interp *interp; -long usec; /* microseconds */ -{ - static subtotal = 0; - int seconds; - - subtotal += usec; - if (subtotal < 1000000) return TCL_OK; - seconds = subtotal/1000000; - subtotal = subtotal%1000000; - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); - } - sleep(seconds); - return TCL_OK; -} -#endif /*0*/ - -/* set things up for later calls to event handler */ -void -exp_init_event() -{ - exp_event_exit = 0; -} DELETED exp_poll.c Index: exp_poll.c ================================================================== --- exp_poll.c +++ /dev/null @@ -1,880 +0,0 @@ -/* exp_poll.c - This file contains UNIX specific procedures for - * poll-based notifier, which is the lowest-level part of the Tcl - * event loop. This file works together with ../generic/tclNotify.c. - * - * 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. - * - * Written by Don Libes, NIST, 2/6/90 - * Rewritten by Don Libes, 2/96 for new Tcl notifier paradigm. - * Rewritten again by Don Libes, 8/97 for yet another Tcl notifier paradigm. - */ - -#include "tclInt.h" -#include "tclPort.h" -#include - -#include -#include - -#ifdef HAVE_UNISTD_H -# include -#endif - -/* Some systems require that the poll array be non-empty so provide a - * 1-elt array for starters. It will be ignored as soon as it grows - * larger. - */ - -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 - * Tcl event loop. This file works together with - * ../generic/tclNotify.c. - * - * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * SCCS: @(#) tclUnixNotfy.c 1.42 97/07/02 20:55:44 - */ - -/* - * This structure is used to keep track of the notifier info for a - * a registered file. - */ - -typedef struct FileHandler { - int fd; - int mask; /* Mask of desired events: TCL_READABLE, - * etc. */ - int readyMask; /* Mask of events that have been seen since the - * last time file handlers were invoked for - * this file. */ - Tcl_FileProc *proc; /* Procedure to call, in the style of - * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ - int pollArrayIndex; /* index into poll array */ - struct FileHandler *nextPtr;/* Next in list of all files we care about. */ -} FileHandler; - -/* - * The following structure is what is added to the Tcl event queue when - * file handlers are ready to fire. - */ - -typedef struct FileHandlerEvent { - Tcl_Event header; /* Information that is standard for - * all events. */ - int fd; /* File descriptor that is ready. Used - * to find the FileHandler structure for - * the file (can't point directly to the - * FileHandler structure because it could - * go away while the event is queued). */ -} FileHandlerEvent; - -/* - * The following static structure contains the state information for the - * select based implementation of the Tcl notifier. - */ - -static struct { - FileHandler *firstFileHandlerPtr; - /* Pointer to head of file handler list. */ - fd_mask checkMasks[3*MASK_SIZE]; - /* This array is used to build up the masks - * to be used in the next call to select. - * Bits are set in response to calls to - * Tcl_CreateFileHandler. */ - fd_mask readyMasks[3*MASK_SIZE]; - /* This array reflects the readable/writable - * conditions that were found to exist by the - * last call to select. */ - int numFdBits; /* Number of valid bits in checkMasks - * (one more than highest fd for which - * Tcl_WatchFile has been called). */ -} notifier; - -/* - * The following static indicates whether this module has been initialized. - */ - -static int initialized = 0; - -/* - * Static routines defined in this file. - */ - -static void InitNotifier _ANSI_ARGS_((void)); -static void NotifierExitHandler _ANSI_ARGS_(( - ClientData clientData)); -static int FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr, - int flags)); - -/* - *---------------------------------------------------------------------- - * - * InitNotifier -- - * - * Initializes the notifier state. - * - * Results: - * None. - * - * Side effects: - * Creates a new exit handler. - * - *---------------------------------------------------------------------- - */ - -static void -InitNotifier() -{ - initialized = 1; - memset(¬ifier, 0, sizeof(notifier)); - Tcl_CreateExitHandler(NotifierExitHandler, NULL); -} - -/* - *---------------------------------------------------------------------- - * - * NotifierExitHandler -- - * - * This function is called to cleanup the notifier state before - * Tcl is unloaded. - * - * Results: - * None. - * - * Side effects: - * Destroys the notifier window. - * - *---------------------------------------------------------------------- - */ - -static void -NotifierExitHandler(clientData) - ClientData clientData; /* Not used. */ -{ - initialized = 0; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetTimer -- - * - * This procedure sets the current notifier timer value. This - * interface is not implemented in this notifier because we are - * always running inside of Tcl_DoOneEvent. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetTimer(timePtr) - Tcl_Time *timePtr; /* Timeout value, may be NULL. */ -{ - /* - * The interval timer doesn't do anything in this implementation, - * because the only event loop is via Tcl_DoOneEvent, which passes - * timeout values to Tcl_WaitForEvent. - */ -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_CreateFileHandler -- - * - * This procedure registers a file handler with the Xt notifier. - * - * Results: - * None. - * - * Side effects: - * Creates a new file handler structure and registers one or more - * input procedures with Xt. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_CreateFileHandler(fd, mask, proc, clientData) - int fd; /* Handle of stream to watch. */ - int mask; /* OR'ed combination of TCL_READABLE, - * TCL_WRITABLE, and TCL_EXCEPTION: - * indicates conditions under which - * proc should be called. */ - Tcl_FileProc *proc; /* Procedure to call for each - * selected event. */ - ClientData clientData; /* Arbitrary data to pass to proc. */ -{ - FileHandler *filePtr; - int index, bit; - int cur_fd_index; - - if (!initialized) { - InitNotifier(); - } - - for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd == fd) { - break; - } - } - if (filePtr == NULL) { - filePtr = (FileHandler*) ckalloc(sizeof(FileHandler)); /* MLK */ - filePtr->fd = fd; - filePtr->readyMask = 0; - 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) { - 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_DeleteFileHandler -- - * - * Cancel a previously-arranged callback arrangement for - * a file. - * - * Results: - * None. - * - * Side effects: - * If a callback was previously registered on file, remove it. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_DeleteFileHandler(fd) - int fd; /* Stream id for which to remove callback procedure. */ -{ - FileHandler *filePtr, *prevPtr, *lastPtr; - int index, bit, mask, i; - int cur_fd_index; - - if (!initialized) { - InitNotifier(); - } - - /* - * Find the entry for the given file (and return if there - * isn't one). - */ - - for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ; - prevPtr = filePtr, filePtr = filePtr->nextPtr) { - if (filePtr == NULL) { - return; - } - 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) { - notifier.firstFileHandlerPtr = filePtr->nextPtr; - } else { - prevPtr->nextPtr = filePtr->nextPtr; - } - - /* back to poll-specific code - DEL */ - - cur_fd_index = filePtr->pollArrayIndex; - fdsInUse--; - - /* if this one is last, do nothing special */ - /* else swap with one at end of array */ - - if (cur_fd_index != fdsInUse) { - int lastfd_in_array = fdArray[fdsInUse].fd; - memcpy(&fdArray[cur_fd_index],&fdArray[fdsInUse],sizeof(struct pollfd)); - - /* update index to reflect new location in array */ - /* first find link corresponding to last element in array */ - - for (lastPtr = notifier.firstFileHandlerPtr; filePtr; lastPtr = lastPtr->nextPtr) { - if (lastPtr->fd == lastfd_in_array) { - lastPtr->pollArrayIndex = cur_fd_index; - break; - } - } - } - - fdsInUse--; - - ckfree((char *) filePtr); -} - -/* - *---------------------------------------------------------------------- - * - * FileHandlerEventProc -- - * - * This procedure is called by Tcl_ServiceEvent when a file event - * reaches the front of the event queue. This procedure is - * responsible for actually handling the event by invoking the - * callback for the file handler. - * - * Results: - * Returns 1 if the event was handled, meaning it should be removed - * from the queue. Returns 0 if the event was not handled, meaning - * it should stay on the queue. The only time the event isn't - * handled is if the TCL_FILE_EVENTS flag bit isn't set. - * - * Side effects: - * Whatever the file handler's callback procedure does. - * - *---------------------------------------------------------------------- - */ - -static int -FileHandlerEventProc(evPtr, flags) - Tcl_Event *evPtr; /* Event to service. */ - int flags; /* Flags that indicate what events to - * handle, such as TCL_FILE_EVENTS. */ -{ - FileHandler *filePtr; - FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr; - int mask; - - if (!(flags & TCL_FILE_EVENTS)) { - return 0; - } - - /* - * Search through the file handlers to find the one whose handle matches - * the event. We do this rather than keeping a pointer to the file - * handler directly in the event, so that the handler can be deleted - * while the event is queued without leaving a dangling pointer. - */ - - for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL; - filePtr = filePtr->nextPtr) { - if (filePtr->fd != fileEvPtr->fd) { - continue; - } - - /* - * The code is tricky for two reasons: - * 1. The file handler's desired events could have changed - * since the time when the event was queued, so AND the - * ready mask with the desired mask. - * 2. The file could have been closed and re-opened since - * the time when the event was queued. This is why the - * ready mask is stored in the file handler rather than - * the queued event: it will be zeroed when a new - * file handler is created for the newly opened file. - */ - - mask = filePtr->readyMask & filePtr->mask; - filePtr->readyMask = 0; - if (mask != 0) { - (*filePtr->proc)(filePtr->clientData, mask); - } - break; - } - return 1; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_WaitForEvent -- - * - * This function is called by Tcl_DoOneEvent to wait for new - * events on the message queue. If the block time is 0, then - * Tcl_WaitForEvent just polls without blocking. - * - * Results: - * Returns -1 if the select would block forever, otherwise - * returns 0. - * - * Side effects: - * Queues file events that are detected by the select. - * - *---------------------------------------------------------------------- - */ - -int -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; - - if (!initialized) { - InitNotifier(); - } - - /* - * Set up the timeout structure. Note that if there are no events to - * 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. - */ - - for (filePtr = notifier.firstFileHandlerPtr; - (filePtr != NULL) && (numFound > 0); - filePtr = filePtr->nextPtr) { - index = filePtr->pollArrayIndex; - mask = 0; - - if (fdArray[index].revents & POLLIN) { - mask |= TCL_READABLE; - } - if (fdArray[index].revents & POLLOUT) { - mask |= TCL_WRITABLE; - } - /* 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--; - } - - /* - * Don't bother to queue an event if the mask was previously - * non-zero since an event must still be on the queue. - */ - - if (filePtr->readyMask == 0) { - fileEvPtr = (FileHandlerEvent *) ckalloc( - sizeof(FileHandlerEvent)); - fileEvPtr->header.proc = FileHandlerEventProc; - fileEvPtr->fd = filePtr->fd; - Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL); - } - 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__ */ DELETED exp_prog.h Index: exp_prog.h ================================================================== --- exp_prog.h +++ /dev/null @@ -1,19 +0,0 @@ -/* exp_prog.h - private symbols common to both expect program and library - -Written by: Don Libes, libes@cme.nist.gov, 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. -*/ - -#ifndef _EXPECT_PROG_H -#define _EXPECT_PROG_H - -#include "expect_tcl.h" -#include "exp_int.h" - -/* yes, I have a weak mind */ -#define streq(x,y) (0 == strcmp((x),(y))) - -#endif /* _EXPECT_PROG_H */ DELETED exp_pty.c Index: exp_pty.c ================================================================== --- exp_pty.c +++ /dev/null @@ -1,275 +0,0 @@ -/* exp_pty.c - generic routines to allocate and test ptys - -Written by: Don Libes, NIST, 3/9/93 - -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" -#ifdef HAVE_UNISTD_H -# include -#endif -#ifdef HAVE_SYS_FCNTL_H -# include -#else -# include -#endif -#include -#include - -#ifdef TIME_WITH_SYS_TIME -# include -# include -#else -# if HAVE_SYS_TIME_H -# include -# else -# include -# endif -#endif - -#include -#include -#include -#define EXP_AVOID_INCLUDING_TCL_H 1 -#include "expect_comm.h" -#include "exp_rename.h" -#include "exp_pty.h" - -#include - -void debuglog(); - -#ifndef TRUE -#define TRUE 1 -#define FALSE 0 -#endif - -#ifdef O_NOCTTY -#define RDWR ((O_RDWR)|(O_NOCTTY)) -#else -#define RDWR O_RDWR -#endif - -static int locked = FALSE; -static char lock[] = "/tmp/ptylock.XXXX"; /* XX is replaced by pty id */ -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 */ -static jmp_buf env; /* for interruptable read() */ -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 */ -/* as well. */ - -/* Note that this code is virtually replicated from other code in expect */ -/* At some point, I'll dump one, but not until I'm satisfied no other */ -/* changes are needed */ - -/*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); -} - -/* interruptable read */ -static int -i_read(fd,buffer,length,timeout) -int fd; -char *buffer; -int length; -int timeout; -{ - int cc = -2; - - /* since setjmp insists on returning 1 upon longjmp(,0), */ - /* longjmp(,2) instead. */ - - /* restart read if setjmp returns 0 (first time) or 2. */ - /* abort if setjmp returns 1. */ - - alarm(timeout); - - if (1 != setjmp(env)) { - env_valid = TRUE; - cc = read(fd,buffer,length); - } - env_valid = FALSE; - i_read_errno = errno; /* errno can be overwritten by the */ - /* time we return */ - alarm(0); - return(cc); -} - -static RETSIGTYPE (*oldAlarmHandler)(); -static RETSIGTYPE (*oldHupHandler)(); -static time_t current_time; /* time when testing began */ - -/* if TRUE, begin testing, else end testing */ -/* returns -1 for failure, 0 for success */ -int -exp_pty_test_start() -{ - int lfd; /* locksrc file descriptor */ - - oldAlarmHandler = signal(SIGALRM,sigalarm_handler); -#ifndef O_NOCTTY - /* Ignore hangup signals generated by pty testing */ - /* when running in background with no control tty. */ - /* Very few systems don't define O_NOCTTY. Only one */ - /* I know of is Next. */ - oldAlarmHandler = signal(SIGHUP,SIG_IGN); -#endif - - time(¤t_time); - - /* 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))) { - static char buf[256]; - exp_pty_error = buf; - sprintf(exp_pty_error,"can't create %s, errno = %d\n",locksrc, errno); - return(-1); - } - close(lfd); - return 0; -} - -void -exp_pty_test_end() -{ - signal(SIGALRM,oldAlarmHandler); -#ifndef O_NOCTTY - signal(SIGALRM,oldHupHandler); -#endif - (void) unlink(locksrc); -} - -/* returns non-negative if successful */ -int -exp_pty_test(master_name,slave_name,bank,num) -char *master_name; -char *slave_name; -int bank; -char *num; /* string representation of number */ -{ - int master, slave; - int cc; - char c; - - /* 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); - 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); - -#ifdef __QNX__ - - /* QNX ptys don't have a lot of the same properties such as - read 0 at EOF, etc */ - /* if 1 should pacify C compiler without using nested ifdefs */ - 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", - master_name); - (void) close(master); - return -1; - } - return(master); -#else - if (0 > (slave = open(slave_name,RDWR))) { - (void) close(master); - return -1; - } - (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); - locked = FALSE; /* leave lock file around so Expect's avoid */ - /* retrying this pty for near future */ - return -1; - } - - /* verify no one else is using master by attempting */ - /* to read eof from slave side */ - if (0 > (master = open(master_name,RDWR))) return(-1); - if (0 > (slave = open(slave_name,RDWR))) { - (void) close(master); - return -1; - } - (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); - return -1; - } - - /* seems ok, let's use it */ - debuglog("using master pty %s\n",master_name); - return(open(master_name,RDWR)); -#endif -} - -void -exp_pty_unlock() -{ - if (locked) { - (void) unlink(lock); - locked = FALSE; - } -} - -/* returns 1 if successfully locked, 0 otherwise */ -int -exp_pty_lock(bank,num) -int bank; -char *num; /* string representation of number */ -{ - struct stat statbuf; - - if (locked) { - unlink(lock); - locked = FALSE; - } - - sprintf(lock,"/tmp/ptylock.%c%s",bank,num); - - if ((0 == stat(lock,&statbuf)) && - (statbuf.st_mtime+3600 < current_time)) { - (void) unlink(lock); - } - - if (-1 == (link(locksrc,lock))) locked = FALSE; - else locked = TRUE; - - return locked; -} - DELETED exp_pty.h Index: exp_pty.h ================================================================== --- exp_pty.h +++ /dev/null @@ -1,17 +0,0 @@ -/* exp_pty.h - declarations for pty allocation and testing - -Written by: Don Libes, NIST, 3/9/93 - -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. - -*/ - -int exp_pty_test_start(); -void exp_pty_test_end(); -int exp_pty_test(); -void exp_pty_unlock(); -int exp_pty_lock(); - -extern char *exp_pty_slave_name; DELETED exp_regexp.c Index: exp_regexp.c ================================================================== --- exp_regexp.c +++ /dev/null @@ -1,1253 +0,0 @@ -/* - * regcomp and regexec -- regsub and regerror are 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. *** - * *** The only change is to use ckalloc and ckfree instead of *** - * *** malloc and free. *** - - * *** and again for Expect!!! - DEL - - * *** More minor corrections stolen from tcl7.5p1/regexp.c - DEL - - */ - -#include "tcl.h" -#include "expect_cf.h" -#include "exp_prog.h" -#include "tclRegexp.h" -#include "exp_regexp.h" -#include "string.h" - -#define NOTSTATIC /* was at one time, but Expect needs access */ - -/* - * 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 regcomp() 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 regexec() needs it and regcomp() 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) { regerror(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 regcomp(). - */ -static char *regparse; /* Input-scan pointer. */ -static int regnpar; /* () count. */ -static char regdummy; -static char *regcode; /* Code-emit pointer; ®dummy = don't. */ -static long regsize; /* Code size. */ - -/* - * 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 regcomp()'s friends. - */ -#ifndef STATIC -#define STATIC static -#endif -STATIC char *reg(); -STATIC char *regbranch(); -STATIC char *regpiece(); -STATIC char *regatom(); -STATIC char *regnode(); -STATIC char *regnext(); -STATIC void regc(); -STATIC void reginsert(); -STATIC void regtail(); -STATIC void regoptail(); -#ifdef STRCSPN -STATIC int strcspn(); -#endif - -/* regcomp originally appeared here - DEL */ - -/* - - 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) -int paren; /* Parenthesized? */ -int *flagp; -{ - 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 (regnpar >= NSUBEXP) - FAIL("too many ()"); - parno = regnpar; - regnpar++; - ret = regnode(OPEN+parno); - } else - ret = NULL; - - /* Pick up the branches, linking them together. */ - br = regbranch(&flags); - 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 (*regparse == '|') { - regparse++; - br = regbranch(&flags); - 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); - 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 && *regparse++ != ')') { - FAIL("unmatched ()"); - } else if (!paren && *regparse != '\0') { - if (*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) -int *flagp; -{ - register char *ret; - register char *chain; - register char *latest; - int flags; - - *flagp = WORST; /* Tentatively. */ - - ret = regnode(BRANCH); - chain = NULL; - while (*regparse != '\0' && *regparse != '|' && *regparse != ')') { - latest = regpiece(&flags); - 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); - - 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) -int *flagp; -{ - register char *ret; - register char op; - register char *next; - int flags; - - ret = regatom(&flags); - if (ret == NULL) - return(NULL); - - op = *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); - else if (op == '*') { - /* Emit x* as (x&|), where & means "self". */ - reginsert(BRANCH, ret); /* Either x */ - regoptail(ret, regnode(BACK)); /* and loop */ - regoptail(ret, ret); /* back */ - regtail(ret, regnode(BRANCH)); /* or */ - regtail(ret, regnode(NOTHING)); /* null. */ - } else if (op == '+' && (flags&SIMPLE)) - reginsert(PLUS, ret); - else if (op == '+') { - /* Emit x+ as x(&|), where & means "self". */ - next = regnode(BRANCH); /* Either */ - regtail(ret, next); - regtail(regnode(BACK), ret); /* loop back */ - regtail(next, regnode(BRANCH)); /* or */ - regtail(ret, regnode(NOTHING)); /* null. */ - } else if (op == '?') { - /* Emit x? as (x|) */ - reginsert(BRANCH, ret); /* Either x */ - regtail(ret, regnode(BRANCH)); /* or */ - next = regnode(NOTHING); /* null. */ - regtail(ret, next); - regoptail(ret, next); - } - regparse++; - if (ISMULT(*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) -int *flagp; -{ - register char *ret; - int flags; - - *flagp = WORST; /* Tentatively. */ - - switch (*regparse++) { - case '^': - ret = regnode(BOL); - break; - case '$': - ret = regnode(EOL); - break; - case '.': - ret = regnode(ANY); - *flagp |= HASWIDTH|SIMPLE; - break; - case '[': { - register int clss; - register int classend; - - if (*regparse == '^') { /* Complement of range. */ - ret = regnode(ANYBUT); - regparse++; - } else - ret = regnode(ANYOF); - if (*regparse == ']' || *regparse == '-') - regc(*regparse++); - while (*regparse != '\0' && *regparse != ']') { - if (*regparse == '-') { - regparse++; - if (*regparse == ']' || *regparse == '\0') - regc('-'); - else { - clss = UCHARAT(regparse-2)+1; - classend = UCHARAT(regparse); - if (clss > classend+1) - FAIL("invalid [] range"); - for (; clss <= classend; clss++) - regc((char)clss); - regparse++; - } - } else - regc(*regparse++); - } - regc('\0'); - if (*regparse != ']') - FAIL("unmatched []"); - regparse++; - *flagp |= HASWIDTH|SIMPLE; - } - break; - case '(': - ret = reg(1, &flags); - if (ret == NULL) - return(NULL); - *flagp |= flags&(HASWIDTH|SPSTART); - break; - case '\0': - case '|': - case ')': - FAIL("internal urp"); /* Supposed to be caught earlier. */ - /* NOTREACHED */ - break; - case '?': - case '+': - case '*': - FAIL("?+* follows nothing"); - /* NOTREACHED */ - break; - case '\\': - if (*regparse == '\0') - FAIL("trailing \\"); - ret = regnode(EXACTLY); - regc(*regparse++); - regc('\0'); - *flagp |= HASWIDTH|SIMPLE; - break; - default: { - register int len; - register char ender; - - regparse--; - len = strcspn(regparse, META); - if (len <= 0) - FAIL("internal disaster"); - ender = *(regparse+len); - if (len > 1 && ISMULT(ender)) - len--; /* Back off clear of ?+* operand. */ - *flagp |= HASWIDTH; - if (len == 1) - *flagp |= SIMPLE; - ret = regnode(EXACTLY); - while (len > 0) { - regc(*regparse++); - len--; - } - regc('\0'); - } - break; - } - - return(ret); -} - -/* - - regnode - emit a node - */ -static char * /* Location. */ -regnode(op) -int op; -{ - register char *ret; - register char *ptr; - - ret = regcode; - if (ret == ®dummy) { - regsize += 3; - return(ret); - } - - ptr = ret; - *ptr++ = (char)op; - *ptr++ = '\0'; /* Null "next" pointer. */ - *ptr++ = '\0'; - regcode = ptr; - - return(ret); -} - -/* - - regc - emit (if appropriate) a byte of code - */ -static void -regc(b) -int b; -{ - if (regcode != ®dummy) - *regcode++ = (char)b; - else - regsize++; -} - -/* - - reginsert - insert an operator in front of already-emitted operand - * - * Means relocating the operand. - */ -static void -reginsert(op, opnd) -int op; -char *opnd; -{ - register char *src; - register char *dst; - register char *place; - - if (regcode == ®dummy) { - regsize += 3; - return; - } - - src = regcode; - regcode += 3; - dst = 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); -} - -/* - * regexec and friends - */ - -/* - * Global work variables for regexec(). - */ -static char *reginput; /* String-input pointer. */ -NOTSTATIC char *regbol; /* Beginning of input, for ^ check. */ -static char **regstartp; /* Pointer to startp array. */ -static char **regendp; /* Ditto for endp. */ - -/* - * Forwards. - */ - -NOTSTATIC int regtry(); -STATIC int regmatch(); -STATIC int regrepeat(); - -#ifdef DEBUG -int regnarrate = 0; -void regdump(); -STATIC char *regprop(); -#endif - -#if 0 -/* - - regexec - match a regexp against a string - */ -int -regexec(prog, string, stringlength, matchlength) -register regexp *prog; -register char *string; /* note: CURRENTLY ASSUMED TO BE NULL-TERMINATED!!! */ -int stringlength; /* length of string */ -int *matchlength; /* number of chars matched (or to be skipped) */ - /* set when MATCH or CANT_MATCH */ -{ - register char *s; - extern char *strchr(); - - /* Be paranoid... */ - if (prog == NULL || string == NULL) { - regerror("NULL parameter"); - return(EXP_TCLERROR); - } - - /* Check validity of program. */ - if (UCHARAT(prog->program) != MAGIC) { - regerror("corrupted program"); - return(EXP_KM_ERROR); - } - -#if THIS_RUINS_EXP -/* no need for this shortcut anyway */ - /* 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, prog->regmlen) == 0) - break; /* Found it. */ - s++; - } - if (s == NULL) /* Not present. */ - return(0); - } -#endif - - /* Mark beginning of line for ^ . */ - regbol = string; - - /* Simplest case: anchored match need be tried only once. */ - if (prog->reganch) { - int r = regtry(prog,string,matchlength); - if (r == CANT_MATCH) *matchlength = stringlength; - return(r); - } - - /* Messy cases: unanchored match. */ - s = string; - if (prog->regstart != '\0') { - register char *s2 = s; - - /* We know what char it must start with. */ - while (1) { - int r; - - s2 = strchr(s2,prog->regstart); - if (s2 == 0) { - *matchlength = stringlength; - return(CANT_MATCH); - } - r = regtry(prog,s2,matchlength); - if (r == CANT_MATCH) { - s2++; - continue; - } - if (s2 == s) return(r); - *matchlength = s2-s; - return CANT_MATCH; - } - } else { - /* We don't -- general case. */ - register char *s2 = s; - int r = regtry(prog,s,matchlength); - if (r == EXP_MATCH) return(r); - else if (r == EXP_CANMATCH) return(r); - /* at this point, we know some characters at front */ - /* of string don't match */ - for (s2++;*s2;s2++) { - r = regtry(prog,s2,matchlength); - if (r == CANT_MATCH) continue; - /* if we match or can_match, say cant_match and */ - /* record the number of chars at front that don't match */ - *matchlength = s2-s; - return(CANT_MATCH); - } - /* made it thru string with CANT_MATCH all the way */ - *matchlength = stringlength; - return(CANT_MATCH); - } -} -#endif - -/* - - regtry - try match at specific point - */ -/* return CAN_MATCH, CANT_MATCH or MATCH */ -int /* 0 failure, 1 success */ -regtry(prog, string, matchlength) -regexp *prog; -char *string; -int *matchlength; /* only set for MATCH */ -{ - register int i; - register char **sp; - register char **ep; - int r; /* result of regmatch */ - - reginput = string; - regstartp = prog->startp; - regendp = prog->endp; - - sp = prog->startp; - ep = prog->endp; - for (i = NSUBEXP; i > 0; i--) { - *sp++ = NULL; - *ep++ = NULL; - } - r = regmatch(prog->program + 1); - if (EXP_MATCH == r) { - prog->startp[0] = string; - prog->endp[0] = reginput; - *matchlength = reginput-string; - return(EXP_MATCH); - } - return(r); /* CAN_MATCH or CANT_MATCH */ -} - -/* - - 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. - */ -/* returns CAN, CANT or MATCH */ -static int /* 0 failure, 1 success */ -regmatch(prog) -char *prog; -{ - register char *scan; /* Current node. */ - char *next; /* Next node. */ -#ifndef strchr /* May be #defined to something else */ - extern char *strchr(); -#endif - - 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 (reginput != regbol) -/* return(0);*/ - return(EXP_CANTMATCH); - break; - case EOL: - if (*reginput != '\0') -/* return(0);*/ -/* note this implies that "$" must match everything received to this point! */ - return(EXP_CANTMATCH); - break; - case ANY: - if (*reginput == '\0') -/* return(0);*/ - return(EXP_CANMATCH); - reginput++; - break; - case EXACTLY: { -/* register int len;*/ - register char *opnd; - - opnd = OPERAND(scan); - - /* this section of code is totally rewritten - DEL */ - /* group of literal chars in pattern */ - /* compare each one */ - do { - if (*opnd != *reginput) { - if (*reginput == '\0') { - return EXP_CANMATCH; - } else return EXP_CANTMATCH; - } - - reginput++; - opnd++; - } while (*opnd != '\0'); - } - break; - case ANYOF: -/* if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) == NULL) - return(0); -*/ - if (*reginput == '\0') - return(EXP_CANMATCH); - if (strchr(OPERAND(scan),*reginput) == NULL) - return(EXP_CANTMATCH); - reginput++; - break; - case ANYBUT: -/* if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) != NULL) - return(0); -*/ - if (*reginput == '\0') - return(EXP_CANMATCH); - if (strchr(OPERAND(scan),*reginput) != NULL) - return(EXP_CANTMATCH); - 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; - int r; /* result of regmatch */ - - doOpen: - no = OP(scan) - OPEN; - save = reginput; - - r = regmatch(next); - if (r == EXP_MATCH) { - /* - * Don't set startp if some later - * invocation of the same parentheses - * already has. - */ - if (regstartp[no] == NULL) - regstartp[no] = save; - } - return(r); - } - /* NOTREACHED */ - 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: { - register int no; - register char *save; - int r; /* result of regmatch */ - - doClose: - no = OP(scan) - CLOSE; - save = reginput; - - r = regmatch(next); - if (r == EXP_MATCH) { - /* - * Don't set endp if some later - * invocation of the same parentheses - * already has. - */ - if (regendp[no] == NULL) - regendp[no] = save; - } - return(r); - } - /* NOTREACHED */ - break; - case BRANCH: { - register char *save; - int match_status; - - if (OP(next) != BRANCH) /* No choice. */ - next = OPERAND(scan); /* Avoid recursion. */ - else { - match_status = EXP_CANTMATCH; - - do { - int r; - - save = reginput; - r = regmatch(OPERAND(scan)); - if (r == EXP_MATCH) return(r); - if (r == EXP_CANMATCH) { - match_status = r; - } - reginput = save; - scan = regnext(scan); - } while (scan != NULL && OP(scan) == BRANCH); - return(match_status); - /* NOTREACHED */ - } - } - /* NOTREACHED */ - break; - case STAR: - case PLUS: { - register char nextch; - register int no; - register char *save; - register int min; - int match_status; - - /* - * Lookahead to avoid useless match attempts - * when we know what character comes next. - */ - match_status = EXP_CANTMATCH; - nextch = '\0'; - if (OP(next) == EXACTLY) - nextch = *OPERAND(next); - min = (OP(scan) == STAR) ? 0 : 1; - save = reginput; - no = regrepeat(OPERAND(scan)); - while (no >= min) { - /* If it could work, try it. */ - /* 3rd condition allows for CAN_MATCH */ - 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; - } - /* Couldn't or didn't -- back up. */ - no--; - reginput = save + no; - } - return(match_status); - } - /* NOTREACHED */ - break; - case END: - return(EXP_MATCH); /* Success! */ - /* NOTREACHED */ - break; - default: - if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) { - goto doOpen; - } else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) { - goto doClose; - } - regerror("memory corruption"); - return(EXP_TCLERROR); - /* NOTREACHED */ - break; - } - - scan = next; - } - - /* - * We get here only if there's trouble -- normally "case END" is - * the terminating point. - */ - regerror("corrupted pointers"); - return(EXP_TCLERROR); -} - -/* - - regrepeat - repeatedly match something simple, report how many - */ -static int -regrepeat(p) -char *p; -{ - register int count = 0; - register char *scan; - register char *opnd; -#ifndef strchr /* May be #defined to something else */ -/*DEL*/ extern char *strchr(); -#endif - - scan = 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. */ - regerror("internal foulup"); - count = 0; /* Best compromise. */ - break; - } - 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; - extern char *strchr(); - - - 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 DELETED exp_regexp.h Index: exp_regexp.h ================================================================== --- exp_regexp.h +++ /dev/null @@ -1,8 +0,0 @@ -/* access to regexp internals */ -#define regbol exp_regbol -#define regtry exp_regtry -#define regexec exp_regexec -#define regerror TclRegError -extern char *regbol; -int regtry(); - DELETED exp_rename.h Index: exp_rename.h ================================================================== --- exp_rename.h +++ /dev/null @@ -1,22 +0,0 @@ -/* 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. - -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 DELETED exp_select.c Index: exp_select.c ================================================================== --- exp_select.c +++ /dev/null @@ -1,290 +0,0 @@ -/* exp_select.c - select() 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. - -*/ - -/* suppress file-empty warnings produced by some compilers */ -void exp_unused() {} - -#if 0 /* WHOLE FILE!!!! */ -#include "expect_cf.h" -#include -#include -#include - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#ifdef HAVE_SYS_TIME_H -#include -#endif - -#ifdef HAVE_SYSSELECT_H -# include /* Intel needs this for timeval */ -#endif - -#ifdef HAVE_PTYTRAP -# include -#endif - -#ifdef HAVE_UNISTD_H -# include -#endif - -#ifdef _AIX -/* AIX has some unusual definition of FD_SET */ -#include -#endif - -#if !defined( FD_SET ) && defined( HAVE_SYS_BSDTYPES_H ) - /* like AIX, ISC has it's own definition of FD_SET */ -# include -#endif /* ! FD_SET && HAVE_SYS_BSDTYPES_H */ - -#include "tcl.h" -#include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f defs */ -#include "exp_event.h" - -#ifdef HAVE_SYSCONF_H -#include -#endif - -#ifndef FD_SET -#define FD_SET(fd,fdset) (fdset)->fds_bits[0] |= (1<<(fd)) -#define FD_CLR(fd,fdset) (fdset)->fds_bits[0] &= ~(1<<(fd)) -#define FD_ZERO(fdset) (fdset)->fds_bits[0] = 0 -#define FD_ISSET(fd,fdset) (((fdset)->fds_bits[0]) & (1<<(fd))) -#ifndef AUX2 -typedef struct fd_set { - long fds_bits[1]; - /* any implementation so pathetic as to not define FD_SET will just */ - /* have to suffer with only 32 bits worth of fds */ -} fd_set; -#endif /* AUX2 */ -#endif - -static struct timeval zerotime = {0, 0}; -static struct timeval anytime = {0, 0}; /* can be changed by user */ - -/* returns status, one of EOF, TIMEOUT, ERROR or DATA */ -int -exp_get_next_event(interp,masters, n,master_out,timeout,key) -Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 1st event master, not set if none */ -int timeout; /* seconds */ -int key; -{ - static rr = 0; /* round robin ptr */ - - int i; /* index into in-array */ - struct timeval *t; - - fd_set rdrs; - fd_set excep; -/* FIXME: This is really gross, but the folks at Lynx said their select is - * way hosed and to ignore all exceptions. - */ -#ifdef __Lynx__ -#define EXCEP 0 -#else -#define EXCEP &excep -#endif - - 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 (timeout >= 0) { - t = &anytime; - t->tv_sec = timeout; - } else { - t = NULL; - } - - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); - - /* anything in the environment could have changed */ - return EXP_RECONFIGURE; - } - - FD_ZERO(&rdrs); - FD_ZERO(&excep); - for (i = 0;i < n;i++) { - FD_SET(masters[i],&rdrs); - FD_SET(masters[i],&excep); - } - - /* The reason all fd masks are (seemingly) redundantly cast to */ - /* SELECT_MASK_TYPE is that the HP defines its mask in terms of */ - /* of int * and yet defines FD_SET in terms of fd_set. */ - - if (-1 == select(exp_fd_max+1, - (SELECT_MASK_TYPE *)&rdrs, - (SELECT_MASK_TYPE *)0, - (SELECT_MASK_TYPE *)EXCEP, - t)) { - /* window refreshes trigger EINTR, ignore */ - if (errno == EINTR) goto restart; - else if (errno == EBADF) { - /* someone is rotten */ - for (i=0;i= n) rr = 0; /* ">" catches previous readys that */ - /* used more fds then we're using now */ - - if (FD_ISSET(masters[rr],&rdrs)) { - *master_out = masters[rr]; - return(EXP_DATA_NEW); -/*#ifdef HAVE_PTYTRAP*/ - } else if (FD_ISSET(masters[rr], &excep)) { -#ifndef HAVE_PTYTRAP - *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)); - 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)); - /* presumably, we trapped an open here */ - goto restart; -#endif /* HAVE_PTYTRAP */ - } - } - return(EXP_TIMEOUT); -} - -/*ARGSUSED*/ -int -exp_get_next_event_info(interp,fd,ready_mask) -Tcl_Interp *interp; -int fd; -int ready_mask; -{ - /* this function is only used when running with Tk */ - /* hence, it is merely a stub in this file but to */ - /* pacify lint, return something */ - return 0; -} - -int /* returns TCL_XXX */ -exp_dsleep(interp,sec) -Tcl_Interp *interp; -double sec; -{ - struct timeval t; - - t.tv_sec = sec; - t.tv_usec = (sec - t.tv_sec) * 1000000L; - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return rc; - } - if (-1 == select(1, - (SELECT_MASK_TYPE *)0, - (SELECT_MASK_TYPE *)0, - (SELECT_MASK_TYPE *)0, - &t) - && errno == EINTR) - goto restart; - return TCL_OK; -} - -#if 0 -int /* returns TCL_XXX */ -exp_usleep(interp,usec) -Tcl_Interp *interp; -long usec; /* microseconds */ -{ - struct timeval t; - - t.tv_sec = usec/1000000L; - t.tv_usec = usec%1000000L; - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); - } - if (-1 == select(1, - (SELECT_MASK_TYPE *)0, - (SELECT_MASK_TYPE *)0, - (SELECT_MASK_TYPE *)0, - &t) - && errno == EINTR) - goto restart; - return TCL_OK; -} -#endif /*0*/ - -/* set things up for later calls to event handler */ -void -exp_init_event() -{ -#if 0 -#ifdef _SC_OPEN_MAX - maxfds = sysconf(_SC_OPEN_MAX); -#else - maxfds = getdtablesize(); -#endif -#endif - - exp_event_exit = 0; -} -#endif /* WHOLE FILE !!!! */ DELETED exp_simple.c Index: exp_simple.c ================================================================== --- exp_simple.c +++ /dev/null @@ -1,467 +0,0 @@ -/* - * tclUnixNotify.c -- - * - * This file contains Unix-specific procedures for the notifier, - * which is the lowest-level part of the Tcl event loop. This file - * works together with ../generic/tclNotify.c. - * - * Copyright (c) 1995 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -static char sccsid[] = "@(#) tclUnixNotify.c 1.27 96/01/19 10:30:23"; - -#include "tclInt.h" -#include "tclPort.h" -#include - -/* - * The information below is used to provide read, write, and - * exception masks to select during calls to Tcl_DoOneEvent. - */ - -static fd_mask checkMasks[3*MASK_SIZE]; - /* This array is used to build up the masks - * to be used in the next call to select. - * Bits are set in response to calls to - * Tcl_WatchFile. */ -static fd_mask readyMasks[3*MASK_SIZE]; - /* This array reflects the readable/writable - * conditions that were found to exist by the - * last call to select. */ -static int numFdBits; /* Number of valid bits in checkMasks - * (one more than highest fd for which - * Tcl_WatchFile has been called). */ - -/* - *---------------------------------------------------------------------- - * - * 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. - * - *---------------------------------------------------------------------- - */ - -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, index; - fd_mask bit; - - fd = (int) Tcl_GetFileInfo(file, &type); - - if (type != TCL_UNIX_FD) { - panic("Tcl_WatchFile: unexpected file type"); - } - - if (fd >= FD_SETSIZE) { - panic("Tcl_WatchFile can't handle file id %d", fd); - } - - index = fd/(NBBY*sizeof(fd_mask)); - bit = 1 << (fd%(NBBY*sizeof(fd_mask))); - if (mask & TCL_READABLE) { - checkMasks[index] |= bit; - } - if (mask & TCL_WRITABLE) { - (checkMasks+MASK_SIZE)[index] |= bit; - } - if (mask & TCL_EXCEPTION) { - (checkMasks+2*(MASK_SIZE))[index] |= bit; - } - if (numFdBits <= fd) { - numFdBits = fd+1; - } -} - -/* - *---------------------------------------------------------------------- - * - * 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"); - } - - index = fd/(NBBY*sizeof(fd_mask)); - bit = 1 << (fd%(NBBY*sizeof(fd_mask))); - result = 0; - if ((mask & TCL_READABLE) && (readyMasks[index] & bit)) { - result |= TCL_READABLE; - } - if ((mask & TCL_WRITABLE) && ((readyMasks+MASK_SIZE)[index] & bit)) { - result |= TCL_WRITABLE; - } - if ((mask & TCL_EXCEPTION) && ((readyMasks+(2*MASK_SIZE))[index] & bit)) { - 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: - * None. - * - * 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. - * - *---------------------------------------------------------------------- - */ - -void -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. */ -{ - struct timeval timeout, *timeoutPtr; - int numFound; - - memcpy((VOID *) readyMasks, (VOID *) checkMasks, - 3*MASK_SIZE*sizeof(fd_mask)); - if (timePtr == NULL) { - timeoutPtr = NULL; - } else { - timeoutPtr = &timeout; - timeout.tv_sec = timePtr->sec; - timeout.tv_usec = timePtr->usec; - } - numFound = select(numFdBits, (SELECT_MASK *) &readyMasks[0], - (SELECT_MASK *) &readyMasks[MASK_SIZE], - (SELECT_MASK *) &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 *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); - } - - /* - * Reset the check masks in preparation for the next call to - * select. - */ - - numFdBits = 0; - memset((VOID *) checkMasks, 0, 3*MASK_SIZE*sizeof(fd_mask)); -} - -/* - *---------------------------------------------------------------------- - * - * 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; - } - (void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0, - (SELECT_MASK *) 0, &delay); - TclGetTime(&before); - } -} - - - - - - - -#if 0 /* WHOLE FILE */ - - - -/* interact (with only one process) - give user keyboard control - -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. -*/ - -/* This file exists for deficient versions of UNIX that lack select, -poll, or some other multiplexing hook. Instead, this code uses two -processes per spawned process. One sends characters from the spawnee -to the spawner; a second send chars the other way. - -This will work on any UNIX system. The only sacrifice is that it -doesn't support multiple processes. Eventually, it should catch -SIGCHLD on dead processes and do the right thing. But it is pretty -gruesome to imagine so many processes to do all this. If you change -it successfully, please mail back the changes to me. - Don -*/ - -#include "expect_cf.h" -#include -#include -#include - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#include "tcl.h" -#include "exp_prog.h" -#include "exp_command.h" /* for struct exp_f defs */ -#include "exp_event.h" - -/*ARGSUSED*/ -void -exp_arm_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_disarm_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_disarm_background_filehandler_force(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_unblock_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_block_background_filehandler(m) -int m; -{ -} - -/*ARGSUSED*/ -void -exp_event_disarm(fd) -int fd; -{ -} - -/* returns status, one of EOF, TIMEOUT, ERROR or DATA */ -/*ARGSUSED*/ -int -exp_get_next_event(interp,masters, n,master_out,timeout,key) -Tcl_Interp *interp; -int *masters; -int n; /* # of masters */ -int *master_out; /* 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); -} - -/*ARGSUSED*/ -int -exp_get_next_event_info(interp,fd,ready_mask) -Tcl_Interp *interp; -int fd; -int ready_mask; -{ -} - -/* There is no portable way to do sub-second sleeps on such a system, so */ -/* do the next best thing (without a busy loop) and fake it: sleep the right */ -/* amount of time over the long run. Note that while "subtotal" isn't */ -/* reinitialized, it really doesn't matter for such a gross hack as random */ -/* scheduling pauses will easily introduce occasional one second delays. */ -int /* returns TCL_XXX */ -exp_dsleep(interp,sec) -Tcl_Interp *interp; -double sec; -{ - static double subtotal = 0; - int seconds; - - subtotal += sec; - if (subtotal < 1) return TCL_OK; - seconds = subtotal; - subtotal -= seconds; - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(rc); - } - sleep(seconds); - return TCL_OK; -} - -#if 0 -/* There is no portable way to do sub-second sleeps on such a system, so */ -/* do the next best thing (without a busy loop) and fake it: sleep the right */ -/* amount of time over the long run. Note that while "subtotal" isn't */ -/* reinitialized, it really doesn't matter for such a gross hack as random */ -/* scheduling pauses will easily introduce occasional one second delays. */ -int /* returns TCL_XXX */ -exp_usleep(interp,usec) -Tcl_Interp *interp; -long usec; /* microseconds */ -{ - static subtotal = 0; - int seconds; - - subtotal += usec; - if (subtotal < 1000000) return TCL_OK; - seconds = subtotal/1000000; - subtotal = subtotal%1000000; - restart: - if (Tcl_AsyncReady()) { - int rc = Tcl_AsyncInvoke(interp,TCL_OK); - if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); - } - sleep(seconds); - return TCL_OK; -} -#endif /*0*/ - -/* set things up for later calls to event handler */ -void -exp_init_event() -{ - exp_event_exit = 0; -} - -#endif /* WHOLE FILE! */ DELETED exp_strf.c Index: exp_strf.c ================================================================== --- exp_strf.c +++ /dev/null @@ -1,614 +0,0 @@ -/* exp_strp.c - functions for exp_timestamp */ -/* - * strftime.c - * - * Public-domain implementation of ANSI C library routine. - * - * It's written in old-style C for maximal portability. - * However, since I'm used to prototypes, I've included them too. - * - * If you want stuff in the System V ascftime routine, add the SYSV_EXT define. - * For extensions from SunOS, add SUNOS_EXT. - * For stuff needed to implement the P1003.2 date command, add POSIX2_DATE. - * For VMS dates, add VMS_EXT. - * For complete POSIX semantics, add POSIX_SEMANTICS. - * - * The code for %c, %x, and %X now follows the 1003.2 specification for - * the POSIX locale. - * This version ignores LOCALE information. - * It also doesn't worry about multi-byte characters. - * So there. - * - * This file is also shipped with GAWK (GNU Awk), gawk specific bits of - * code are included if GAWK is defined. - * - * Arnold Robbins - * January, February, March, 1991 - * Updated March, April 1992 - * Updated April, 1993 - * Updated February, 1994 - * Updated May, 1994 - * Updated January 1995 - * Updated September 1995 - * - * Fixes from ado@elsie.nci.nih.gov - * February 1991, May 1992 - * Fixes from Tor Lillqvist tml@tik.vtt.fi - * May, 1993 - * Further fixes from ado@elsie.nci.nih.gov - * February 1994 - * %z code from chip@chinacat.unicom.com - * Applied September 1995 - * - * - * Modified by Don Libes for Expect, 10/93 and 12/95. - * Forced POSIX semantics. - * Replaced inline/min/max stuff with a single range function. - * Removed tzset stuff. - * Commented out tzname stuff. - * - * According to Arnold, the current version of this code can ftp'd from - * ftp.mathcs.emory.edu:/pub/arnold/strftime.shar.gz - * - */ - -#include "expect_cf.h" -#include "tcl.h" - -#include -#include -#include "string.h" - -/* according to Karl Vogel, time.h is insufficient on Pyramid */ -/* following is recommended by autoconf */ - -#ifdef TIME_WITH_SYS_TIME -# include -# include -#else -# ifdef HAVE_SYS_TIME_H -# include -# else -# include -# endif -#endif - - - -#include - -#define SYSV_EXT 1 /* stuff in System V ascftime routine */ -#define POSIX2_DATE 1 /* stuff in Posix 1003.2 date command */ - -#if defined(POSIX2_DATE) && ! defined(SYSV_EXT) -#define SYSV_EXT 1 -#endif - -#if defined(POSIX2_DATE) -#define adddecl(stuff) stuff -#else -#define adddecl(stuff) -#endif - -#ifndef __STDC__ -#define const - -extern char *getenv(); -static int weeknumber(); -adddecl(static int iso8601wknum();) -#else - -extern char *strchr(const char *str, int ch); -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 */ -/* less portable ways */ -#if !defined(HAVE_STRFTIME) -# if defined(HAVE_SV_TIMEZONE) -extern char *tzname[2]; -extern int daylight; -# else -# if defined(HAVE_TIMEZONE) - -char * -zone_name (tp) -struct tm *tp; -{ - char *timezone (); - struct timeval tv; - struct timezone tz; - - gettimeofday (&tv, &tz); - - return timezone (tz.tz_minuteswest, tp->tm_isdst); -} - -# endif /* HAVE_TIMEZONE */ -# endif /* HAVE_SV_TIMEZONE */ -#endif /* HAVE_STRFTIME */ - -static int -range(low,item,hi) -int low, item, hi; -{ - if (item < low) return low; - if (item > hi) return hi; - return item; -} - -/* strftime --- produce formatted time */ - -void -/*size_t*/ -#ifndef __STDC__ -exp_strftime(/*s,*/ format, timeptr, dstring) -/*char *s;*/ -char *format; -const struct tm *timeptr; -Tcl_DString *dstring; -#else -/*exp_strftime(char *s, size_t maxsize, const char *format, const struct tm *timeptr)*/ -exp_strftime(char *format, const struct tm *timeptr,Tcl_DString *dstring) -#endif -{ - int copied; /* used to suppress copying when called recursively */ - -#if 0 - char *endp = s + maxsize; - char *start = s; -#endif - char *percentptr; - - char tbuf[100]; - int i; - - /* various tables, useful in North America */ - static char *days_a[] = { - "Sun", "Mon", "Tue", "Wed", - "Thu", "Fri", "Sat", - }; - static char *days_l[] = { - "Sunday", "Monday", "Tuesday", "Wednesday", - "Thursday", "Friday", "Saturday", - }; - static char *months_a[] = { - "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", - }; - static char *months_l[] = { - "January", "February", "March", "April", - "May", "June", "July", "August", "September", - "October", "November", "December", - }; - static char *ampm[] = { "AM", "PM", }; - -/* for (; *format && s < endp - 1; format++) {*/ - for (; *format ; format++) { - tbuf[0] = '\0'; - copied = 0; /* has not been copied yet */ - percentptr = strchr(format,'%'); - if (percentptr == 0) { - Tcl_DStringAppend(dstring,format,-1); - goto out; - } else if (percentptr != format) { - Tcl_DStringAppend(dstring,format,percentptr - format); - format = percentptr; - } -#if 0 - if (*format != '%') { - *s++ = *format; - continue; - } -#endif - again: - switch (*++format) { - case '\0': - Tcl_DStringAppend(dstring,"%",1); -#if 0 - *s++ = '%'; -#endif - goto out; - - case '%': - Tcl_DStringAppend(dstring,"%",1); - copied = 1; - break; -#if 0 - *s++ = '%'; - continue; -#endif - - case 'a': /* abbreviated weekday name */ - if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6) - strcpy(tbuf, "?"); - else - strcpy(tbuf, days_a[timeptr->tm_wday]); - break; - - case 'A': /* full weekday name */ - if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6) - strcpy(tbuf, "?"); - else - strcpy(tbuf, days_l[timeptr->tm_wday]); - break; - -#ifdef SYSV_EXT - case 'h': /* abbreviated month name */ -#endif - case 'b': /* abbreviated month name */ - if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11) - strcpy(tbuf, "?"); - else - strcpy(tbuf, months_a[timeptr->tm_mon]); - break; - - case 'B': /* full month name */ - if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11) - strcpy(tbuf, "?"); - else - strcpy(tbuf, months_l[timeptr->tm_mon]); - break; - - case 'c': /* appropriate date and time representation */ - sprintf(tbuf, "%s %s %2d %02d:%02d:%02d %d", - days_a[range(0, timeptr->tm_wday, 6)], - months_a[range(0, timeptr->tm_mon, 11)], - range(1, timeptr->tm_mday, 31), - range(0, timeptr->tm_hour, 23), - range(0, timeptr->tm_min, 59), - range(0, timeptr->tm_sec, 61), - timeptr->tm_year + 1900); - break; - - case 'd': /* day of the month, 01 - 31 */ - i = range(1, timeptr->tm_mday, 31); - sprintf(tbuf, "%02d", i); - break; - - case 'H': /* hour, 24-hour clock, 00 - 23 */ - i = range(0, timeptr->tm_hour, 23); - sprintf(tbuf, "%02d", i); - break; - - case 'I': /* hour, 12-hour clock, 01 - 12 */ - i = range(0, timeptr->tm_hour, 23); - if (i == 0) - i = 12; - else if (i > 12) - i -= 12; - sprintf(tbuf, "%02d", i); - break; - - case 'j': /* day of the year, 001 - 366 */ - sprintf(tbuf, "%03d", timeptr->tm_yday + 1); - break; - - case 'm': /* month, 01 - 12 */ - i = range(0, timeptr->tm_mon, 11); - sprintf(tbuf, "%02d", i + 1); - break; - - case 'M': /* minute, 00 - 59 */ - i = range(0, timeptr->tm_min, 59); - sprintf(tbuf, "%02d", i); - break; - - case 'p': /* am or pm based on 12-hour clock */ - i = range(0, timeptr->tm_hour, 23); - if (i < 12) - strcpy(tbuf, ampm[0]); - else - strcpy(tbuf, ampm[1]); - break; - - case 'S': /* second, 00 - 61 */ - i = range(0, timeptr->tm_sec, 61); - sprintf(tbuf, "%02d", i); - break; - - case 'U': /* week of year, Sunday is first day of week */ - sprintf(tbuf, "%02d", weeknumber(timeptr, 0)); - break; - - case 'w': /* weekday, Sunday == 0, 0 - 6 */ - i = range(0, timeptr->tm_wday, 6); - sprintf(tbuf, "%d", i); - break; - - case 'W': /* week of year, Monday is first day of week */ - sprintf(tbuf, "%02d", weeknumber(timeptr, 1)); - break; - - case 'x': /* appropriate date representation */ - sprintf(tbuf, "%s %s %2d %d", - days_a[range(0, timeptr->tm_wday, 6)], - months_a[range(0, timeptr->tm_mon, 11)], - range(1, timeptr->tm_mday, 31), - timeptr->tm_year + 1900); - break; - - case 'X': /* appropriate time representation */ - sprintf(tbuf, "%02d:%02d:%02d", - range(0, timeptr->tm_hour, 23), - range(0, timeptr->tm_min, 59), - range(0, timeptr->tm_sec, 61)); - break; - - case 'y': /* year without a century, 00 - 99 */ - i = timeptr->tm_year % 100; - sprintf(tbuf, "%02d", i); - break; - - case 'Y': /* year with century */ - sprintf(tbuf, "%d", 1900 + timeptr->tm_year); - break; - - case 'Z': /* time zone name or abbrevation */ -#if defined(HAVE_STRFTIME) - strftime(tbuf,sizeof tbuf,"%Z",timeptr); -#else -# if defined(HAVE_SV_TIMEZONE) - i = 0; - if (daylight && timeptr->tm_isdst) - i = 1; - strcpy(tbuf, tzname[i]); -# else - strcpy(tbuf, zone_name (timeptr)); -# if defined(HAVE_TIMEZONE) -# endif /* HAVE_TIMEZONE */ - /* no timezone available */ - /* feel free to add others here */ -# endif /* HAVE_SV_TIMEZONE */ -#endif /* HAVE STRFTIME */ - break; - -#ifdef SYSV_EXT - case 'n': /* same as \n */ - tbuf[0] = '\n'; - tbuf[1] = '\0'; - break; - - case 't': /* same as \t */ - tbuf[0] = '\t'; - tbuf[1] = '\0'; - break; - - case 'D': /* date as %m/%d/%y */ - exp_strftime("%m/%d/%y", timeptr, dstring); - copied = 1; -/* exp_strftime(tbuf, sizeof tbuf, "%m/%d/%y", timeptr);*/ - break; - - case 'e': /* day of month, blank padded */ - sprintf(tbuf, "%2d", range(1, timeptr->tm_mday, 31)); - break; - - case 'r': /* time as %I:%M:%S %p */ - exp_strftime("%I:%M:%S %p", timeptr, dstring); - copied = 1; -/* exp_strftime(tbuf, sizeof tbuf, "%I:%M:%S %p", timeptr);*/ - break; - - case 'R': /* time as %H:%M */ - exp_strftime("%H:%M", timeptr, dstring); - copied = 1; -/* exp_strftime(tbuf, sizeof tbuf, "%H:%M", timeptr);*/ - break; - - case 'T': /* time as %H:%M:%S */ - exp_strftime("%H:%M:%S", timeptr, dstring); - copied = 1; -/* exp_strftime(tbuf, sizeof tbuf, "%H:%M:%S", timeptr);*/ - break; -#endif - -#ifdef POSIX2_DATE - case 'C': - sprintf(tbuf, "%02d", (timeptr->tm_year + 1900) / 100); - break; - - - case 'E': - case 'O': - /* POSIX locale extensions, ignored for now */ - goto again; - case 'V': /* week of year according ISO 8601 */ - sprintf(tbuf, "%02d", iso8601wknum(timeptr)); - break; - - case 'u': - /* ISO 8601: Weekday as a decimal number [1 (Monday) - 7] */ - sprintf(tbuf, "%d", timeptr->tm_wday == 0 ? 7 : - timeptr->tm_wday); - break; -#endif /* POSIX2_DATE */ - default: - tbuf[0] = '%'; - tbuf[1] = *format; - tbuf[2] = '\0'; - break; - } - if (!copied) - Tcl_DStringAppend(dstring,tbuf,-1); -#if 0 - i = strlen(tbuf); - if (i) { - if (s + i < endp - 1) { - strcpy(s, tbuf); - s += i; - } else - return 0; -#endif - } -out:; -#if 0 - if (s < endp && *format == '\0') { - *s = '\0'; - return (s - start); - } else - return 0; -#endif -} - -/* isleap --- is a year a leap year? */ - -#ifndef __STDC__ -static int -isleap(year) -int year; -#else -static int -isleap(int year) -#endif -{ - return ((year % 4 == 0 && year % 100 != 0) || year % 400 == 0); -} - -#ifdef POSIX2_DATE -/* iso8601wknum --- compute week number according to ISO 8601 */ - -#ifndef __STDC__ -static int -iso8601wknum(timeptr) -const struct tm *timeptr; -#else -static int -iso8601wknum(const struct tm *timeptr) -#endif -{ - /* - * From 1003.2: - * If the week (Monday to Sunday) containing January 1 - * has four or more days in the new year, then it is week 1; - * otherwise it is the highest numbered week of the previous - * (52 or 53) year, and the next week is week 1. - * - * ADR: This means if Jan 1 was Monday through Thursday, - * it was week 1, otherwise week 53. - * - * XPG4 erroneously included POSIX.2 rationale text in the - * main body of the standard. Thus it requires week 53. - */ - - int weeknum, jan1day, diff; - - /* get week number, Monday as first day of the week */ - weeknum = weeknumber(timeptr, 1); - - /* - * With thanks and tip of the hatlo to tml@tik.vtt.fi - * - * What day of the week does January 1 fall on? - * We know that - * (timeptr->tm_yday - jan1.tm_yday) MOD 7 == - * (timeptr->tm_wday - jan1.tm_wday) MOD 7 - * and that - * jan1.tm_yday == 0 - * and that - * timeptr->tm_wday MOD 7 == timeptr->tm_wday - * from which it follows that. . . - */ - jan1day = timeptr->tm_wday - (timeptr->tm_yday % 7); - if (jan1day < 0) - jan1day += 7; - - /* - * If Jan 1 was a Monday through Thursday, it was in - * week 1. Otherwise it was last year's highest week, which is - * this year's week 0. - * - * What does that mean? - * If Jan 1 was Monday, the week number is exactly right, it can - * never be 0. - * If it was Tuesday through Thursday, the weeknumber is one - * less than it should be, so we add one. - * Otherwise, Friday, Saturday or Sunday, the week number is - * OK, but if it is 0, it needs to be 52 or 53. - */ - switch (jan1day) { - case 1: /* Monday */ - break; - case 2: /* Tuesday */ - case 3: /* Wednesday */ - case 4: /* Thursday */ - weeknum++; - break; - case 5: /* Friday */ - case 6: /* Saturday */ - case 0: /* Sunday */ - if (weeknum == 0) { -#ifdef USE_BROKEN_XPG4 - /* XPG4 (as of March 1994) says 53 unconditionally */ - weeknum = 53; -#else - /* get week number of last week of last year */ - struct tm dec31ly; /* 12/31 last year */ - dec31ly = *timeptr; - dec31ly.tm_year--; - dec31ly.tm_mon = 11; - dec31ly.tm_mday = 31; - dec31ly.tm_wday = (jan1day == 0) ? 6 : jan1day - 1; - dec31ly.tm_yday = 364 + isleap(dec31ly.tm_year + 1900); - weeknum = iso8601wknum(& dec31ly); -#endif - } - break; - } - - if (timeptr->tm_mon == 11) { - /* - * The last week of the year - * can be in week 1 of next year. - * Sigh. - * - * This can only happen if - * M T W - * 29 30 31 - * 30 31 - * 31 - */ - int wday, mday; - - wday = timeptr->tm_wday; - mday = timeptr->tm_mday; - if ( (wday == 1 && (mday >= 29 && mday <= 31)) - || (wday == 2 && (mday == 30 || mday == 31)) - || (wday == 3 && mday == 31)) - weeknum = 1; - } - - return weeknum; -} -#endif - -/* weeknumber --- figure how many weeks into the year */ - -/* With thanks and tip of the hatlo to ado@elsie.nci.nih.gov */ - -#ifndef __STDC__ -static int -weeknumber(timeptr, firstweekday) -const struct tm *timeptr; -int firstweekday; -#else -static int -weeknumber(const struct tm *timeptr, int firstweekday) -#endif -{ - int wday = timeptr->tm_wday; - int ret; - - if (firstweekday == 1) { - if (wday == 0) /* sunday */ - wday = 6; - else - wday--; - } - ret = ((timeptr->tm_yday + 7 - wday) / 7); - if (ret < 0) - ret = 0; - return ret; -} DELETED exp_trap.c Index: exp_trap.c ================================================================== --- exp_trap.c +++ /dev/null @@ -1,551 +0,0 @@ -/* exp_trap.c - Expect's trap command - -Written by: Don Libes, NIST, 9/1/93 - -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 -#include -#include - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#if defined(SIGCLD) && !defined(SIGCHLD) -#define SIGCHLD SIGCLD -#endif - -#include "tcl.h" - -#include "exp_rename.h" -#include "exp_prog.h" -#include "exp_command.h" -#include "exp_log.h" - -#ifdef TCL_DEBUGGER -#include "tcldbg.h" -#endif - -#define NO_SIG 0 - -static struct trap { - char *action; /* Tcl command to execute upon sig */ - /* Each is handled by the eval_trap_action */ - int mark; /* TRUE if signal has occurred */ - Tcl_Interp *interp; /* interp to use or 0 if we should use the */ - /* interpreter active at the time the sig */ - /* is processed */ - int code; /* return our new code instead of code */ - /* available when signal is processed */ - char *name; /* name of signal */ - int reserved; /* if unavailable for trapping */ -} traps[NSIG]; - -int sigchld_count = 0; /* # of sigchlds caught but not yet processed */ - -static int eval_trap_action(); - -static int got_sig; /* this records the last signal received */ - /* it is only a hint and can be wiped out */ - /* by multiple signals, but it will always */ - /* be left with a valid signal that is */ - /* pending */ - -static Tcl_AsyncHandler async_handler; - -static char * -signal_to_string(sig) -int sig; -{ - if (sig <= 0 || sig > NSIG) return("SIGNAL OUT OF RANGE"); - return(traps[sig].name); -} - -/* current sig being processed by user sig handler */ -static int current_sig = NO_SIG; - -int exp_nostack_dump = FALSE; /* TRUE if user has requested unrolling of */ - /* stack with no trace */ - - - -/*ARGSUSED*/ -static int -tophalf(clientData,interp,code) -ClientData clientData; -Tcl_Interp *interp; -int code; -{ - 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); - - if (got_sig <= 0 || got_sig >= NSIG) { - errorlog("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 */ - current_sig = got_sig; - trap = &traps[current_sig]; - - trap->mark = FALSE; - - /* 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); - } - - 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", - signal_to_string(current_sig),current_sig); - abort(); - } - - if (trap->interp) { - /* if trap requested original interp, use it */ - sig_interp = trap->interp; - } else if (!interp) { - /* else if another interp is available, use it */ - sig_interp = interp; - } else { - /* fall back to exp_interp */ - sig_interp = exp_interp; - } - - rc = eval_trap_action(sig_interp,current_sig,trap,code); - current_sig = NO_SIG; - - /* - * scan for more signals to process - */ - - /* first check for additional SIGCHLDs */ - if (sigchld_count) { - got_sig = SIGCHLD; - traps[SIGCHLD].mark = TRUE; - Tcl_AsyncMark(async_handler); - } else { - got_sig = -1; - for (i=1;i 0 && sig < NSIG) return sig; - } else { - /* try interpreting as a string */ - for (sig=1;sig 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;iresult */ - - exp_debuglog("async event handler: Tcl_Eval(%s)\r\n",trap->action); - - /* 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); - } - - newcode = Tcl_GlobalEval(interp,trap->action); - - /* - * 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); - - /* - * 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))); - } - } 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 (!code_flag) { - /* - * restore values - */ - Tcl_ResetResult(interp); /* turns off Tcl's internal */ - /* flags: ERR_IN_PROGRESS, ERROR_CODE_SET */ - - if (eip) { - Tcl_AddErrorInfo(interp,eip); - Tcl_DStringFree(&ei); - } else { - 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); - } else { - 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)! */ - } - return newcode; -} - -static struct exp_cmd_data -cmd_data[] = { -{"trap", exp_proc(Exp_TrapCmd), (ClientData)EXP_SPAWN_ID_BAD, 0}, -{0}}; - -void -exp_init_trap_cmds(interp) -Tcl_Interp *interp; -{ - exp_create_commands(interp,cmd_data); -} - DELETED exp_tstamp.h Index: exp_tstamp.h ================================================================== --- exp_tstamp.h +++ /dev/null @@ -1,2 +0,0 @@ -EXTERN void exp_timestamp _ANSI_ARGS_((Tcl_Interp *,time_t *, - char *)); DELETED exp_tty.c Index: exp_tty.c ================================================================== --- exp_tty.c +++ /dev/null @@ -1,764 +0,0 @@ -/* exp_tty.c - tty support routines */ - -#include "expect_cf.h" -#include -#include -#include "string.h" - -#ifdef HAVE_SYS_FCNTL_H -# include -#else -# include -#endif - -#include - -#ifdef HAVE_INTTYPES_H -# include -#endif -#include - -#ifdef HAVE_UNISTD_H -# include -#endif - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#if defined(SIGCLD) && !defined(SIGCHLD) -#define SIGCHLD SIGCLD -#endif - -#include "tcl.h" -#include "exp_prog.h" -#include "exp_rename.h" -#include "exp_tty_in.h" -#include "exp_log.h" -#include "exp_command.h" - -static int is_raw = FALSE; -static int is_noecho = FALSE; - -int exp_ioctled_devtty = FALSE; -int exp_stdin_is_tty; -int exp_stdout_is_tty; - -/*static*/ extern exp_tty exp_tty_current, exp_tty_cooked; -#define tty_current exp_tty_current -#define tty_cooked exp_tty_cooked - -int -exp_israw() -{ - return is_raw; -} - -int -exp_isecho() -{ - return !is_noecho; -} - -/* if set == 1, set it to raw, else unset it */ -void -exp_tty_raw(set) -int set; -{ - if (set == 1) { - is_raw = TRUE; -#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO) /* had POSIX too */ - tty_current.c_iflag = 0; - tty_current.c_oflag = 0; - tty_current.c_lflag &= ECHO; /* disable everything but echo */ - tty_current.c_cc[VMIN] = 1; - tty_current.c_cc[VTIME] = 0; - } else { - tty_current.c_iflag = tty_cooked.c_iflag; - tty_current.c_oflag = tty_cooked.c_oflag; -/* tty_current.c_lflag = tty_cooked.c_lflag;*/ -/* attempt 2 tty_current.c_lflag = tty_cooked.c_lflag & ~ECHO;*/ - /* retain current echo setting */ - tty_current.c_lflag = (tty_cooked.c_lflag & ~ECHO) | (tty_current.c_lflag & ECHO); - tty_current.c_cc[VMIN] = tty_cooked.c_cc[VMIN]; - tty_current.c_cc[VTIME] = tty_cooked.c_cc[VTIME]; -#else -# if defined(HAVE_SGTTYB) - tty_current.sg_flags |= RAW; - } else { - tty_current.sg_flags = tty_cooked.sg_flags; -# endif -#endif - is_raw = FALSE; - } -} - -void -exp_tty_echo(set) -int set; -{ - if (set == 1) { - is_noecho = FALSE; -#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO) /* had POSIX too */ - tty_current.c_lflag |= ECHO; - } else { - tty_current.c_lflag &= ~ECHO; -#else - tty_current.sg_flags |= ECHO; - } else { - tty_current.sg_flags &= ~ECHO; -#endif - is_noecho = TRUE; - } -} - -int -exp_tty_set_simple(tty) -exp_tty *tty; -{ -#ifdef HAVE_TCSETATTR - return(tcsetattr(exp_dev_tty, TCSADRAIN,tty)); -#else - return(ioctl (exp_dev_tty, TCSETSW ,tty)); -#endif -} - -int -exp_tty_get_simple(tty) -exp_tty *tty; -{ -#ifdef HAVE_TCSETATTR - return(tcgetattr(exp_dev_tty, tty)); -#else - return(ioctl (exp_dev_tty, TCGETS, tty)); -#endif -} - -/* returns 0 if nothing changed */ -/* if something changed, the out parameters are changed as well */ -int -exp_tty_raw_noecho(interp,tty_old,was_raw,was_echo) -Tcl_Interp *interp; -exp_tty *tty_old; -int *was_raw, *was_echo; -{ - if (exp_disconnected) return(0); - if (is_raw && is_noecho) return(0); - 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); - - 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); - } - - exp_ioctled_devtty = TRUE; - return(1); -} - -/* returns 0 if nothing changed */ -/* if something changed, the out parameters are changed as well */ -int -exp_tty_cooked_echo(interp,tty_old,was_raw,was_echo) -Tcl_Interp *interp; -exp_tty *tty_old; -int *was_raw, *was_echo; -{ - if (exp_disconnected) return(0); - if (!is_raw && !is_noecho) return(0); - 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); - - 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); - } - exp_ioctled_devtty = TRUE; - - return(1); -} - -void -exp_tty_set(interp,tty,raw,echo) -Tcl_Interp *interp; -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); - } - is_raw = raw; - is_noecho = !echo; - tty_current = *tty; - debuglog("tty_set: raw = %d, echo = %d\r\n",is_raw,!is_noecho); - exp_ioctled_devtty = TRUE; -} - -#if 0 -/* avoids scoping problems */ -void -exp_update_cooked_from_current() { - tty_cooked = tty_current; -} - -int -exp_update_real_tty_from_current() { - return(exp_tty_set_simple(&tty_current)); -} - -int -exp_update_current_from_real_tty() { - return(exp_tty_get_simple(&tty_current)); -} -#endif - -void -exp_init_stdio() -{ - exp_stdin_is_tty = isatty(0); - exp_stdout_is_tty = isatty(1); - - setbuf(stdout,(char *)0); /* unbuffer stdout */ -} - -/*ARGSUSED*/ -void -exp_tty_break(interp,fd) -Tcl_Interp *interp; -int fd; -{ -#ifdef POSIX - tcsendbreak(fd,0); -#else -# ifdef TIOCSBRK - ioctl(fd,TIOCSBRK,0); - exp_dsleep(interp,0.25); /* sleep for at least a quarter of a second */ - ioctl(fd,TIOCCBRK,0); -# else - /* dunno how to do this - ignore */ -# endif -#endif -} - -/* take strings with newlines and insert carriage-returns. This allows user */ -/* to write send_user strings without always putting in \r. */ -/* If len == 0, use strlen to compute it */ -/* NB: if terminal is not in raw mode, nothing is done. */ -char * -exp_cook(s,len) -char *s; -int *len; /* current and new length of s */ -{ - static int destlen = 0; - static char *dest = 0; - char *d; /* ptr into dest */ - unsigned int need; - - if (s == 0) return(""); - - if (!is_raw) return(s); - - /* worst case is every character takes 2 to represent */ - need = 1 + 2*(len?*len:strlen(s)); - if (need > destlen) { - if (dest) ckfree(dest); - dest = ckalloc(need); - destlen = need; - } - - for (d = dest;*s;s++) { - if (*s == '\n') { - *d++ = '\r'; - *d++ = '\n'; - } else { - *d++ = *s; - } - } - *d = '\0'; - if (len) *len = d-dest; - return(dest); -} - -/* this stupidity because Tcl needs commands in writable space */ -static char exec_cmd[] = "exec"; -static char stty_cmd[] = "/bin/stty"; - -static int /* returns TCL_whatever */ -exec_stty(interp,argc,argv,devtty) -Tcl_Interp *interp; -int argc; -char **argv; -int devtty; /* if true, redirect to /dev/tty */ -{ - 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; - for (i=1;i/dev/tty"; -#else - "result); - return TCL_OK; - } - } else if (streq(*argv,"columns")) { - if (*(argv+1)) { - exp_win_columns_set(*(argv+1)); - argv++; - no_args = FALSE; - } else { - exp_win_columns_get(interp->result); - return TCL_OK; - } - } else { - saw_unknown_stty_arg = TRUE; - } - } - /* if any unknown args, let real stty try */ - if (saw_unknown_stty_arg || no_args) { - /* let real stty try */ - rc = exec_stty(interp,argc,argv0,1); - - /* find out what weird options user asked for */ - if (exp_tty_get_simple(&tty_current) == -1) { - exp_error(interp,"stty: ioctl(get): %s\r\n",Tcl_PosixError(interp)); - rc = TCL_ERROR; - } - if (cooked) { - /* find out user's new defn of 'cooked' */ - tty_cooked = tty_current; - } - } else if (saw_known_stty_arg) { - if (exp_tty_set_simple(&tty_current) == -1) { - if (exp_disconnected || (exp_dev_tty == -1) || !isatty(exp_dev_tty)) { - errorlog("stty: impossible in this context\n"); - errorlog("are you disconnected or in a batch, at, or cron script?"); - /* user could've conceivably closed /dev/tty as well */ - } - exp_error(interp,"stty: ioctl(user): %s\r\n",Tcl_PosixError(interp)); - rc = TCL_ERROR; - } - } - - /* if no result, make a crude one */ - if (interp->result[0] == '\0') { - sprintf(interp->result,"%sraw %secho", - (was_raw?"":"-"), - (was_echo?"":"-")); - } - } else { - /* a different tty */ - - /* temporarily zap redirect */ - char *redirect_save = *redirect; - *redirect = 0; - - for (argv=argv0+1;*argv;argv++) { - if (streq(*argv,"rows")) { - if (*(argv+1)) { - exp_win2_rows_set(fd,*(argv+1)); - argv++; - no_args = FALSE; - } else { - exp_win2_rows_get(fd,interp->result); - goto done; - } - } else if (streq(*argv,"columns")) { - if (*(argv+1)) { - exp_win2_columns_set(fd,*(argv+1)); - argv++; - no_args = FALSE; - } else { - exp_win2_columns_get(fd,interp->result); - goto done; - } - } else if (streq(*argv,"<")) { - break; - } else { - saw_unknown_stty_arg = TRUE; - break; - } - } - - /* restore redirect */ - *redirect = redirect_save; - - close(fd); /* no more use for this, from now on */ - /* pass by name */ - - if (saw_unknown_stty_arg || no_args) { -#ifdef STTY_READS_STDOUT - /* switch "<" to ">" */ - char original_redirect_char = (*redirect)[0]; - (*redirect)[0] = '>'; - /* stderr unredirected so we can get it directly! */ -#endif - rc = exec_stty(interp,argc,argv0,0); -#ifdef STTY_READS_STDOUT - /* restore redirect - don't know if necessary */ - (*redirect)[0] = original_redirect_char; -#endif - } - } - done: - exp_trap_on(master); - - return rc; -} - -/*ARGSUSED*/ -static int -Exp_SystemCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - int result = TCL_OK; - RETSIGTYPE (*old)(); /* save old sigalarm handler */ -#define MAX_ARGLIST 10240 - int i; - - WAIT_STATUS_TYPE waitStatus; - int systemStatus -; - int abnormalExit = FALSE; - char buf[MAX_ARGLIST]; - char *bufp = buf; - int total_len = 0, arg_len; - - int stty_args_recognized = TRUE; - int cmd_is_stty = FALSE; - int cooked = FALSE; - int was_raw, was_echo; - - if (argc == 1) return TCL_OK; - - if (streq(argv[1],"stty")) { - debuglog("system stty is deprecated, use stty\r\n"); - - cmd_is_stty = TRUE; - was_raw = exp_israw(); - was_echo = exp_isecho(); - } - - if (argc > 2 && cmd_is_stty) { - exp_ioctled_devtty = TRUE; - - for (i=2;iresult,"%sraw %secho", - (was_raw?"":"-"), - (was_echo?"":"-")); - } - return(TCL_OK); - } - } - - for (i = 1;i MAX_ARGLIST) { - exp_error(interp,"args too long (>=%d chars)", - total_len); - return(TCL_ERROR); - } - memcpy(bufp,argv[i],arg_len); - bufp += arg_len; - /* no need to check bounds, we accted for it earlier */ - memcpy(bufp," ",1); - bufp += 1; - } - - *(bufp-1) = '\0'; - old = signal(SIGCHLD, SIG_DFL); - systemStatus = system(buf); - signal(SIGCHLD, old); /* restore signal handler */ - debuglog("system(%s) = %d\r\n",buf,i); - - if (systemStatus == -1) { - exp_error(interp,Tcl_PosixError(interp)); - return TCL_ERROR; - } - *(int *)&waitStatus = systemStatus; - - if (!stty_args_recognized) { - /* find out what weird options user asked for */ -#ifdef HAVE_TCSETATTR - if (tcgetattr(exp_dev_tty, &tty_current) == -1) { -#else - if (ioctl(exp_dev_tty, TCGETS, &tty_current) == -1) { -#endif - errorlog("ioctl(get): %s\r\n",Tcl_PosixError(interp)); - exp_exit(interp,1); - } - if (cooked) { - /* find out user's new defn of 'cooked' */ - tty_cooked = tty_current; - } - } - - if (cmd_is_stty) { - sprintf(interp->result,"%sraw %secho", - (was_raw?"":"-"), - (was_echo?"":"-")); - } - -/* following macros stolen from Tcl's tclUnix.h file */ -/* we can't include the whole thing because it depends on other macros */ -/* that come out of Tcl's Makefile, sigh */ - -#if 0 - -#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 */ - -/* stolen from Tcl. Again, this is embedded in another routine */ -/* (CleanupChildren in tclUnixAZ.c) that we can't use directly. */ - - if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) { - char msg1[20], msg2[20]; - int pid = 0; /* fake a pid, since system() won't tell us */ - - result = TCL_ERROR; - sprintf(msg1, "%d", pid); - if (WIFEXITED(waitStatus)) { - sprintf(msg2, "%d", WEXITSTATUS(waitStatus)); - Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, - (char *) NULL); - abnormalExit = TRUE; - } else if (WIFSIGNALED(waitStatus)) { - char *p; - - p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus))); - Tcl_SetErrorCode(interp, "CHILDKILLED", msg1, - Tcl_SignalId((int) (WTERMSIG(waitStatus))), p, - (char *) NULL); - Tcl_AppendResult(interp, "child killed: ", p, "\n", - (char *) NULL); - } else if (WIFSTOPPED(waitStatus)) { - char *p; - - p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus))); - Tcl_SetErrorCode(interp, "CHILDSUSP", msg1, - Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p, (char *) NULL); - Tcl_AppendResult(interp, "child suspended: ", p, "\n", - (char *) NULL); - } else { - Tcl_AppendResult(interp, - "child wait status didn't make sense\n", - (char *) NULL); - } - } - - if (abnormalExit && (*interp->result == 0)) { - Tcl_AppendResult(interp, "child process exited abnormally", - (char *) NULL); - } - - return result; -} - -static struct exp_cmd_data -cmd_data[] = { -{"stty", exp_proc(Exp_SttyCmd), 0, 0}, -{"system", exp_proc(Exp_SystemCmd), 0, 0}, -{0}}; - -void -exp_init_tty_cmds(interp) -struct Tcl_Interp *interp; -{ - exp_create_commands(interp,cmd_data); -} DELETED exp_tty.h Index: exp_tty.h ================================================================== --- exp_tty.h +++ /dev/null @@ -1,29 +0,0 @@ -/* exp_tty.h - tty support definitions - -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. -*/ - -#ifndef __EXP_TTY_H__ -#define __EXP_TTY_H__ - -#include "expect_cf.h" - -extern int exp_dev_tty; -extern int exp_ioctled_devtty; -extern int exp_stdin_is_tty; -extern int exp_stdout_is_tty; - -void exp_tty_raw(); -void exp_tty_echo(); -void exp_tty_break(); -int exp_tty_raw_noecho(); -int exp_israw(); -int exp_isecho(); - -void exp_tty_set(); -int exp_tty_set_simple(); -int exp_tty_get_simple(); - -#endif /* __EXP_TTY_H__ */ DELETED exp_tty_comm.c Index: exp_tty_comm.c ================================================================== --- exp_tty_comm.c +++ /dev/null @@ -1,36 +0,0 @@ -/* exp_tty_comm.c - tty support routines common to both Expect program - and library */ - -#include "expect_cf.h" -#include - -#include "exp_tty_in.h" -#include "exp_rename.h" -#define EXP_AVOID_INCLUDING_TCL_H -#include "expect_comm.h" -#include "exp_log.h" - -#ifndef TRUE -#define FALSE 0 -#define TRUE 1 -#endif - -int exp_disconnected = FALSE; /* not disc. from controlling tty */ - -/*static*/ exp_tty exp_tty_current, exp_tty_cooked; -#define tty_current exp_tty_current -#define tty_cooked exp_tty_cooked - -void -exp_init_tty() -{ - extern exp_tty exp_tty_original; - - /* save original user tty-setting in 'cooked', just in case user */ - /* asks for it without earlier telling us what cooked means to them */ - tty_cooked = exp_tty_original; - - /* save our current idea of the terminal settings */ - tty_current = exp_tty_original; -} - DELETED exp_tty_in.h Index: exp_tty_in.h ================================================================== --- exp_tty_in.h +++ /dev/null @@ -1,100 +0,0 @@ -/* exp_tty_in.h - internal tty support definitions */ - -/* Definitions for handling termio inclusion are localized here */ -/* This file should be included only if direct access to tty structures are */ -/* required. This file is necessary to avoid mismatch between gcc's and */ -/* vendor's include files */ - -/* Written by Rob Savoye . Mon Feb 22 11:16:53 RMT 1993 */ - -#ifndef __EXP_TTY_IN_H__ -#define __EXP_TTY_IN_H__ - -#include "expect_cf.h" - -#ifdef __MACHTEN__ -#include "sys/types.h" -#endif - -/* - * Set up some macros to isolate tty differences - */ - -/* On some hosts, termio is incomplete (broken) and sgtty is a better -choice. At the same time, termio has some definitions for modern -stuff like window sizes that sgtty lacks - that's why termio.h -is included even when we claim the basic style is sgtty -*/ - -/* test for pyramid may be unnecessary, but only Pyramid people have */ -/* complained - notably pclink@qus102.qld.npb.telecom.com.au (Rick) */ -#if defined(pyr) && defined(HAVE_TERMIO) && defined(HAVE_SGTTYB) -#undef HAVE_SGTTYB -#endif - -/* on ISC SVR3.2, termios is skeletal and termio is a better choice. */ -/* sgttyb must also be avoided because it redefines same things that */ -/* termio does */ -/* note that both SVR3.2 and AIX lacks TCGETS or TCGETA in termios.h */ -/* but SVR3.2 lacks both TCSETATTR and TCGETS/A */ -#if defined(HAVE_TERMIO) && defined(HAVE_TERMIOS) && !defined(HAVE_TCGETS_OR_TCGETA_IN_TERMIOS_H) && !defined(HAVE_TCSETATTR) -# undef HAVE_TERMIOS -# undef HAVE_SGTTYB -#endif - -#if defined(HAVE_TERMIO) && !defined(HAVE_TERMIOS) -# include -# undef POSIX -# define TERMINAL termio -# ifndef TCGETS -# define TCGETS TCGETA -# define TCSETS TCSETA -# define TCSETSW TCSETAW -# define TCSETSF TCSETAF -# endif -#endif - -#if defined(HAVE_SGTTYB) && !defined(HAVE_TERMIOS) -# undef HAVE_TERMIO -# undef POSIX -#ifndef TCGETS -# define TCGETS TIOCGETP -# define TCSETS TIOCSETP -#endif -#ifndef TCSETSW -# define TCSETSW TIOCSETN -#endif -# define TERMINAL sgttyb -# ifdef HAVE_SYS_FCNTL_H -# include -# else -# include -# endif -# include -# include -#endif - - -#if defined(HAVE_TERMIOS) -# undef HAVE_TERMIO -# undef HAVE_SGTTYB -# include -# define TERMINAL termios -# if !defined(TCGETS) || !defined(TCSETS) -# define TCGETS TCGETA -# define TCSETS TCSETA -# define TCSETSW TCSETAW -# define TCSETSF TCSETAF -# endif -#endif - -/* This section was written by: Don Libes, NIST, 2/6/90 */ - -typedef struct TERMINAL exp_tty; -extern exp_tty exp_tty_original; -extern exp_tty exp_tty_current; -extern exp_tty exp_tty_cooked; - -#include "exp_tty.h" - -#endif /* __EXP_TTY_IN_H__ */ DELETED exp_win.c Index: exp_win.c ================================================================== --- exp_win.c +++ /dev/null @@ -1,205 +0,0 @@ -/* exp_win.c - window support - -Written by: Don Libes, NIST, 10/25/93 - -This file is in the public domain. However, the author and NIST -would appreciate credit if you use this file or parts of it. - -*/ - -#include "expect_cf.h" -#include "tcl.h" - -#ifdef NO_STDLIB_H -#include "../compat/stdlib.h" -#else -#include -#endif - -/* _IBCS2 required on some Intel platforms to allow the include files */ -/* to produce a definition for winsize. */ -#define _IBCS2 1 - -/* - * get everyone's window size definitions - * -note that this is tricky because (of course) everyone puts them in -different places. Worse, on some systems, some .h files conflict -and cannot both be included even though both exist. This is the -case, for example, on SunOS 4.1.3 using gcc where termios.h -conflicts with sys/ioctl.h - */ - -#ifdef HAVE_TERMIOS -# include -#else -# include -#endif - -/* Sigh. On AIX 2.3, termios.h exists but does not define TIOCGWINSZ */ -/* Instead, it has to come from ioctl.h. However, As I said above, this */ -/* can't be cavalierly included on all machines, even when it exists. */ -#if defined(HAVE_TERMIOS) && !defined(HAVE_TIOCGWINSZ_IN_TERMIOS_H) -# include -#endif - -/* SCO defines window size structure in PTEM and TIOCGWINSZ in termio.h */ -/* Sigh... */ -#if defined(HAVE_SYS_PTEM_H) -# include /* for stream.h's caddr_t */ -# include /* for ptem.h's mblk_t */ -# include -#endif /* HAVE_SYS_PTEM_H */ - -#include "exp_tty.h" -#include "exp_win.h" - -#ifdef TIOCGWINSZ -typedef struct winsize exp_winsize; -#define columns ws_col -#define rows ws_row -#define EXP_WIN -#endif - -#if !defined(EXP_WIN) && defined(TIOCGSIZE) -typedef struct ttysize exp_winsize; -#define columns ts_cols -#define rows ts_lines -#define EXP_WIN -#endif - -#if !defined(EXP_WIN) -typedef struct { - int columns; - int rows; -} exp_winsize; -#endif - -static exp_winsize winsize = {0, 0}; -static exp_winsize win2size = {0, 0}; - -int exp_window_size_set(fd) -int fd; -{ -#ifdef TIOCSWINSZ - ioctl(fd,TIOCSWINSZ,&winsize); -#endif -#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ) - ioctl(fd,TIOCSSIZE,&winsize); -#endif -} - -int exp_window_size_get(fd) -int fd; -{ -#ifdef TIOCGWINSZ - ioctl(fd,TIOCGWINSZ,&winsize); -#endif -#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ) - ioctl(fd,TIOCGSIZE,&winsize); -#endif -#if !defined(EXP_WIN) - winsize.rows = 0; - winsize.columns = 0; -#endif -} - -void -exp_win_rows_set(rows) -char *rows; -{ - winsize.rows = atoi(rows); - exp_window_size_set(exp_dev_tty); -} - -void -exp_win_rows_get(rows) -char *rows; -{ - exp_window_size_get(exp_dev_tty); - sprintf(rows,"%d",winsize.rows); -} - -void -exp_win_columns_set(columns) -char *columns; -{ - winsize.columns = atoi(columns); - exp_window_size_set(exp_dev_tty); -} - -void -exp_win_columns_get(columns) -char *columns; -{ - exp_window_size_get(exp_dev_tty); - sprintf(columns,"%d",winsize.columns); -} - -/* - * separate copy of everything above - used for handling user stty requests - */ - -int exp_win2_size_set(fd) -int fd; -{ -#ifdef TIOCSWINSZ - ioctl(fd,TIOCSWINSZ,&win2size); -#endif -#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ) - ioctl(fd,TIOCSSIZE,&win2size); -#endif -} - -int exp_win2_size_get(fd) -int fd; -{ -#ifdef TIOCGWINSZ - ioctl(fd,TIOCGWINSZ,&win2size); -#endif -#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ) - ioctl(fd,TIOCGSIZE,&win2size); -#endif -} - -void -exp_win2_rows_set(fd,rows) -int fd; -char *rows; -{ - exp_win2_size_get(fd); - win2size.rows = atoi(rows); - exp_win2_size_set(fd); -} - -void -exp_win2_rows_get(fd,rows) -int fd; -char *rows; -{ - exp_win2_size_get(fd); - sprintf(rows,"%d",win2size.rows); -#if !defined(EXP_WIN) - win2size.rows = 0; - win2size.columns = 0; -#endif -} - -void -exp_win2_columns_set(fd,columns) -int fd; -char *columns; -{ - exp_win2_size_get(fd); - win2size.columns = atoi(columns); - exp_win2_size_set(fd); -} - -void -exp_win2_columns_get(fd,columns) -int fd; -char *columns; -{ - exp_win2_size_get(fd); - sprintf(columns,"%d",win2size.columns); -} DELETED exp_win.h Index: exp_win.h ================================================================== --- exp_win.h +++ /dev/null @@ -1,20 +0,0 @@ -/* exp_win.h - window support - -Written by: Don Libes, NIST, 10/25/93 - -This file is in the public domain. However, the author and NIST -would appreciate credit if you use this file or parts of it. -*/ - -int exp_window_size_set(); -int exp_window_size_get(); - -void exp_win_rows_set(); -void exp_win_rows_get(); -void exp_win_columns_set(); -void exp_win_columns_get(); - -void exp_win2_rows_set(); -void exp_win2_rows_get(); -void exp_win2_columns_set(); -void exp_win2_columns_get(); DELETED expect.c Index: expect.c ================================================================== --- expect.c +++ /dev/null @@ -1,3027 +0,0 @@ -/* expect.c - expect commands - -Written by: Don Libes, NIST, 2/6/90 - -Design and implementation of this program was paid for by U.S. tax -dollars. Therefore it is public domain. However, the author and NIST -would appreciate credit if this program or parts of it are used. - -*/ - -#include -#include -#include -#include -#include /* for isspace */ -#include /* for time(3) */ -#if 0 -#include -#endif - -#include "expect_cf.h" - -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#ifdef HAVE_UNISTD_H -# include -#endif - -#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" -#include "exp_tty.h" -#include "exp_tstamp.h" /* this should disappear when interact */ - /* loses ref's to it */ -#ifdef TCL_DEBUGGER -#include "tcldbg.h" -#endif - -/* initial length of strings that we can guarantee patterns can match */ -int exp_default_match_max = 2000; -#define INIT_EXPECT_TIMEOUT_LIT "10" /* seconds */ -#define INIT_EXPECT_TIMEOUT 10 /* seconds */ -int exp_default_parity = TRUE; -int exp_default_rm_nulls = TRUE; - -/* user variable names */ -#define EXPECT_TIMEOUT "timeout" -#define EXPECT_OUT "expect_out" - -/* 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 */ -#define PAT_EOF 1 -#define PAT_TIMEOUT 2 -#define PAT_DEFAULT 3 -#define PAT_FULLBUFFER 4 -#define PAT_GLOB 5 /* glob-style pattern list */ -#define PAT_RE 6 /* regular expression */ -#define PAT_EXACT 7 /* exact string */ -#define PAT_NULL 8 /* ASCII 0 */ -#define PAT_TYPES 9 /* used to size array of pattern type descriptions */ - int use; /* PAT_XXX */ - int simple_start;/* offset 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]; - -struct exp_cases_descriptor { - int count; - struct ecase **cases; -}; - -/* This describes an Expect command */ -static -struct exp_cmd_descriptor { - int cmdtype; /* bg, before, after */ - int duration; /* permanent or temporary */ - int timeout_specified_by_flag; /* if -timeout flag used */ - int timeout; /* timeout period if flag used */ - struct exp_cases_descriptor ecd; - struct exp_i *i_list; -} exp_cmds[4]; -/* note that exp_cmds[FG] is just a fake, the real contents is stored - in some dynamically-allocated variable. We use exp_cmds[FG] mostly - as a well-known address and also as a convenience and so we allocate - just a few of its fields that we need. */ - -static void -exp_cmd_init(cmd,cmdtype,duration) -struct exp_cmd_descriptor *cmd; -int duration; -int cmdtype; -{ - cmd->duration = duration; - cmd->cmdtype = cmdtype; - cmd->ecd.cases = 0; - cmd->ecd.count = 0; - cmd->i_list = 0; -} - -static int i_read_errno;/* place to save errno, if i_read() == -1, so it - doesn't get overwritten before we get to read it */ -#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(); - -/* 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 */ -} - -/* free up any argv structures in the ecases */ -static void -free_ecases(interp,eg,free_ilist) -Tcl_Interp *interp; -struct exp_cmd_descriptor *eg; -int free_ilist; /* if true, free ilists */ -{ - int i; - - if (!eg->ecd.cases) return; - - for (i=0;iecd.count;i++) { - free_ecase(interp,eg->ecd.cases[i],free_ilist); - } - ckfree((char *)eg->ecd.cases); - - eg->ecd.cases = 0; - eg->ecd.count = 0; -} - - -#if 0 -/* no standard defn for this, and some systems don't even have it, so avoid */ -/* the whole quagmire by calling it something else */ -static char *exp_strdup(s) -char *s; -{ - char *news = ckalloc(strlen(s) + 1); - strcpy(news,s); - return(news); -} -#endif - -/* In many places, there is no need to malloc a copy of a string, since it */ -/* will be freed before we return to Tcl */ -static void -save_str(lhs,rhs,nosave) -char **lhs; /* left hand side */ -char *rhs; /* right hand side */ -int nosave; -{ - if (nosave || (rhs == 0)) { - *lhs = rhs; - } else { - *lhs = ckalloc(strlen(rhs) + 1); - strcpy(*lhs,rhs); - } -} - -/* return TRUE if string appears to be a set of arguments - The intent of this test is to support the ability of commands to have - all their args braced as one. This conflicts with the possibility of - actually intending to have a single argument. - The bad case is in expect which can have a single argument with embedded - \n's although it's rare. Examples that this code should handle: - \n FALSE (pattern) - \n\n FALSE - \n \n \n FALSE - foo FALSE - foo\n FALSE - \nfoo\n TRUE (set of args) - \nfoo\nbar TRUE - - Current test is very cheap and almost always right :-) -*/ -int -exp_one_arg_braced(p) -char *p; -{ - int seen_nl = FALSE; - - for (;*p;p++) { - if (*p == '\n') { - seen_nl = TRUE; - continue; - } - - if (!isspace(*p)) { - return(seen_nl); - } - } - return FALSE; -} - -/* called to execute a command of only one argument - a hack to commands */ -/* to be called with all args surrounded by an outer set of braces */ -/* returns TCL_whatever */ -/*ARGSUSED*/ -int -exp_eval_with_one_arg(clientData,interp,argv) -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]); - - /* - * replace top-level newlines with blanks - */ - - /* 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); -} - -static void -ecase_clear(ec) -struct ecase *ec; -{ - 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 * -ecase_new() -{ - struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase)); - - ecase_clear(ec); - return ec; -} - -/* - -parse_expect_args parses the arguments to expect or its variants. -It normally returns TCL_OK, and returns TCL_ERROR for failure. -(It can't return i_list directly because there is no way to differentiate -between clearing, say, expect_before and signalling an error.) - -eg (expect_global) is initialized to reflect the arguments parsed -eg->ecd.cases is an array of ecases -eg->ecd.count is the # of ecases -eg->i_list is a linked list of exp_i's which represent the -i info - -Each exp_i is chained to the next so that they can be easily free'd if -necessary. Each exp_i has a reference count. If the -i is not used -(e.g., has no following patterns), the ref count will be 0. - -Each ecase points to an exp_i. Several ecases may point to the same exp_i. -Variables named by indirect exp_i's are read for the direct values. - -If called from a foreground expect and no patterns or -i are given, a -default exp_i is forced so that the command "expect" works right. - -The exp_i chain can be broken by the caller if desired. - -*/ - -static int -parse_expect_args(interp,eg,default_spawn_id,argc,argv) -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; - - /* 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); - - 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); -} - -#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 */ -}; - - -/* 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) -Tcl_Interp *interp; -struct ecase *e; -int m; -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; -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); -} - -/* 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) -Tcl_Interp *interp; -struct exp_cmd_descriptor *eg; -int m; -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; -int *last_case; -int status; -int *masters; -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;jecd.count;) { - struct ecase *e = ecmd->ecd.cases[i]; - if (e->i_list == exp_i) { - free_ecase(interp,e,0); - - /* shift remaining elements down */ - /* but only if there are any left */ - if (i+1 != ecmd->ecd.count) { - memcpy(&ecmd->ecd.cases[i], - &ecmd->ecd.cases[i+1], - ((ecmd->ecd.count - i) - 1) * - sizeof(struct exp_cmd_descriptor *)); - } - ecmd->ecd.count--; - if (0 == ecmd->ecd.count) { - ckfree((char *)ecmd->ecd.cases); - ecmd->ecd.cases = 0; - } - } else { - i++; - } - } -} - -/* remove exp_i from list */ -static void -exp_i_remove(interp,ei,exp_i) -Tcl_Interp *interp; -struct exp_i **ei; /* list to remove from */ -struct exp_i *exp_i; /* element to remove */ -{ - /* since it's in middle of list, free exp_i by hand */ - for (;*ei; ei = &(*ei)->next) { - if (*ei == exp_i) { - *ei = exp_i->next; - exp_i->next = 0; - exp_free_i(interp,exp_i,exp_indirect_update2); - break; - } - } -} - -/* remove exp_i from list and remove any dependent ecases */ -static void -exp_i_remove_with_ecases(interp,ecmd,exp_i) -Tcl_Interp *interp; -struct exp_cmd_descriptor *ecmd; -struct exp_i *exp_i; -{ - ecases_remove_by_expi(interp,ecmd,exp_i); - exp_i_remove(interp,&ecmd->i_list,exp_i); -} - -/* remove ecases tied to a single direct spawn id */ -static void -ecmd_remove_fd(interp,ecmd,m,direct) -Tcl_Interp *interp; -struct exp_cmd_descriptor *ecmd; -int m; -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); - - /* force it - explanation in exp_tk.c where this func is defined */ - exp_disarm_background_filehandler_force(m); -} - -/* arm a list of background fd'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++; - } -} - -/* return TRUE if this ecase is used by this fd */ -static int -exp_i_uses_fd(exp_i,fd) -struct exp_i *exp_i; -int fd; -{ - struct exp_fd_list *fdp; - - for (fdp = exp_i->fd_list;fdp;fdp=fdp->next) { - if (fdp->fd == fd) return 1; - } - return 0; -} - -static void -ecase_append(interp,ec) -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"); - 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:""); -} - -/* append all ecases that match this exp_i */ -static void -ecase_by_exp_i_append(interp,ecmd,exp_i) -Tcl_Interp *interp; -struct exp_cmd_descriptor *ecmd; -struct exp_i *exp_i; -{ - int i; - for (i=0;iecd.count;i++) { - if (ecmd->ecd.cases[i]->i_list == exp_i) { - ecase_append(interp,ecmd->ecd.cases[i]); - } - } -} - -static void -exp_i_append(interp,exp_i) -Tcl_Interp *interp; -struct exp_i *exp_i; -{ - Tcl_AppendElement(interp,"-i"); - if (exp_i->direct == EXP_INDIRECT) { - Tcl_AppendElement(interp,exp_i->variable); - } else { - struct exp_fd_list *fdp; - - /* if more than one element, add braces */ - if (exp_i->fd_list->next) - Tcl_AppendResult(interp," {",(char *)0); - - for (fdp = exp_i->fd_list;fdp;fdp=fdp->next) { - char buf[10]; /* big enough for a small int */ - sprintf(buf,"%d",fdp->fd); - Tcl_AppendElement(interp,buf); - } - - if (exp_i->fd_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); -} - -/* 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'; - } -} - - -/* - - 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). - -*/ -/* 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) -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. */ -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); -} - -/* 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) -Tcl_Interp *interp; -struct exp_f *f; -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; -} - -/* map EXP_ style return value to TCL_ style return value */ -/* not defined to work on TCL_OK */ -int -exp_tcl2_returnvalue(x) -int x; -{ - switch (x) { - case TCL_ERROR: return EXP_TCLERROR; - case TCL_RETURN: return EXP_TCLRET; - case TCL_BREAK: return EXP_TCLBRK; - case TCL_CONTINUE: return EXP_TCLCNT; - case EXP_CONTINUE: return EXP_TCLCNTEXP; - case EXP_CONTINUE_TIMER: return EXP_TCLCNTTIMER; - case EXP_TCL_RETURN: return EXP_TCLRETTCL; - } -} - -/* map from EXP_ style return value to TCL_ style return values */ -int -exp_2tcl_returnvalue(x) -int x; -{ - switch (x) { - case EXP_TCLERROR: return TCL_ERROR; - case EXP_TCLRET: return TCL_RETURN; - case EXP_TCLBRK: return TCL_BREAK; - case EXP_TCLCNT: return TCL_CONTINUE; - case EXP_TCLCNTEXP: return EXP_CONTINUE; - case EXP_TCLCNTTIMER: return EXP_CONTINUE_TIMER; - case EXP_TCLRETTCL: return EXP_TCL_RETURN; - } -} - -/* 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. -*/ -char * -exp_get_var(interp,var) -Tcl_Interp *interp; -char *var; -{ - char *val; - - if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */))) - return(val); - return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY)); -} - -static int -get_timeout(interp) -Tcl_Interp *interp; -{ - static int timeout = INIT_EXPECT_TIMEOUT; - char *t; - - if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) { - timeout = atoi(t); - } - return(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) -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; -} - -char * -exp_cmdtype_printable(cmdtype) -int cmdtype; -{ - switch (cmdtype) { - case EXP_CMD_FG: return("expect"); - case EXP_CMD_BG: return("expect_background"); - case EXP_CMD_BEFORE: return("expect_before"); - case EXP_CMD_AFTER: return("expect_after"); - } -#ifdef LINT - return("unknown expect command"); -#endif -} - -/* exp_indirect_update2 is called back via Tcl's trace handler whenever */ -/* an indirect spawn id list is changed */ -/*ARGSUSED*/ -static char * -exp_indirect_update2(clientData, interp, name1, name2, flags) -ClientData clientData; -Tcl_Interp *interp; /* Interpreter containing variable. */ -char *name1; /* Name of variable. */ -char *name2; /* Second part of variable name. */ -int flags; /* Information about what happened. */ -{ - char *msg; - - struct exp_i *exp_i = (struct exp_i *)clientData; - exp_configure_count++; - msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i); - - exp_background_filehandlers_run_all(); - - return msg; -} - -static char * -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 */ - - /* - * disarm any fd'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; - - if (m == EXP_SPAWN_ID_ANY) 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; - - exp_fs[m].bg_ecount--; - if (exp_fs[m].bg_ecount == 0) { - exp_disarm_background_filehandler(m); - exp_fs[m].bg_interp = 0; - } - } - } - - /* - * reread indirect variable - */ - - exp_i_update(interp,exp_i); - - /* - * 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 each spawn id in list, arm if necessary */ - if (ecmd->cmdtype == EXP_CMD_BG) { - fd_list_arm(interp,exp_i->fd_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*/); - } - } -} - -/* this function is called from the background when input arrives */ -/*ARGSUSED*/ -void -exp_background_filehandler(clientData,mask) -ClientData clientData; -int mask; -{ - int m; - - Tcl_Interp *interp; - int cc; /* number of chars 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 */ - /* 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); - } - -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) { - /* 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; - } - - 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; - } - } - finish: - /* fd could have gone away, so check before using */ - if (exp_fs[m].valid) - exp_unblock_background_filehandler(m); -} -#undef out - -/*ARGSUSED*/ -int -Exp_ExpectCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - 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 */ - /* 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; - - 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; - -error: - 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); - } - } - - 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 */ - -/*ARGSUSED*/ -static int -Exp_TimestampCmd(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - char *format = 0; - time_t seconds = -1; - int gmt = FALSE; /* local time by default */ - struct tm *tm; - Tcl_DString dstring; - - argc--; argv++; - - while (*argv) { - if (streq(*argv,"-format")) { - argc--; argv++; - if (!*argv) goto usage_error; - format = *argv; - argc--; argv++; - } else if (streq(*argv,"-seconds")) { - argc--; argv++; - if (!*argv) goto usage_error; - seconds = atoi(*argv); - argc--; argv++; - } else if (streq(*argv,"-gmt")) { - gmt = TRUE; - argc--; argv++; - } else break; - } - - if (argc) goto usage_error; - - if (seconds == -1) { - time(&seconds); - } - - Tcl_DStringInit(&dstring); - - if (format) { - if (gmt) { - tm = gmtime(&seconds); - } else { - tm = localtime(&seconds); - } -/* exp_strftime(interp->result,TCL_RESULT_SIZE,format,tm);*/ - exp_strftime(format,tm,&dstring); - Tcl_DStringResult(interp,&dstring); - } else { - sprintf(interp->result,"%ld",seconds); - } - - return TCL_OK; - usage_error: - 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); -} - -/*ARGSUSED*/ -int -Exp_RemoveNullsCmd(clientData,interp,argc,argv) -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); -} - -/*ARGSUSED*/ -int -Exp_ParityCmd(clientData,interp,argc,argv) -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); -} - -#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; -{ - if (!fdl) return; - printf("%d ",fdl->fd); - exp_fd_print(fdl->next); -} - -void -exp_i_print(exp_i) -struct exp_i *exp_i; -{ - if (!exp_i) return; - printf("exp_i %x",exp_i); - printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect"); - printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp"); - printf(" ecount = %d\n",exp_i->ecount); - printf("variable %s, value %s\n", - ((exp_i->variable)?exp_i->variable:"--"), - ((exp_i->value)?exp_i->value:"--")); - printf("fds: "); - exp_fd_print(exp_i->fd_list); printf("\n"); - exp_i_print(exp_i->next); -} - -void -exp_ecase_print(ecase) -struct ecase *ecase; -{ - printf("pat <%s>\n",ecase->pat); - printf("exp_i = %x\n",ecase->i_list); -} - -void -exp_ecases_print(ecd) -struct exp_cases_descriptor *ecd; -{ - int i; - - printf("%d cases\n",ecd->count); - for (i=0;icount;i++) exp_ecase_print(ecd->cases[i]); -} - -void -exp_cmd_print(ecmd) -struct exp_cmd_descriptor *ecmd; -{ - printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype)); - printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp "); - /* printdict */ - exp_ecases_print(&ecmd->ecd); - exp_i_print(ecmd->i_list); -} - -void -exp_cmds_print() -{ - exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]); - exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]); - exp_cmd_print(&exp_cmds[EXP_CMD_BG]); -} - -/*ARGSUSED*/ -int -cmdX(clientData, interp, argc, argv) -ClientData clientData; -Tcl_Interp *interp; -int argc; -char **argv; -{ - 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; - -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}, -{"match_max", exp_proc(Exp_MatchMaxCmd), 0, 0}, -{"remove_nulls",exp_proc(Exp_RemoveNullsCmd), 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); - - /* preallocate to one element, so future realloc's work */ - exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0; - exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0; - exp_cmds[EXP_CMD_BG ].ecd.cases = 0; - - pattern_style[PAT_EOF] = "eof"; - pattern_style[PAT_TIMEOUT] = "timeout"; - pattern_style[PAT_DEFAULT] = "default"; - pattern_style[PAT_FULLBUFFER] = "full buffer"; - pattern_style[PAT_GLOB] = "glob pattern"; - pattern_style[PAT_RE] = "regular expression"; - pattern_style[PAT_EXACT] = "exact string"; - pattern_style[PAT_NULL] = "null"; - -#if 0 - Tcl_CreateCommand(interp,"x", - cmdX,(ClientData)0,exp_deleteProc); -#endif -} - -void -exp_init_sig() { -#if 0 - signal(SIGALRM,sigalarm_handler); - signal(SIGINT,sigint_handler); -#endif -} DELETED expect.h Index: expect.h ================================================================== --- expect.h +++ /dev/null @@ -1,78 +0,0 @@ -/* expect.h - include file for using the expect library, libexpect.a -from C or C++ (i.e., without Tcl) - -Written by: Don Libes, libes@cme.nist.gov, 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. -*/ - -#ifndef _EXPECT_H -#define _EXPECT_H - -#include "expect_comm.h" - -enum exp_type { - exp_end = 0, /* placeholder - no more cases */ - exp_glob, /* glob-style */ - exp_exact, /* exact string */ - exp_regexp, /* regexp-style, uncompiled */ - exp_compiled, /* regexp-style, compiled */ - exp_null, /* matches binary 0 */ - exp_bogus /* aid in reporting compatibility problems */ -}; - -struct exp_case { /* case for expect command */ - char *pattern; - regexp *re; - enum exp_type type; - int value; /* value to be returned upon match */ -}; - -EXTERN char *exp_buffer; /* buffer of matchable chars */ -EXTERN char *exp_buffer_end; /* one beyond end of matchable chars */ -EXTERN char *exp_match; /* start of matched string */ -EXTERN char *exp_match_end; /* one beyond end of matched string */ -EXTERN int exp_match_max; /* bytes */ -EXTERN int exp_timeout; /* seconds */ -EXTERN int exp_full_buffer; /* if true, return on full buffer */ -EXTERN int exp_remove_nulls; /* if true, remove nulls */ - -EXTERN int exp_pty_timeout; /* see Cray hooks in source */ -EXTERN int exp_pid; /* process-id of spawned process */ -EXTERN int exp_autoallocpty; /* if TRUE, we do allocation */ -EXTERN int exp_pty[2]; /* master is [0], slave is [1] */ -EXTERN char *exp_pty_slave_name; /* name of pty slave device if we */ - /* do allocation */ -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 */ - -EXTERN jmp_buf exp_readenv; /* for interruptable read() */ -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_logfile_all; -EXTERN FILE *exp_debugfile; -EXTERN FILE *exp_logfile; - -EXTERN int exp_disconnect _ANSI_ARGS_((void)); -EXTERN FILE *exp_popen _ANSI_ARGS_((char *command)); -EXTERN void (*exp_child_exec_prelude) _ANSI_ARGS_((void)); - -#ifndef EXP_DEFINE_FNS -EXTERN int exp_spawnl _ANSI_ARGS_(TCL_VARARGS(char *,file)); -EXTERN int exp_expectl _ANSI_ARGS_(TCL_VARARGS(int,fd)); -EXTERN int exp_fexpectl _ANSI_ARGS_(TCL_VARARGS(FILE *,fp)); -#endif - -EXTERN int exp_spawnv _ANSI_ARGS_((char *file, char *argv[])); -EXTERN int exp_expectv _ANSI_ARGS_((int fd, struct exp_case *cases)); -EXTERN int exp_fexpectv _ANSI_ARGS_((FILE *fp, struct exp_case *cases)); - -EXTERN int exp_spawnfd _ANSI_ARGS_((int fd)); - -#endif /* _EXPECT_H */ DELETED expect.man Index: expect.man ================================================================== --- expect.man +++ /dev/null @@ -1,2591 +0,0 @@ -.TH EXPECT 1 "29 December 1994" -.SH NAME -expect \- programmed dialogue with interactive programs, Version 5 -.SH SYNOPSIS -.B expect -[ -.B \-dDinN -] -[ -.B \-c -.I cmds -] -[ -.BR \- [ f | b ] -] -.I cmdfile -] -[ -.I args -] -.SH INTRODUCTION -.B Expect -is a program that "talks" to other interactive programs according to a -script. Following the script, -.B Expect -knows what can be expected from -a program and what the correct response should be. An interpreted -language provides branching and high-level control structures to -direct the dialogue. In addition, the user can take control -and interact directly when desired, afterward returning control to the -script. -.PP -.B Expectk -is a mixture of -.B Expect -and -.BR Tk . -It behaves just like -.B Expect -and -.BR Tk 's -.BR wish . -.B Expect -can also be used directly in C or C++ (that is, without Tcl). -See libexpect(3). -.PP -The name "Expect" comes from the idea of -.I send/expect -sequences popularized -by uucp, kermit and other modem control programs. -However unlike uucp, -.B Expect -is generalized so that it can be run as a user-level command -with any program and task in mind. -.B Expect -can actually talk to several programs at the same time. -.PP -For example, here are some things -.B Expect -can do: -.RS -.TP 4 -\(bu -Cause your computer to dial you back, -so that you can login without paying for the call. -.TP -\(bu -Start a game (e.g., rogue) and if the optimal configuration doesn't appear, -restart it (again and again) until it does, -then hand over control to you. -.TP -\(bu -Run fsck, and in response to its questions, answer "yes", "no" or give control back to you, -based on predetermined criteria. -.TP -\(bu -Connect to another network or BBS (e.g., MCI Mail, CompuServe) and -automatically retrieve your mail so that it appears as if -it was originally sent to your local system. -.TP -\(bu -Carry environment variables, current directory, -or any kind of information across rlogin, telnet, tip, su, chgrp, etc. -.RE -.PP -There are a variety of reasons why the shell cannot perform these tasks. -(Try, you'll see.) -All are possible with -.BR Expect . -.PP -In general, -.B Expect -is useful for running any program which requires -interaction between the program and the user. -All that is necessary is that the interaction can be characterized -programmatically. -.B Expect -can also give the user back control -(without halting the program being controlled) if desired. -Similarly, the user can return control to the script at any time. -.SH USAGE -.B Expect -reads -.I cmdfile -for a list of commands to execute. -.B Expect -may also be invoked implicitly on systems which support the #! notation -by marking the script executable, and making the first line in your script: - - #!/usr/local/bin/expect \-f - -Of course, the path must accurately describe where -.B Expect -lives. /usr/local/bin is just an example. - -The -.B \-c -flag prefaces a command to be executed before any in the script. -The command should be quoted to prevent being broken up by the shell. -This option may be used multiple times. -Multiple commands may be -executed with a single -.B \-c -by separating them with semicolons. -Commands are executed in the order they appear. -(When using Expectk, this option is specified as -.BR \-command .) -.PP -The -.B \-d -flag enables some diagnostic output, which -primarily reports internal activity of commands such as -.B expect -and -.BR interact . -This flag has the same effect as "exp_internal 1" at the beginning of an Expect -script, plus the version of -.B Expect -is printed. -(The -.B strace -command is useful for tracing statements, and the -.B trace -command is useful for tracing variable assignments.) -(When using Expectk, this option is specified as -.BR \-diag .) -.PP -The -.B \-D -flag enables an interactive debugger. An integer value should follow. -The debugger will take control before the next Tcl procedure -if the value is non-zero -or if a ^C is pressed (or a breakpoint is hit, or other appropriate debugger -command appears in the script). See the README file or SEE ALSO (below) -for more information on the debugger. -(When using Expectk, this option is specified as -.BR \-Debug .) -.PP -The -.B \-f -flag prefaces a file from which to read commands from. -The flag itself is optional as it is only useful when using -the #! notation (see above), -so that other arguments may be supplied on the command line. -(When using Expectk, this option is specified as -.BR \-file .) -.PP -By default, the command file is read into memory and executed in its entirety. -It is occasionally desirable to read files one line at a time. For example, -stdin is read this way. In order to force arbitrary files to be handled this -way, use the -.B \-b -flag. -(When using Expectk, this option is specified as -.BR \-buffer .) -.PP -If the string "\-" is supplied as a filename, standard input is read instead. -(Use "./\-" to read from a file actually named "\-".) -.PP -The -.B \-i -flag causes -.B Expect -to interactively prompt for commands instead of reading -them from a file. -Prompting is terminated via the -.B exit -command or upon EOF. -See -.B interpreter -(below) for more information. -.B \-i -is assumed if neither a command file nor -.B \-c -is used. -(When using Expectk, this option is specified as -.BR \-interactive .) -.PP -.B \-\- -may be used to delimit the end of the options. This is useful if -you want to pass an option-like argument to your script without it being -interpreted by -.BR Expect . -This can usefully be placed in the #! line to prevent any flag-like -interpretation by Expect. For example, the following will leave the -original arguments (including the script name) in the variable -.IR argv . - - #!/usr/local/bin/expect \-\- - -Note that the usual getopt(3) and execve(2) conventions must be observed -when adding arguments to the #! line. -.PP -The file $exp_library/expect.rc is sourced automatically if present, unless -the -.B \-N -flag is used. -(When using Expectk, this option is specified as -.BR \-NORC .) -Immediately after this, -the file ~/.expect.rc is sourced automatically, unless the -.B \-n -flag is used. If the environment variable DOTDIR is defined, -it is treated as a directory and .expect.rc is read from there. -(When using Expectk, this option is specified as -.BR \-norc .) -This sourcing occurs only after executing any -.B \-c -flags. -.PP -.B \-v -causes Expect to print its version number and exit. (The corresponding flag -in Expectk, which uses long flag names, is \-version.) -.PP -Optional -.I args -are constructed into a list and stored in the variable named -.IR argv . -.I argc -is initialized to the length of argv. -.PP -.I argv0 -is defined to be the name of the script (or binary if no script is used). -For example, -the following prints out the name of the script and the first three arguments: -.nf - - send_user "$argv0 [lrange $argv 0 2]\\n" - -.fi -.SH COMMANDS -.B Expect -uses -.I Tcl -(Tool Command Language). -Tcl provides control flow (e.g., if, for, break), -expression evaluation and several other features such as recursion, -procedure definition, etc. -Commands used here but not defined (e.g., -.BR set , -.BR if , -.BR exec ) -are Tcl commands (see tcl(3)). -.B Expect -supports additional commands, described below. -Unless otherwise specified, commands return the empty string. -.PP -Commands are listed alphabetically so that they can be quickly located. -However, new users may find it easier to start by reading the descriptions -of -.BR spawn , -.BR send , -.BR expect , -and -.BR interact , -in that order. - -Note that the best introduction to the language (both Expect and Tcl) -is provided in the book "Exploring Expect" (see SEE ALSO below). -Examples are included in this man page but they are very limited since -this man page is meant primarily as reference material. - -Note that in the text of this man page, "Expect" with an uppercase "E" -refers to the -.B Expect -program while "expect" with a lower-case "e" refers to the -.B expect -command within the -.B Expect -program.) -.I -.TP 6 -.BI close " [-slave] [\-onexec 0|1] [\-i spawn_id]" -closes the connection to the current process. -Most interactive programs will detect EOF on their stdin and exit; -thus -.B close -usually suffices to kill the process as well. -The -.B \-i -flag declares the process to close corresponding to the named spawn_id. - -Both -.B expect -and -.B interact -will detect when the current process exits and implicitly do a -.BR close . -But if you kill the process by, say, "exec kill $pid", -you will need to explicitly call -.BR close . - -The -.BR \-onexec -flag determines whether the spawn id will be closed in any new spawned -processes or if the process is overlayed. To leave a spawn id open, -use the value 0. A non-zero integer value will force the spawn closed -(the default) in any new processes. - -The -.B \-slave -flag closes the slave associated with the spawn id. (See "spawn -pty".) -When the connection is closed, the slave is automatically closed as -well if still open. - -No matter whether the connection is closed implicitly or explicitly, -you should call -.B wait -to clear up the corresponding kernel process slot. -.B close -does not call -.B wait -since there is no guarantee that closing a process connection will cause -it to exit. -See -.B wait -below for more info. -.TP -.BI debug " [[-now] 0|1]" -controls a Tcl debugger allowing you to step through statements, set -breakpoints, etc. - -With no arguments, a 1 is returned if the debugger is not running, otherwise -a 0 is returned. - -With a 1 argument, the debugger is started. With a 0 argument, the -debugger is stopped. If a 1 argument is preceded by the -.B \-now -flag, the debugger is started immediately (i.e., in the middle of the -.B debug -command itself). Otherwise, the debugger is started with the next -Tcl statement. - -The -.B debug -command does not change any traps. Compare this to starting Expect with the -.B -D -flag (see above). - -See the README file or SEE ALSO (below) -for more information on the debugger. -.TP -.B disconnect -disconnects a forked process from the terminal. It continues running in the -background. The process is given its own process group (if possible). -Standard I/O is redirected to /dev/null. -.IP -The following fragment uses -.B disconnect -to continue running the script in the background. -.nf - - if [fork]!=0 exit - disconnect - . . . - -.fi -The following script reads a password, and then runs a program -every hour that demands a password each time it is run. The script supplies -the password so that you only have to type it once. -(See the -.B stty -command which demonstrates how to turn off password echoing.) -.nf - - send_user "password?\\ " - expect_user -re "(.*)\\n" - for {} 1 {} { - if [fork]!=0 {sleep 3600;continue} - disconnect - spawn priv_prog - expect Password: - send "$expect_out(1,string)\\r" - . . . - exit - } - -.fi -An advantage to using -.B disconnect -over the shell asynchronous process feature (&) is that -.B Expect -can -save the terminal parameters prior to disconnection, and then later -apply them to new ptys. With &, -.B Expect -does not have a chance -to read the terminal's parameters since the terminal is already -disconnected by the time -.B Expect -receives control. -.TP -.BI exit " [\-opts] [status]" -causes -.B Expect -to exit or otherwise prepare to do so. - -The -.B \-onexit -flag causes the next argument to be used as an exit handler. -Without an argument, the current exit handler is returned. - -The -.B \-noexit -flag causes -.B Expect -to prepare to exit but stop short of actually returning control to the -operating system. The user-defined exit handler is run as well as Expect's -own internal handlers. -No further Expect commands should be executed. -This is useful if you are running Expect with other Tcl extensions. -The current interpreter (and main window if in the Tk environment) remain -so that other Tcl extensions can clean up. If Expect's -.B exit -is called again (however this might occur), the handlers are not rerun. - -Upon exiting, -all connections to spawned processes are closed. Closure will be detected -as an EOF by spawned processes. -.B exit -takes no other actions beyond what the normal _exit(2) procedure does. -Thus, spawned processes that do not check for EOF may continue to run. -(A variety of conditions are important to determining, for example, what -signals a spawned process will be sent, but these are system-dependent, -typically documented under exit(3).) -Spawned processes that continue to run will be inherited by init. - -.I status -(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 -The command -.B exp_continue -allows -.B expect -itself to continue -executing rather than returning as it normally would. -(See -.B expect -for more information.) -.TP -.BI exp_internal " [\-f file] value" -causes further commands to send diagnostic information internal to -.B Expect -to stderr if -.I value -is non-zero. This output is disabled if -.I value -is 0. The diagnostic information includes every character received, -and every attempt made to match the current output against the patterns. -.IP -If the optional -.I file -is supplied, all normal and debugging output is written to that file -(regardless of the value of -.IR value ). -Any previous diagnostic output file is closed. - -The -.B \-info -flag causes exp_internal to return a description of the -most recent non-info arguments given. -.TP -.BI exp_open " [args] [\-i spawn_id]" -returns a Tcl file identifier that corresponds to the original spawn id. -The file identifier can then be used as if it were opened by Tcl's -.B open -command. (The spawn id should no longer be used. A -.B wait -should not be executed. - -The -.B \-leaveopen -flag leaves the spawn id open for access through -Expect commands. A -.B wait -must be executed on the spawn id. -.TP -.BI exp_pid " [\-i spawn_id]" -returns the process id corresponding to the currently spawned process. -If the -.B \-i -flag is used, the pid returned corresponds to that of the given spawn id. -.TP -.B exp_send -is an alias for -.BR send . -.TP -.B exp_send_error -is an alias for -.BR send_error . -.TP -.B exp_send_log -is an alias for -.BR send_log . -.TP -.B exp_send_tty -is an alias for -.BR send_tty . -.TP -.B exp_send_user -is an alias for -.BR send_user . -.TP -.BI exp_version " [[\-exit] version]" -is useful for assuring that the script is compatible with the current -version of Expect. -.IP -With no arguments, the current version of -.B Expect -is returned. This version -may then be encoded in your script. If you actually know that you are not -using features of recent versions, you can specify an earlier version. -.IP -Versions consist of three numbers separated by dots. First -is the major number. Scripts written for versions of -.B Expect -with a -different major number will almost certainly not work. -.B exp_version -returns an error if the major numbers do not match. -.IP -Second is the minor number. Scripts written for a version with a -greater minor number than the current version -may depend upon some new feature and might not run. -.B exp_version -returns an error if the major numbers match, but the script minor number -is greater than that of the running -.BR Expect . -.IP -Third is a number that plays no part in the version comparison. -However, it is incremented when the -.B Expect -software -distribution is changed in any way, such as by additional documentation -or optimization. It is reset to 0 upon each new minor version. -.IP -With the -.B \-exit -flag, -.B Expect -prints an error and exits if the version is out of date. -.TP -.BI expect " [[\-opts] pat1 body1] ... [\-opts] patn [bodyn]" -waits until one of the patterns matches the output of a spawned process, -a specified time period has passed, or an end-of-file is seen. -If the final body is empty, it may be omitted. -.IP -Patterns from the most recent -.B expect_before -command are implicitly used before any other patterns. -Patterns from the most recent -.B expect_after -command are implicitly used after any other patterns. -.IP -If the arguments to the entire -.B expect -statement require more than one line, -all the arguments may be "braced" into one so as to avoid terminating each -line with a backslash. In this one case, the usual Tcl substitutions will -occur despite the braces. -.IP -If a pattern is the keyword -.BR eof , -the corresponding body is executed upon end-of-file. -If a pattern is the keyword -.BR timeout , -the corresponding body is executed upon timeout. If no timeout keyword -is used, an implicit null action is executed upon timeout. -The default timeout period is 10 seconds but may be set, for example to 30, -by the command "set timeout 30". An infinite timeout may be designated -by the value \-1. -If a pattern is the keyword -.BR default , -the corresponding body is executed upon either timeout or end-of-file. -.IP -If a pattern matches, then the corresponding body is executed. -.B expect -returns the result of the body (or the empty string if no pattern matched). -In the event that multiple patterns match, the one appearing first is -used to select a body. -.IP -Each time new output arrives, it is compared to each pattern in the order -they are listed. Thus, you may test for absence of a match by making -the last pattern something guaranteed to appear, such as a prompt. -In situations where there is no prompt, you must use -.B timeout -(just like you would if you were interacting manually). -.IP -Patterns are specified in three ways. By default, -patterns are specified as with Tcl's -.B string match -command. (Such patterns are also similar to C-shell regular expressions -usually referred to as "glob" patterns). The -.B \-gl -flag may may -be used to protect patterns that might otherwise match -.B expect -flags from doing so. -Any pattern beginning with a "-" should be protected this way. (All strings -starting with "-" are reserved for future options.) - -.IP -For example, the following fragment looks for a successful login. -(Note that -.B abort -is presumed to be a procedure defined elsewhere in the script.) -.nf - -.ta \w' expect 'u +\w'invalid password 'u - expect { - busy {puts busy\\n ; exp_continue} - failed abort - "invalid password" abort - timeout abort - connected - } - -.fi -Quotes are necessary on the fourth pattern since it contains a space, which -would otherwise separate the pattern from the action. -Patterns with the same action (such as the 3rd and 4th) require listing the -actions again. This can be avoid by using regexp-style patterns (see below). -More information on forming glob-style patterns can be found in the Tcl manual. -.IP -Regexp-style patterns follow the syntax defined by Tcl's -.B regexp -(short for "regular expression") command. -regexp patterns are introduced with the flag -.BR \-re . -The previous example can be rewritten using a regexp as: -.nf - -.ta \w' expect 'u +\w'connected 'u - expect { - busy {puts busy\\n ; exp_continue} - \-re "failed|invalid password" abort - timeout abort - connected - } - -.fi -Both types of patterns are "unanchored". This means that patterns -do not have to match the entire string, but can begin and end the -match anywhere in the string (as long as everything else matches). -Use ^ to match the beginning of a string, and $ to match the end. -Note that if you do not wait for the end of a string, your responses -can easily end up in the middle of the string as they are echoed from -the spawned process. While still producing correct results, the output -can look unnatural. Thus, use of $ is encouraged if you can exactly -describe the characters at the end of a string. - -Note that in many editors, the ^ and $ match the beginning and end of -lines respectively. However, because expect is not line oriented, -these characters match the beginning and end of the data (as opposed -to lines) currently in the expect matching buffer. (Also, see the -note below on "system indigestion.") - -The -.B \-ex -flag causes the pattern to be matched as an "exact" string. No -interpretation of *, ^, etc is made (although the usual Tcl -conventions must still be observed). -Exact patterns are always unanchored. - -.IP -The -.B \-nocase -flag causes uppercase characters of the output to compare as if they were -lowercase characters. The pattern is not affected. -.IP -While reading output, -more than 2000 bytes can force earlier bytes to be "forgotten". -This may be changed with the function -.BR match_max . -(Note that excessively large values can slow down the pattern matcher.) -If -.I patlist -is -.BR full_buffer , -the corresponding body is executed if -.I match_max -bytes have been received and no other patterns have matched. -Whether or not the -.B full_buffer -keyword is used, the forgotten characters are written to -expect_out(buffer). - -If -.I patlist -is the keyword -.BR null , -and nulls are allowed (via the -.B remove_nulls -command), the corresponding body is executed if a single ASCII -0 is matched. -It is not possible to -match 0 bytes via glob or regexp patterns. - -Upon matching a pattern (or eof or full_buffer), -any matching and previously unmatched output is saved in the variable -.IR expect_out(buffer) . -Up to 9 regexp substring matches are saved in the variables -.I expect_out(1,string) -through -.IR expect_out(9,string) . -If the -.B -indices -flag is used before a pattern, -the starting and ending indices (in a form suitable for -.BR lrange ) -of the -10 strings are stored in the variables -.I expect_out(X,start) -and -.I expect_out(X,end) -where X is a digit, corresponds to the substring position in the buffer. -0 refers to strings which matched the entire pattern -and is generated for glob patterns as well as regexp patterns. -For example, if a process has produced output of "abcdefgh\\n", the result of: -.nf - - expect "cd" - -.fi -is as if the following statements had executed: -.nf - - set expect_out(0,string) cd - set expect_out(buffer) abcd - -.fi -and "efgh\\n" is left in the output buffer. -If a process produced the output "abbbcabkkkka\\n", the result of: -.nf - - expect \-indices \-re "b(b*).*(k+)" - -.fi -is as if the following statements had executed: -.nf - - set expect_out(0,start) 1 - set expect_out(0,end) 10 - set expect_out(0,string) bbbcabkkkk - set expect_out(1,start) 2 - set expect_out(1,end) 3 - set expect_out(1,string) bb - set expect_out(2,start) 10 - set expect_out(2,end) 10 - set expect_out(2,string) k - set expect_out(buffer) abbbcabkkkk - -.fi -and "a\\n" is left in the output buffer. The pattern "*" (and -re ".*") will -flush the output buffer without reading any more output from the -process. -.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). - -The spawn id associated with the matching output (or eof or -full_buffer) is stored in -.IR expect_out(spawn_id) . - -The -.B \-timeout -flag causes the current expect command to use the following value -as a timeout instead of using the value of the timeout variable. - -By default, -patterns are matched against output from the current process, however the -.B \-i -flag declares the output from the named spawn_id list be matched against -any following patterns (up to the next -.BR \-i ). -The spawn_id list should either be a whitespace separated list of spawn_ids -or a variable referring to such a list of spawn_ids. - -For example, the following example waits for -"connected" from the current process, or "busy", "failed" or "invalid -password" from the spawn_id named by $proc2. -.nf - - expect { - \-i $proc2 busy {puts busy\\n ; exp_continue} - \-re "failed|invalid password" abort - timeout abort - connected - } - -.fi -The value of the global variable -.I any_spawn_id -may be used to match patterns to any spawn_ids that are named -with all other -.B \-i -flags in the current -.B expect -command. -The spawn_id from a -.B \-i -flag with no associated pattern (i.e., followed immediately -by another -.BR \-i ) -is made available to any other patterns -in the same -.B expect -command associated with -.I any_spawn_id. - -The -.B \-i -flag may also name a global variable in which case the variable is read -for a list of spawn ids. The variable is reread whenever it changes. -This provides a way of changing the I/O source while the command is in -execution. Spawn ids provided this way are called "indirect" spawn ids. - -Actions such as -.B break -and -.B continue -cause control structures (i.e., -.BR for , -.BR proc ) -to behave in the usual way. -The command -.B exp_continue -allows -.B expect -itself to continue -executing rather than returning as it normally would. -.IP -This is useful for avoiding explicit loops or repeated expect statements. -The following example is part of a fragment to automate rlogin. The -.B exp_continue -avoids having to write a second -.B expect -statement (to look for the prompt again) if the rlogin prompts for a password. -.nf - - expect { - Password: { - stty -echo - send_user "password (for $user) on $host: " - expect_user -re "(.*)\\n" - send_user "\\n" - send "$expect_out(1,string)\\r" - stty echo - exp_continue - } incorrect { - send_user "invalid password or account\\n" - exit - } timeout { - send_user "connection to $host timed out\\n" - exit - } eof { - send_user \\ - "connection to host failed: $expect_out(buffer)" - exit - } -re $prompt - } - -.fi -For example, the following fragment might help a user guide -an interaction that is already totally automated. In this case, the terminal -is put into raw mode. If the user presses "+", a variable is incremented. -If "p" is pressed, several returns are sent to the process, -perhaps to poke it in some way, and "i" lets the user interact with the -process, effectively stealing away control from the script. -In each case, the -.B exp_continue -allows the current -.B expect -to continue pattern matching after executing the -current action. -.nf - - stty raw \-echo - expect_after { - \-i $user_spawn_id - "p" {send "\\r\\r\\r"; exp_continue} - "+" {incr foo; exp_continue} - "i" {interact; exp_continue} - "quit" exit - } - -.fi -.IP -By default, -.B exp_continue -resets the timeout timer. The timer is not restarted, if -.B exp_continue -is called with the -.B \-continue_timer -flag. -.TP -.BI expect_after " [expect_args]" -works identically to the -.B expect_before -except that if patterns from both -.B expect -and -.B expect_after -can match, the -.B expect -pattern is used. See the -.B expect_before -command for more information. -.TP -.BI expect_background " [expect_args]" -takes the same arguments as -.BR expect , -however it returns immediately. -Patterns are tested whenever new input arrives. -The pattern -.B timeout -and -.B default -are meaningless to -.BR expect_background -and are silently discarded. -Otherwise, the -.B expect_background -command uses -.B expect_before -and -.B expect_after -patterns just like -.B expect -does. - -When -.B expect_background -actions are being evaluated, background processing for the same -spawn id is blocked. Background processing is unblocked when -the action completes. While background processing is blocked, -it is possible to do a (foreground) -.B expect -on the same spawn id. - -It is not possible to execute an -.B expect -while an -.B expect_background -is unblocked. -.B expect_background -for a particular spawn id is deleted by -declaring a new expect_background with the same spawn id. Declaring -.B expect_background -with no pattern removes the given spawn id -from the ability to match patterns in the background. -.TP -.BI expect_before " [expect_args]" -takes the same arguments as -.BR expect , -however it returns immediately. -Pattern-action pairs from the most recent -.B expect_before -with the same spawn id are implicitly added to any following -.B expect -commands. If a pattern matches, it is treated as if it had been -specified in the -.B expect -command itself, and the associated body is executed in the context -of the -.B expect -command. -If patterns from both -.B expect_before -and -.B expect -can match, the -.B expect_before -pattern is used. - -If no pattern is specified, the spawn id is not checked for any patterns. - -Unless overridden by a -.B \-i -flag, -.B expect_before -patterns match against the spawn id defined at the time that the -.B expect_before -command was executed (not when its pattern is matched). - -The \-info flag causes -.B expect_before -to return the current specifications of what patterns it will match. -By default, it reports on the current spawn id. An optional spawn id specification may be given for information on that spawn id. For example -.nf - - expect_before -info -i $proc - -.fi -At most one spawn id specification may be given. The flag \-indirect -suppresses direct spawn ids that come only from indirect specifications. - -Instead of a spawn id specification, the flag "-all" will cause -"-info" to report on all spawn ids. - -The output of the \-info flag can be reused as the argument to expect_before. -.TP -.BI expect_tty " [expect_args]" -is like -.B expect -but it reads characters from /dev/tty (i.e. keystrokes from the user). -By default, reading is performed in cooked mode. -Thus, lines must end with a return in order for -.B expect -to see them. -This may be changed via -.B stty -(see the -.B stty -command below). -.TP -.BI expect_user " [expect_args]" -is like -.B expect -but it reads characters from stdin (i.e. keystrokes from the user). -By default, reading is performed in cooked mode. -Thus, lines must end with a return in order for -.B expect -to see them. -This may be changed via -.B stty -(see the -.B stty -command below). -.TP -.B fork -creates a new process. The new process is an exact copy of the current -.B Expect -process. On success, -.B fork -returns 0 to the new (child) process and returns the process ID of the child -process to the parent process. -On failure (invariably due to lack of resources, e.g., swap space, memory), -.B fork -returns \-1 to the parent process, and no child process is created. -.IP -Forked processes exit via the -.B exit -command, just like the original process. -Forked processes are allowed to write to the log files. If you do not -disable debugging or logging in most of the processes, the result can be -confusing. -.IP -Some pty implementations may be confused by multiple readers and writers, -even momentarily. Thus, it is safest to -.B fork -before spawning processes. -.TP -.BI interact " [string1 body1] ... [stringn [bodyn]]" -gives control of the current process to the user, so that -keystrokes are sent to the current process, -and the stdout and stderr of the current process are returned. -.IP -String-body pairs may be specified as arguments, in which case the -body is executed when the corresponding string is entered. (By default, the -string is not sent to the current process.) The -.B interpreter -command is assumed, if the final body is missing. -.IP -If the arguments to the entire -.B interact -statement require more than one line, -all the arguments may be "braced" into one so as to avoid terminating each -line with a backslash. In this one case, the usual Tcl substitutions will -occur despite the braces. -.IP -For example, the following command runs interact with the following -string-body pairs defined: When ^Z is pressed, -.B Expect -is suspended. -(The -.B \-reset -flag restores the terminal modes.) -When ^A is pressed, the user sees "you typed a control-A" and the -process is sent a ^A. When $ is pressed, the user sees the date. -When ^C is pressed, -.B Expect -exits. If "foo" is entered, the user sees "bar". -When ~~ is pressed, the -.B Expect -interpreter runs interactively. -.nf - -.ta \w' interact 'u +\w'$CTRLZ 'u +\w'{'u - set CTRLZ \\032 - interact { - -reset $CTRLZ {exec kill \-STOP [pid]} - \\001 {send_user "you typed a control\-A\\n"; - send "\\001" - } - $ {send_user "The date is [exec date]."} - \\003 exit - foo {send_user "bar"} - ~~ - } - -.fi -.IP -In string-body pairs, strings are matched in the order they are listed -as arguments. Strings that partially match are not sent to the -current process in anticipation of the remainder coming. If -characters are then entered such that there can no longer possibly be -a match, only the part of the string will be sent to the process that cannot -possibly begin another match. Thus, strings that are substrings of -partial matches can match later, if the original strings that was attempting -to be match ultimately fails. -.IP -By default, string matching is exact with no wild cards. (In contrast, -the -.B expect -command uses glob-style patterns by default.) The -.B \-ex -flag may be used to protect patterns that might otherwise match -.B interact -flags from doing so. -Any pattern beginning with a "-" should be protected this way. (All strings -starting with "-" are reserved for future options.) - -The -.B \-re -flag forces the string to be interpreted as a regexp-style pattern. In this -case, matching substrings are stored in the variable -.I interact_out -similarly to the way -.B expect -stores its output in the variable -.BR expect_out . -The -.B \-indices -flag is similarly supported. - -The pattern -.B eof -introduces an action that is -executed upon end-of-file. A separate -.B eof -pattern may also follow the -.B \-output -flag in which case it is matched if an eof is detected while writing output. -The default -.B eof -action is "return", so that -.B interact -simply returns upon any EOF. - -The pattern -.B timeout -introduces a timeout (in seconds) and action that is executed -after no characters have been read for a given time. -The -.B timeout -pattern applies to the most recently specified process. -There is no default timeout. -The special variable "timeout" (used by the -.B expect -command) has no affect on this timeout. - -For example, the following statement could be used to autologout users who have -not typed anything for an hour but who still get frequent system -messages: -.nf - - interact -input $user_spawn_id timeout 3600 return -output \\ - $spawn_id - -.fi - -If the pattern is the keyword -.BR null , -and nulls are allowed (via the -.B remove_nulls -command), the corresponding body is executed if a single ASCII -0 is matched. -It is not possible to -match 0 bytes via glob or regexp patterns. - -Prefacing a pattern with the flag -.B \-iwrite -causes the variable -.I interact_out(spawn_id) -to be set to the spawn_id which matched the pattern -(or eof). - -Actions such as -.B break -and -.B continue -cause control structures (i.e., -.BR for , -.BR proc ) -to behave in the usual way. -However -.B return -causes interact to return to its caller, while -.B inter_return -causes -.B interact -to cause a return in its caller. For example, if "proc foo" called -.B interact -which then executed the action -.BR inter_return , -.B proc foo -would return. (This means that if -.B interact -calls -.B interpreter -interactively typing -.B return -will cause the interact to continue, while -.B inter_return -will cause the interact to return to its caller.) -.IP -During -.BR interact , -raw mode is used so that all characters may be passed to the current process. -If the current process does not catch job control signals, -it will stop if sent a stop signal (by default ^Z). -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. -.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 -For speed, actions execute in raw mode by default. The -.B \-reset -flag resets the terminal to the mode it had before -.B interact -was executed (invariably, cooked mode). -Note that characters entered when the mode is being switched may be lost -(an unfortunate feature of the terminal driver on some systems). -The only reason to use -.B \-reset -is if your action -depends on running in cooked mode. -.IP -The -.B \-echo -flag sends characters that match the following pattern back to the process -that generated them as each character is read. This may be useful -when the user needs to see feedback from partially typed patterns. -.IP -If a pattern is being echoed but eventually fails to match, -the characters are sent to the spawned process. If the spawned -process then echoes them, the user will see the characters twice. -.B \-echo -is probably only appropriate in situations where the user is -unlikely to not complete the pattern. For example, the following -excerpt is from rftp, the recursive-ftp script, where the user is -prompted to enter ~g, ~p, or ~l, to get, put, or list the current -directory recursively. These are so far away from the normal ftp -commands, that the user is unlikely to type ~ followed by anything -else, except mistakenly, in which case, they'll probably just ignore -the result anyway. -.nf - - interact { - -echo ~g {getcurdirectory 1} - -echo ~l {getcurdirectory 0} - -echo ~p {putcurdirectory} - } - -.fi -The -.B \-nobuffer -flag sends characters that match the following pattern on to -the output process as characters are read. - -This is useful when you wish to let a program echo back the pattern. -For example, the following might be used to monitor where a person is -dialing (a Hayes-style modem). Each time "atd" is seen the script -logs the rest of the line. -.nf - - proc lognumber {} { - interact -nobuffer -re "(.*)\\r" return - puts $log "[exec date]: dialed $interact_out(1,string)" - } - - interact -nobuffer "atd" lognumber - -.fi -.IP -During -.BR interact , -previous use of -.B log_user -is ignored. In particular, -.B interact -will force its output to be logged (sent to the standard output) -since it is presumed the user doesn't wish to interact blindly. -.IP -The -.B \-o -flag causes any following key-body pairs to be applied to the output of -the current process. -This can be useful, for example, when dealing with hosts that -send unwanted characters during a telnet session. -.IP -By default, -.B interact -expects the user to be writing stdin and reading stdout of the -.B Expect -process -itself. -The -.B \-u -flag (for "user") makes -.B interact -look for the user as the process named by its argument -(which must be a spawned id). -.IP -This allows two unrelated processes to be joined -together without using an explicit loop. To aid in debugging, Expect -diagnostics always go to stderr (or stdout for certain logging and -debugging information). For the same reason, the -.B interpreter -command will read interactively from stdin. -.IP -For example, the following fragment creates a login process. -Then it dials the user (not shown), and finally connects the two together. -Of course, any process may be substituted for login. -A shell, for example, would allow the user to work without supplying an -account and password. -.nf - - spawn login - set login $spawn_id - spawn tip modem - # dial back out to user - # connect user to login - interact \-u $login - -.fi -To send output to multiple processes, list each spawn id list prefaced by a -.B \-output -flag. Input for a group of output spawn ids may be determined -by a spawn id list prefaced by a -.B \-input -flag. (Both -.B \-input -and -.B \-output -may take lists in the same form as the -.B \-i -flag in the -.B expect -command, except that any_spawn_id is not meaningful in -.BR interact .) -All following flags and -strings (or patterns) apply to this input until another -input flag appears. -If no -.B \-input -appears, -.B \-output -implies "\-input $user_spawn_id \-output". -(Similarly, with patterns that do not have -.BR \-input .) -If one -.B \-input -is specified, it overrides $user_spawn_id. If a second -.B \-input -is specified, -it overrides $spawn_id. Additional -.B \-input -flags may be specified. - -The two implied input processes default to having their outputs specified as -$spawn_id and $user_spawn_id (in reverse). -If a -.B \-input -flag appears -with no -.B \-output -flag, characters from that process are discarded. - -The -.B \-i -flag introduces a replacement for the current spawn_id when no -other -.B \-input -or -.B \-output -flags are used. A \-i flag implies a \-o flag. - -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 -causes the user to be interactively prompted for -.B Expect -and Tcl commands. -The result of each command is printed. -.IP -Actions such as -.B break -and -.B continue -cause control structures (i.e., -.BR for , -.BR proc ) -to behave in the usual way. -However -.B return -causes interpreter to return to its caller, while -.B inter_return -causes -.B interpreter -to cause a return in its caller. For example, if "proc foo" called -.B interpreter -which then executed the action -.BR inter_return , -.B proc foo -would return. -Any other command causes -.B interpreter -to continue prompting for new commands. -.IP -By default, the prompt contains two integers. -The first integer describes the depth of -the evaluation stack (i.e., how many times Tcl_Eval has been called). The -second integer is the Tcl history identifier. The prompt can be set by -defining a procedure called "prompt1" whose return value becomes the next -prompt. If a statement has open quotes, parens, braces, or brackets, a -secondary prompt (by default "+> ") is issued upon newline. The secondary -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. -.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. -.B log_file -will stop recording if no argument is given. Any previous log file is closed. - -Instead of a filename, a Tcl file identifier may be provided by using the -.B \-open -or -.B \-leaveopen -flags. This is similar to the -.B spawn -command. (See -.B spawn -for more info.) - -The -.B \-a -flag forces output to be logged that was suppressed by the -.B log_user -command. - -By default, the -.B log_file -command -.I appends -to old files rather than truncating them, -for the convenience of being able to turn logging off and on multiple -times in one session. -To truncate files, use the -.B \-noappend -flag. - -The -.B -info -flag causes log_file to return a description of the -most recent non-info arguments given. -.TP -.BI log_user " -info|0|1" -By default, the send/expect dialogue is logged to stdout -(and a logfile if open). -The logging to stdout is disabled by the command "log_user 0" -and reenabled by "log_user 1". Logging to the logfile is unchanged. - -The -.B -info -flag causes log_user to return a description of the -most recent non-info arguments given. -.TP -.BI match_max " [\-d] [\-i spawn_id] [size]" -defines the size of the buffer (in bytes) used internally by -.BR expect . -With no -.I size -argument, the current size is returned. -.IP -With the -.B \-d -flag, the default size is set. (The initial default is 2000.) -With the -.B \-i -flag, the size is set for the named spawn id, otherwise it is set for -the current process. -.TP -.BI overlay " [\-# spawn_id] [\-# spawn_id] [...] program [args]" -executes -.IR "program args" -in place of the current -.B Expect -program, which terminates. -A bare hyphen argument forces a hyphen in front of the command name as if -it was a login shell. -All spawn_ids are closed except for those named as arguments. These -are mapped onto the named file identifiers. -.IP -Spawn_ids are mapped to file identifiers for the new program to inherit. -For example, the following line runs chess and allows it to be -controlled by the current process \- say, a chess master. -.nf - - overlay \-0 $spawn_id \-1 $spawn_id \-2 $spawn_id chess - -.fi -This is more efficient than -"interact \-u", however, it sacrifices the ability to do programmed -interaction since the -.B Expect -process is no longer in control. -.IP -Note that no controlling terminal is provided. Thus, if you -disconnect or remap standard input, programs that do -job control (shells, login, etc) will not function properly. -.TP -.BI parity " [\-d] [\-i spawn_id] [value]" -defines whether parity should be retained or stripped from the output of -spawned processes. If -.I value -is zero, parity is stripped, otherwise it is not stripped. -With no -.I value -argument, the current value is returned. -.IP -With the -.B \-d -flag, the default parity value is set. (The initial default is 1, i.e., -parity is not stripped.) -With the -.B \-i -flag, the parity value is set for the named spawn id, otherwise it is set for -the current process. -.TP -.BI remove_nulls " [\-d] [\-i spawn_id] [value]" -defines whether nulls are retained or removed from the output of -spawned processes before pattern matching -or storing in the variable -.I expect_out -or -.IR interact_out . -If -.I value -is 1, nulls are removed. If -.I value -is 0, nulls are not removed. -With no -.I value -argument, the current value is returned. -.IP -With the -.B \-d -flag, the default value is set. (The initial default is 1, i.e., -nulls are removed.) -With the -.B \-i -flag, the value is set for the named spawn id, otherwise it is set for -the current process. - -Whether or not nulls are removed, -.B Expect -will record null bytes to the log and stdout. -.TP -.BI send " [\-flags] string" -Sends -.IR string -to the current process. -For example, the command -.nf - - send "hello world\\r" - -.fi -sends the characters, h e l l o w o r l d to the -current process. -(Tcl includes a printf-like command (called -.BR format ) -which can build arbitrarily complex strings.) -.IP -Characters are sent immediately although programs with line-buffered input -will not read the characters until a return character is sent. A return -character is denoted "\\r". - -The -.B \-\- -flag forces the next argument to be interpreted as a string rather than a flag. -Any string can be preceded by "\-\-" whether or not it actually looks -like a flag. This provides a reliable mechanism to specify variable strings -without being tripped up by those that accidentally look like flags. -(All strings starting with "-" are reserved for future options.) - -The -.B \-i -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. -The -.B \-raw -flag disables this translation. - -The -.BR \-null -flag sends null characters (0 bytes). By default, one null is sent. -An integer may follow the -.BR \-null -to indicate how many nulls to send. - -The -.B \-break -flag generates a break condition. This only makes sense if the spawn -id refers to a tty device opened via "spawn -open". If you have -spawned a process such as tip, you should use tip's convention for -generating a break. - -The -.B \-s -flag forces output to be sent "slowly", thus avoid the common situation -where a computer outtypes an input buffer that was designed for a -human who would never outtype the same buffer. This output is -controlled by the value of the variable "send_slow" which takes a two -element list. The first element is an integer that describes the -number of bytes to send atomically. The second element is a real -number that describes the number of seconds by which the atomic sends -must be separated. For example, "set send_slow {10 .001}" would force -"send \-s" to send strings with 1 millisecond in between each 10 -characters sent. - -The -.B \-h -flag forces output to be sent (somewhat) like a human actually typing. -Human-like delays appear between the characters. (The algorithm is -based upon a Weibull distribution, with modifications to suit this -particular application.) This output is controlled by the value of -the variable "send_human" which takes a five element list. The first -two elements are average interarrival time of characters in seconds. -The first is used by default. The second is used at word endings, to -simulate the subtle pauses that occasionally occur at such -transitions. The third parameter is a measure of variability where .1 -is quite variable, 1 is reasonably variable, and 10 is quite -invariable. The extremes are 0 to infinity. The last two parameters -are, respectively, a minimum and maximum interarrival time. -The minimum and maximum are used last and "clip" the final time. -The ultimate average can be quite different from the given average -if the minimum and maximum clip enough values. - -As an -example, the following command emulates a fast and -consistent typist: -.nf - - set send_human {.1 .3 1 .05 2} - send \-h "I'm hungry. Let's do lunch." - -.fi -while the following might be more suitable after a hangover: -.nf - - set send_human {.4 .4 .2 .5 100} - send \-h "Goodd party lash night!" - -.fi -Note that errors are not simulated, although you can set up error -correction situations yourself by embedding mistakes and corrections -in a send argument. - -The flags for sending null characters, for sending breaks, for forcing slow -output and for human-style output are mutually exclusive. Only the one -specified last will be used. Furthermore, no -.I string -argument can be specified with the flags for sending null characters or breaks. - -It is a good idea to precede the first -.B send -to a process by an -.BR expect . -.B expect -will wait for the process to start, while -.B send -cannot. -In particular, if the first -.B send -completes before the process starts running, -you run the risk of having your data ignored. -In situations where interactive programs offer no initial prompt, -you can precede -.B send -by a delay as in: -.nf - - # To avoid giving hackers hints on how to break in, - # this system does not prompt for an external password. - # Wait for 5 seconds for exec to complete - spawn telnet very.secure.gov - sleep 5 - send password\\r - -.fi -.B exp_send -is an alias for -.BI send . -If you are using Expectk or some other variant of Expect in the Tk environment, -.B send -is defined by Tk for an entirely different purpose. -.B exp_send -is provided for compatibility between environments. -Similar aliases are provided for other Expect's other send commands. -.TP -.BI send_error " [\-flags] string" -is like -.BR send , -except that the output is sent to stderr rather than the current -process. -.TP -.BI send_log " [\--] string" -is like -.BR send , -except that the string is only sent to the log file (see -.BR log_file .) -The arguments are ignored if no log file is open. -.TP -.BI send_tty " [\-flags] string" -is like -.BR send , -except that the output is sent to /dev/tty rather than the current -process. -.TP -.BI send_user " [\-flags] string" -is like -.BR send , -except that the output is sent to stdout rather than the current -process. -.TP -.BI sleep " seconds" -causes the script to sleep for the given number of seconds. -Seconds may be a decimal number. Interrupts (and Tk events if you -are using Expectk) are processed while Expect sleeps. -.TP -.BI spawn " [args] program [args]" -creates a new process running -.IR "program args" . -Its stdin, stdout and stderr are connected to Expect, -so that they may be read and written by other -.B Expect -commands. -The connection is broken by -.B close -or if the process itself closes any of the file identifiers. -.IP -When a process is started by -.BR spawn , -the variable -.I spawn_id -is set to a descriptor referring to that process. -The process described by -.I spawn_id -is considered the -.IR "current process" . -.I spawn_id -may be read or written, in effect providing job control. -.IP -.I user_spawn_id -is a global variable containing a descriptor which refers to the user. -For example, when -.I spawn_id -is set to this value, -.B expect -behaves like -.BR expect_user . - -.I -.I error_spawn_id -is a global variable containing a descriptor which refers to the standard -error. -For example, when -.I spawn_id -is set to this value, -.B send -behaves like -.BR send_error . -.IP -.I tty_spawn_id -is a global variable containing a descriptor which refers to /dev/tty. -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] { - # /dev/tty exists - } else { - # /dev/tty doesn't exist - # probably in cron, batch, or at script - } - -.fi -.IP -.B spawn -returns the UNIX process id. If no process is spawned, 0 is returned. -The variable -.I spawn_out(slave,name) -is set to the name of the pty slave device. -.IP -By default, -.B spawn -echoes the command name and arguments. The -.B \-noecho -flag stops -.B spawn -from doing this. -.IP -The -.B \-console -flag causes console output to be redirected to the spawned process. -This is not supported on all systems. - -Internally, -.B spawn -uses a pty, initialized the same way as the user's tty. This is further -initialized so that all settings are "sane" (according to stty(1)). -If the variable -.I stty_init -is defined, it is interpreted in the style of stty arguments -as further configuration. -For example, "set stty_init raw" will cause further spawned processes's -terminals to start in raw mode. -.B \-nottycopy -skips the initialization based on the user's tty. -.B \-nottyinit -skips the "sane" initialization. -.IP -Normally, -.B spawn -takes little time to execute. If you notice spawn taking a -significant amount of time, it is probably encountering ptys that are -wedged. A number of tests are run on ptys to avoid entanglements with -errant processes. (These take 10 seconds per wedged pty.) Running -Expect with the -.B \-d -option will show if -.B Expect -is encountering many ptys in odd states. If you cannot kill -the processes to which these ptys are attached, your only recourse may -be to reboot. - -If -.I program -cannot be spawned successfully because exec(2) fails (e.g. when -.I program -doesn't exist), an error message will be returned by the next -.B interact -or -.B expect -command as if -.I program -had run and produced the error message as output. -This behavior is a natural consequence of the implementation of -.BR spawn . -Internally, spawn forks, after which the spawned process has no -way to communicate with the original -.B Expect -process except by communication -via the spawn_id. - -The -.B \-open -flag causes the next argument to be interpreted as a Tcl file identifier -(i.e., returned by -.BR open .) -The spawn id can then be used as if it were a spawned process. (The file -identifier should no longer be used.) -This lets you treat raw devices, files, and -pipelines as spawned processes without using a pty. 0 is returned to -indicate there is no associated process. When the connection to -the spawned process is closed, so is the Tcl file identifier. -The -.B \-leaveopen -flag is similar to -.B \-open -except that -.B \-leaveopen -causes the file identifier to be left open even after the spawn id is closed. - -The -.B \-pty -flag causes a pty to be opened but no process spawned. 0 is returned -to indicate there is no associated process. Spawn_id is set as usual. - -The variable -.I spawn_out(slave,fd) -is set to a file identifier corresponding to the pty slave. -It can be closed using "close -slave". - -The -.B \-ignore -flag names a signal to be ignored in the spawned process. -Otherwise, signals get the default behavior. -Signals are named as in the -.B trap -command, except that each signal requires a separate flag. -.TP -.BI strace " level" -causes following statements to be printed before being executed. -(Tcl's trace command traces variables.) -.I level -indicates how far down in the call stack to trace. -For example, -the following command runs -.B Expect -while tracing the first 4 levels of calls, -but none below that. -.nf - - expect \-c "strace 4" script.exp - -.fi - -The -.B -info -flag causes strace to return a description of the -most recent non-info arguments given. -.TP -.BI stty " args" -changes terminal modes similarly to the external stty command. - -By default, the controlling terminal is accessed. Other terminals can -be accessed by appending "< /dev/tty..." to the command. (Note that -the arguments should not be grouped into a single argument.) - -Requests for status return it as the result of the command. If no status -is requested and the controlling terminal is accessed, the previous -status of the raw and echo attributes are returned in a form which can -later be used by the command. - -For example, the arguments -.B raw -or -.B \-cooked -put the terminal into raw mode. -The arguments -.B \-raw -or -.B cooked -put the terminal into cooked mode. -The arguments -.B echo -and -.B \-echo -put the terminal into echo and noecho mode respectively. -.IP -The following example illustrates how to temporarily disable echoing. -This could be used in otherwise-automatic -scripts to avoid embedding passwords in them. -(See more discussion on this under EXPECT HINTS below.) -.nf - - stty \-echo - send_user "Password: " - expect_user -re "(.*)\\n" - set password $expect_out(1,string) - stty echo - -.fi -.TP -.BI system " args" -gives -.I args -to sh(1) as input, -just as if it had been typed as a command from a terminal. -.B Expect -waits until the shell terminates. -The return status from sh is handled the same way that -.B exec -handles its return status. -.IP -In contrast to -.B exec -which redirects stdin and stdout to the script, -.B system -performs no redirection -(other than that indicated by the string itself). -Thus, it is possible to use programs which must talk directly to /dev/tty. -For the same reason, the results of -.B system -are not recorded in the log. -.TP -.BI timestamp " [args]" -returns a timestamp. -With no arguments, the number of -seconds since the epoch is returned. - -The -.B \-format -flag introduces a string which is returned but with -substitutions made according to the -POSIX rules for strftime. For example %a is replaced by an abbreviated -weekday name (i.e., Sat). Others are: -.nf - %a abbreviated weekday name - %A full weekday name - %b abbreviated month name - %B full month name - %c date-time as in: Wed Oct 6 11:45:56 1993 - %d day of the month (01-31) - %H hour (00-23) - %I hour (01-12) - %j day (001-366) - %m month (01-12) - %M minute (00-59) - %p am or pm - %S second (00-61) - %u day (1-7, Monday is first day of week) - %U week (00-53, first Sunday is first day of week one) - %V week (01-53, ISO 8601 style) - %w day (0-6) - %W week (00-53, first Monday is first day of week one) - %x date-time as in: Wed Oct 6 1993 - %X time as in: 23:59:59 - %y year (00-99) - %Y year as in: 1993 - %Z timezone (or nothing if not determinable) - %% a bare percent sign - -.fi -Other % specifications are undefined. Other characters will be passed -through untouched. Only the C locale is supported. - -The -.B \-seconds -flag introduces a number of seconds since the epoch to be used as a source -from which to format. Otherwise, the current time is used. - -The -.B \-gmt -flag forces timestamp output to use the GMT timezone. With no flag, -the local timezone is used. -.TP -.BI trap " [[command] signals]" -causes the given -.I command -to be executed upon future receipt of any of the given signals. -The command is executed in the global scope. -If -.I command -is absent, the signal action is returned. -If -.I command -is the string SIG_IGN, the signals are ignored. -If -.I command -is the string SIG_DFL, the signals are result to the system default. -.I signals -is either a single signal or a list of signals. Signals may be specified -numerically or symbolically as per signal(3). The "SIG" prefix may be omitted. - -With no arguments (or the argument \-number), -.B trap -returns the signal number of the trap command currently being executed. - -The -.B \-code -flag uses the return code of the command in place of whatever code Tcl -was about to return when the command originally started running. - -The -.B \-interp -flag causes the command to be evaluated using the interpreter -active at the time the command started running -rather than when the trap was declared. - -The -.B \-name -flag causes the -.B trap -command to return the signal name of the trap command currently being executed. - -The -.B \-max -flag causes the -.B trap -command to return the largest signal number that can be set. - -For example, the command "trap {send_user "Ouch!"} SIGINT" will print "Ouch!" -each time the user presses ^C. - -By default, SIGINT (which can usually be generated by pressing ^C) and -SIGTERM cause Expect to exit. This is due to the following trap, created -by default when Expect starts. -.nf - - trap exit {SIGINT SIGTERM} - -.fi -If you use the -D flag to start the debugger, SIGINT is redefined -to start the interactive debugger. This is due to the following trap: -.nf - - trap {exp_debug 1} SIGINT - -.fi -The debugger trap can be changed by setting the environment variable -EXPECT_DEBUG_INIT to a new trap command. - -You can, of course, override both of these just by adding trap -commands to your script. In particular, if you have your own "trap -exit SIGINT", this will override the debugger trap. This is useful -if you want to prevent users from getting to the debugger at all. - -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} - -.fi -Alternatively, you can trap to the debugger using some other signal. - -.B trap -will not let you override the action for SIGALRM as this is used internally -to -.BR Expect . -The disconnect command sets SIGALRM to SIG_IGN (ignore). You can reenable -this as long as you disable it during subsequent spawn commands. - -See signal(3) for more info. -.TP -.BI wait " [args]" -delays until a spawned process (or -the current process if none is named) terminates. -.IP -.B wait -normally returns a list of four integers. -The first integer is the pid of the process that was waited upon. -The second integer is the corresponding spawn id. -The third integer is -1 if an operating system error occurred, or 0 otherwise. -If the third integer was 0, the fourth integer is the status returned by -the spawned process. If the third integer was -1, the fourth integer is -the value of errno set by the operating system. The global variable -errorCode is also set. - -Additional elements may appear at the end of the return value from -.BR wait . -An optional fifth element identifies a class of information. -Currently, the only possible value for this element is CHILDKILLED in -which case the next two values are the C-style signal name and a short -textual description. -.IP -The -.B \-i -flag declares the process to wait corresponding to the named spawn_id -(NOT the process id). -Inside a SIGCHLD handler, -it is possible to wait for any spawned process by using the spawn id -1. - -The -.B \-nowait -flag causes the wait to return immediately with the indication of a -successful wait. When the process exits (later), it will automatically -disappear without the need for an explicit wait. - -The -.B wait -command may also be used wait for a forked process using the arguments -"-i -1". Unlike its use with spawned processes, this command can be -executed at any time. There is no control over which process is -reaped. However, the return value can be checked for the process id. - -.SH LIBRARIES -Expect automatically knows about two built-in libraries for Expect scripts. -These are defined by the directories named in the variables -exp_library and exp_exec_library. Both are meant to contain utility -files that can be used by other scripts. - -exp_library contains architecture-independent files. exp_exec_library -contains architecture-dependent files. Depending on your system, both -directories may be totally empty. The existence of the file -$exp_exec_library/cat-buffers describes whether your /bin/cat buffers -by default. -.SH PRETTY-PRINTING -A vgrind definition is available for pretty-printing -.B Expect -scripts. -Assuming the vgrind definition supplied with the -.B Expect -distribution is -correctly installed, you can use it as: -.nf - - vgrind \-lexpect file - -.fi -.SH EXAMPLES -It many not be apparent how to put everything together that the man page -describes. I encourage you to read and try out the examples in -the example directory of the -.B Expect -distribution. -Some of them are real programs. Others are simply illustrative -of certain techniques, and of course, a couple are just quick hacks. -The INSTALL file has a quick overview of these programs. -.PP -The -.B Expect -papers (see SEE ALSO) are also useful. While some papers -use syntax corresponding to earlier versions of Expect, the accompanying -rationales are still valid and go into a lot more detail than this -man page. -.SH CAVEATS -Extensions may collide with Expect's command names. For example, -.B send -is defined by Tk for an entirely different purpose. -For this reason, most of the -.B Expect -commands are also available as "exp_XXXX". -Commands and variables beginning with "exp", "inter", "spawn", -and "timeout" do not have aliases. -Use the extended command names if you need this compatibility between environments. - -.B Expect -takes a rather liberal view of scoping. -In particular, variables read by commands specific to the -.B Expect -program will be sought first from the local scope, and if not found, in the -global scope. For example, this -obviates the need to place "global timeout" in every -procedure you write that uses -.BR expect . -On the other hand, variables written are always in the local scope (unless -a "global" command has been issued). The most common problem this causes -is when spawn is executed in a procedure. Outside the procedure, -.I spawn_id -no longer exists, so the spawned process is no longer accessible -simply because of scoping. Add a "global spawn_id" to such a procedure. - -If you cannot enable the multispawning capability -(i.e., your system supports neither select (BSD *.*), poll (SVR>2), -nor something equivalent), -.B Expect -will only be able to control a single process at a time. -In this case, do not attempt to set -.IR spawn_id , -nor should you execute processes via exec while a spawned process -is running. Furthermore, you will not be able to -.B expect -from multiple processes (including the user as one) at the same time. - -Terminal parameters can have a big effect on scripts. For example, if -a script is written to look for echoing, it will misbehave if echoing -is turned off. For this reason, Expect forces sane terminal -parameters by default. Unfortunately, this can make things unpleasant -for other programs. As an example, the emacs shell wants to change -the "usual" mappings: newlines get mapped to newlines instead of -carriage-return newlines, and echoing is disabled. This allows one to -use emacs to edit the input line. Unfortunately, Expect cannot -possibly guess this. - -You can request that Expect not override its default setting of -terminal parameters, but you must then be very careful when writing -scripts for such environments. In the case of emacs, avoid depending -upon things like echoing and end-of-line mappings. - -The commands that accepted arguments braced into a single list (the -.B expect -variants and -.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 -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. - -On some systems, when a shell is spawned, it complains about not being -able to access the tty but runs anyway. This means your system has a -mechanism for gaining the controlling tty that -.B Expect -doesn't know about. Please find out what it is, and send this information -back to me. - -Ultrix 4.1 (at least the latest versions around here) considers -timeouts of above 1000000 to be equivalent to 0. - -Digital UNIX 4.0A (and probably other versions) refuses to allocate -ptys if you define a SIGCHLD handler. See grantpt page for more info. - -IRIX 6.0 does not handle pty permissions correctly so that if Expect -attempts to allocate a pty previously used by someone else, it fails. -Upgrade to IRIX 6.1. - -Telnet (verified only under SunOS 4.1.2) hangs if TERM is not set. -This is a problem under cron, at and in cgi scripts, which do not -define TERM. Thus, you must set it explicitly - to what type is -usually irrelevant. It just has to be set to something! The -following probably suffices for most cases. -.nf - - set env(TERM) vt100 - -.fi - -Tip (verified only under BSDI BSD/OS 3.1 i386) hangs if SHELL and HOME -are not set. This is a problem under cron, at and in cgi scripts, -which do not define these environment variables. Thus, you must set -them explicitly - to what type is usually irrelevant. It just has to -be set to something! The following probably suffices for most cases. -.nf - - set env(SHELL) /bin/sh - set env(HOME) /usr/local/bin - -.fi - - -Some implementations of ptys are designed so that the kernel throws -away any unread output after 10 to 15 seconds (actual number is -implementation-dependent) after the process has closed the file -descriptor. Thus -.B Expect -programs such as -.nf - - spawn date - sleep 20 - expect - -.fi -will fail. To avoid this, invoke non-interactive programs with -.B exec -rather than -.BR spawn . -While such situations are conceivable, in practice I have never -encountered a situation in which the final output of a truly -interactive program would be lost due to this behavior. - -On the other hand, Cray UNICOS ptys throw away any unread output -immediately after the process has closed the file descriptor. I have -reported this to Cray and they are working on a fix. - -Sometimes a delay is required between a prompt and a response, such as -when a tty interface is changing UART settings or matching baud rates -by looking for start/stop bits. Usually, all this is require is to -sleep for a second or two. A more robust technique is to retry until -the hardware is ready to receive input. The following example uses -both strategies: -.nf - - send "speed 9600\\r"; - sleep 1 - expect { - timeout {send "\\r"; exp_continue} - $prompt - } - -.fi - -.SH EXPECT HINTS -There are a couple of things about -.B Expect -that may be non-intuitive. -This section attempts to address some of these things with a couple of -suggestions. - -A common expect problem is how to recognize shell prompts. Since -these are customized differently by differently people and different -shells, portably automating rlogin can be difficult without knowing -the prompt. A reasonable convention is to have users store a regular -expression describing their prompt (in particular, the end of it) in -the environment variable EXPECT_PROMPT. Code like the following -can be used. If EXPECT_PROMPT doesn't exist, the code still has a good chance of functioning correctly. -.nf - - set prompt "(%|#|\\\\$) $" ;# default prompt - catch {set prompt $env(EXPECT_PROMPT)} - - expect -re $prompt - -.fi -I encourage you to write -.B expect -patterns that include the end of whatever -you expect to see. This avoids the possibility of answering a question -before seeing the entire thing. In addition, while you may well be -able to answer questions before seeing them entirely, if you answer -early, your answer may appear echoed back in the middle of the question. -In other words, the resulting dialogue will be correct but look scrambled. - -Most prompts include a space character at the end. -For example, the prompt from ftp is 'f', 't', 'p', '>' and . -To match this prompt, you must account for each of these characters. -It is a common mistake not to include the blank. -Put the blank in explicitly. - -If you use a pattern of the form X*, the * will match all the output -received from the end of X to the last thing received. -This sounds intuitive but can be somewhat confusing because the phrase -"last thing received" can vary depending upon the speed of the computer -and the processing of I/O both by the kernel and the device driver. -.PP -In particular, humans tend to see program output arriving in huge chunks -(atomically) when in reality most programs produce output one -line at a time. Assuming this is the case, the * in the pattern of the -previous paragraph may only match the end of the current line even though -there seems to be more, because at the time of the match that was all -the output that had been received. -.PP -.B expect -has no way of knowing that further output is coming unless your -pattern specifically accounts for it. -.PP -Even depending on line-oriented buffering is unwise. Not only do programs -rarely make promises about the type of buffering they do, but system -indigestion can break output lines up so that lines break at seemingly -random places. Thus, if you can express the last few characters -of a prompt when writing patterns, it is wise to do so. - -If you are waiting for a pattern in the last output of a program -and the program emits something else instead, you will not be able to -detect that with the -.B timeout -keyword. The reason is that -.B expect -will not timeout \- instead it will get an -.B eof -indication. -Use that instead. Even better, use both. That way if that line -is ever moved around, you won't have to edit the line itself. - -Newlines are usually converted to carriage return, linefeed sequences -when output by the terminal driver. Thus, if you want a pattern that -explicitly matches the two lines, from, say, printf("foo\\nbar"), -you should use the pattern "foo\\r\\nbar". -.PP -A similar translation occurs when reading from the user, via -.BR expect_user . -In this case, when you press return, it will be -translated to a newline. If -.B Expect -then passes that to a program -which sets its terminal to raw mode (like telnet), there is going to -be a problem, as the program expects a true return. (Some programs -are actually forgiving in that they will automatically translate -newlines to returns, but most don't.) Unfortunately, there is no way to find -out that a program put its terminal into raw mode. -.PP -Rather than manually replacing newlines with returns, the solution is to -use the command "stty raw", which will stop the translation. -Note, however, that this means that you will no longer get the cooked -line-editing features. -.PP -.B interact -implicitly sets your terminal to raw mode so this problem will not arise then. - -It is often useful to store passwords (or other private information) -in -.B Expect -scripts. This is not recommended since anything that is -stored on a computer is susceptible to being accessed by anyone. -Thus, interactively prompting for passwords from a script is a smarter -idea than embedding them literally. Nonetheless, sometimes such embedding -is the only possibility. -.PP -Unfortunately, the UNIX file system has no direct way of creating -scripts which are executable but unreadable. Systems which support -setgid shell scripts may indirectly simulate this as follows: -.PP -Create the -.B Expect -script (that contains the secret data) as usual. -Make its permissions be 750 (\-rwxr\-x\-\-\-) and owned by a trusted group, -i.e., a group which is allowed to read it. If necessary, create a new -group for this purpose. Next, create a /bin/sh script with -permissions 2751 (\-rwxr\-s\-\-x) owned by the same group as before. -.PP -The result is a script which may be executed (and read) by anyone. -When invoked, it runs the -.B Expect -script. -.SH SEE ALSO -.BR Tcl (3), -.BR libexpect (3) -.br -.I -"Exploring Expect: A Tcl-Based Toolkit for Automating Interactive Programs" -\fRby Don Libes, pp. 602, ISBN 1-56592-090-2, O'Reilly and Associates, 1995. -.br -.I -"expect: Curing Those Uncontrollable Fits of Interactivity" \fRby Don Libes, -Proceedings of the Summer 1990 USENIX Conference, -Anaheim, California, June 11-15, 1990. -.br -.I -"Using -.B expect -to Automate System Administration Tasks" \fRby Don Libes, -Proceedings of the 1990 USENIX Large Installation Systems Administration -Conference, Colorado Springs, Colorado, October 17-19, 1990. -.br -.I -"Tcl: An Embeddable Command Language" \fRby John Ousterhout, -Proceedings of the Winter 1990 USENIX Conference, -Washington, D.C., January 22-26, 1990. -.br -.I -"expect: Scripts for Controlling Interactive Programs" \fRby Don Libes, -Computing Systems, Vol. 4, No. 2, University of California Press Journals, -November 1991. -.br -.I -"Regression Testing and Conformance Testing Interactive Programs", \fRby Don -Libes, Proceedings of the Summer 1992 USENIX Conference, pp. 135-144, -San Antonio, TX, June 12-15, 1992. -.br -.I -"Kibitz \- Connecting Multiple Interactive Programs Together", \fRby Don Libes, -Software \- Practice & Experience, John Wiley & Sons, West Sussex, England, -Vol. 23, No. 5, May, 1993. -.br -.I -"A Debugger for Tcl Applications", \fRby Don Libes, -Proceedings of the 1993 Tcl/Tk Workshop, Berkeley, CA, June 10-11, 1993. -.SH AUTHOR -Don Libes, National Institute of Standards and Technology -.SH ACKNOWLEDGMENTS -Thanks to John Ousterhout for Tcl, and Scott Paisley for inspiration. -Thanks to Rob Savoye for Expect's autoconfiguration code. -.PP -The HISTORY file documents much of the evolution of -.BR expect . -It makes interesting reading and might give you further insight to this -software. Thanks to the people mentioned in it who sent me bug fixes -and gave other assistance. -.PP -Design and implementation of -.B Expect -was paid for in part by the U.S. government and is therefore in the public -domain. -However the author and NIST would like credit -if this program and documentation or portions of them are used. DELETED expect_cf.h.in Index: expect_cf.h.in ================================================================== --- expect_cf.h.in +++ /dev/null @@ -1,114 +0,0 @@ -/* - * Check for headers - */ -#ifndef __EXPECT_CF_H__ -#define __EXPECT_CF_H__ - -#undef NO_STDLIB_H /* Tcl requires this name */ -#undef HAVE_STDARG_H -#undef HAVE_VARARGS_H -#undef HAVE_STROPTS_H -#undef HAVE_SYSCONF_H -#undef HAVE_SYS_FCNTL_H -#undef HAVE_SYS_WAIT_H -#undef HAVE_SYS_BSDTYPES_H /* nice ISC special */ -#undef HAVE_SYS_SELECT_H /* nice ISC special */ -#undef HAVE_SYS_TIME_H /* nice ISC special */ -#undef HAVE_SYS_PTEM_H /* SCO needs this for window size */ -#undef HAVE_STRREDIR_H /* Solaris needs this for console redir */ -#undef HAVE_STRPTY_H /* old-style Dynix ptys need this */ -#undef HAVE_UNISTD_H -#undef HAVE_SYSMACROS_H -#undef HAVE_INTTYPES_H -#undef HAVE_TIOCGWINSZ_IN_TERMIOS_H -#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 */ - -/* - * This section is for compile macros needed by - * everything else. - */ - -/* - * Check for functions - */ -#undef HAVE_MEMCPY -#undef HAVE_SYSCONF -#undef SIMPLE_EVENT -#undef HAVE_STRFTIME -#undef HAVE_MEMMOVE -#undef HAVE_TIMEZONE /* timezone() a la Pyramid */ -#undef HAVE_STRCHR - -#ifndef HAVE_STRCHR -#define strchr(s,c) index(s,c) -#endif /* HAVE_STRCHR */ - -/* - * timezone - */ -#undef HAVE_SV_TIMEZONE - -/* - * wait status type - */ -#undef NO_UNION_WAIT - -#undef WNOHANG_REQUIRES_POSIX_SOURCE - -/* - * Signal stuff. Setup the return type - * and if signals need to be re-armed. - */ -/*#ifndef RETSIGTYPE*/ -/*#define RETSIGTYPE void*/ -/*#endif*/ -#undef REARM_SIG - -/* - * Generate correct type for select mask - */ -#ifndef SELECT_MASK_TYPE -#define SELECT_MASK_TYPE fd_set -#endif - -/* - * Check how stty works - */ -#undef STTY_READS_STDOUT - -/* - * Check for tty/pty functions and structures - */ -#undef POSIX -#undef HAVE_TCSETATTR -#undef HAVE_TERMIO -#undef HAVE_TERMIOS -#undef HAVE_SGTTYB -#undef HAVE__GETPTY -#undef HAVE_GETPTY -#undef HAVE_OPENPTY -#undef HAVE_PTC -#undef HAVE_PTC_PTS -#undef HAVE_PTYM -#undef HAVE_PTYTRAP -#undef HAVE_PTMX -#undef HAVE_PTMX_BSD -#undef HAVE_SCO_CLIST_PTYS - -/* - * Special hacks - */ -#undef CONVEX -#undef SOLARIS - -#ifdef SOLARIS -#define __EXTENSIONS__ -#endif /* SOLARIS */ - -#undef WNOHANG_BACKUP_VALUE - -#endif /* __EXPECT_CF_H__ */ DELETED expect_comm.h Index: expect_comm.h ================================================================== --- expect_comm.h +++ /dev/null @@ -1,172 +0,0 @@ -/* expectcomm.h - public symbols common to both expect.h and expect_tcl.h - -Written by: Don Libes, libes@cme.nist.gov, 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. -*/ - -#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 */ - /* usual sense to check errors in system */ - /* calls */ -#define EXP_TIMEOUT -2 -#define EXP_TCLERROR -3 -#define EXP_FULLBUFFER -5 -#define EXP_MATCH -6 -#define EXP_NOMATCH -7 -#define EXP_CANTMATCH EXP_NOMATCH -#define EXP_CANMATCH -8 -#define EXP_DATA_NEW -9 /* if select says there is new data */ -#define EXP_DATA_OLD -10 /* if we already read data in another cmd */ -#define EXP_EOF -11 -#define EXP_RECONFIGURE -12 /* changes to indirect spawn id lists */ - /* require us to reconfigure things */ - -/* in the unlikely event that a signal handler forces us to return this */ -/* through expect's read() routine, we temporarily convert it to this. */ -#define EXP_TCLRET -20 -#define EXP_TCLCNT -21 -#define EXP_TCLCNTTIMER -22 -#define EXP_TCLBRK -23 -#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 */ -#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)); - -EXTERN char *exp_pty_error; /* place to pass a string generated */ - /* deep in the innards of the pty */ - /* code but needed by anyone */ - -#endif /* _EXPECT_COMM_H */ DELETED expect_tcl.h Index: expect_tcl.h ================================================================== --- expect_tcl.h +++ /dev/null @@ -1,47 +0,0 @@ -/* expect_tcl.h - include file for using the expect library, libexpect.a -with Tcl (and optionally Tk) - -Written by: Don Libes, libes@cme.nist.gov, 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. - -*/ - -#ifndef _EXPECT_TCL_H -#define _EXPECT_TCL_H - -#include "expect_comm.h" - -EXTERN int exp_cmdlinecmds; -EXTERN int exp_interactive; -EXTERN FILE *exp_cmdfile; -EXTERN char *exp_cmdfilename; -EXTERN int exp_getpid; /* pid of Expect itself */ -EXTERN int exp_buffer_command_input; - -EXTERN int exp_tcl_debugger_available; - -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_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)); - - /* 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 */ DELETED expectk.man Index: expectk.man ================================================================== --- expectk.man +++ /dev/null @@ -1,42 +0,0 @@ -.TH EXPECTK 1 "15 February 1993" -.SH NAME -expectk \- Expect with Tk support -.SH SYNOPSIS -.B expectk -[ -.I args -] -.SH INTRODUCTION -.B Expectk -is a combination of Expect with Tk. (See their respective man pages for a more comprehensive explanation -of either.) -.B Expectk -should run any -.B wish -or -.B Expect -script (with minor changes - see below). -.PP -The differences between the Expectk and Expect environment follows. -.PP -The -.B send -command is Tk's. Expect's -.B send -command can be invoked by the name -.BR exp_send . -(For compatibility, Expect allows either -.B send -or -.B exp_send -to be used.) -.PP -Scripts may be invoked implicitly on systems which support the #! notation -by marking the script executable, and making the first line in your script: - - #!/usr/local/bin/expectk \-f - -Of course, the path must accurately describe where -.B Expectk -lives. /usr/local/bin is just an example. - DELETED fixcat Index: fixcat ================================================================== --- fixcat +++ /dev/null @@ -1,21 +0,0 @@ -#!expect -- -# Synopsis: fixcat -# Author: Don Libes - -# Description: test to see if /bin/cat is unbuffered (i.e., -u is needed) -# Return 0 if buffered, 1 if unbuffered. -# -# If this file is sitting in an architecture-specific library directory, -# then it serves as a marker that your /bin/cat buffers by default. - -# test for when catting to/from files -log_user 0 -spawn -open [open "|cat" "r+"] -send "\r" -expect "\r" {exit 1} - -# test for when catting to real tty -#log_user 0 -#spawn /bin/cat -#send "\r" -#expect "\r\n\r\n" {exit 1} DELETED fixline1 Index: fixline1 ================================================================== --- fixline1 +++ /dev/null @@ -1,13 +0,0 @@ -#!expect -- -# Synopsis: fixline1 newpath < input > output -# Author: Don Libes - -# Description: change first line of script to reflect new binary -# try to match any of the following first lines -#!expect ... -#!../expect ... -#!expectk ... -#!foo/bar/expectk ... -# -regsub "^#!(.*/)*(.*)" [gets stdin] "#!$argv/\\2" line1 -puts -nonewline "$line1\n[read stdin]" ADDED generic/Dbg.c Index: generic/Dbg.c ================================================================== --- /dev/null +++ generic/Dbg.c @@ -0,0 +1,1320 @@ +/* Dbg.c - Tcl Debugger - See cmdHelp() for commands + +Written by: Don Libes, NIST, 3/23/93 + +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 + +#include "Dbg_cf.h" +#if 0 +/* tclInt.h drags in stdlib. By claiming no-stdlib, force it to drag in */ +/* Tcl's compat version. This avoids having to test for its presence */ +/* which is too tricky - configure can't generate two cf files, so when */ +/* Expect (or any app) uses the debugger, there's no way to get the info */ +/* about whether stdlib exists or not, except pointing the debugger at */ +/* an app-dependent .h file and I don't want to do that. */ +#define NO_STDLIB_H +#endif + + +#include "tclInt.h" +/*#include tclInt.h drags in varargs.h. Since Pyramid */ +/* objects to including varargs.h twice, just */ +/* omit this one. */ +/*#include "string.h" tclInt.h drags this in, too! */ +#include "Dbg.h" + +#ifndef TRUE +#define TRUE 1 +#define FALSE 0 +#endif + + +/* + * Declarations for local procedures defined in this file: + */ + +static int cmdBreak _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int cmdDir _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int cmdHelp _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int cmdNext _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int cmdSimple _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int cmdWhere _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, char **argv)); +static int simple_interactor _ANSI_ARGS_((Tcl_Interp *interp, + ClientData data)); +static int zero _ANSI_ARGS_((Tcl_Interp *interp, char *string)); +static void print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); +static void debugger_trap _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int level, char *command, + Tcl_CmdProc *cmdProc, ClientData cmdClientData, + int argc, char **argv)); + + +/* most of the static variables in this file may be */ +/* moved into Tcl_Interp */ + +static Dbg_InterProc *interactor = simple_interactor; +static ClientData interdata = 0; +static Dbg_IgnoreFuncsProc *ignoreproc = zero; +static Dbg_OutputProc *printproc = 0; +static ClientData printdata = 0; + +static int debugger_active = FALSE; + +/* this is not externally documented anywhere as of yet */ +char *Dbg_VarName = "dbg"; + +#define DEFAULT_COMPRESS 0 +static int compress = DEFAULT_COMPRESS; +#define DEFAULT_WIDTH 75 /* leave a little space for printing */ + /* stack level */ +static int buf_width = DEFAULT_WIDTH; + +static int main_argc = 1; +static char *default_argv = "application"; +static char **main_argv = &default_argv; + +static Tcl_Trace debug_handle; +static int step_count = 1; /* count next/step */ + +#define FRAMENAMELEN 10 /* enough to hold strings like "#4" */ +static char viewFrameName[FRAMENAMELEN];/* destination frame name for up/down */ + +static CallFrame *goalFramePtr; /* destination for next/return */ +static int goalNumLevel; /* destination for Next */ + +static enum debug_cmd { + none, step, next, ret, cont, up, down, where, Next +} debug_cmd; + +/* info about last action to use as a default */ +static enum debug_cmd last_action_cmd = next; +static int last_step_count = 1; + +/* this acts as a strobe (while testing breakpoints). It is set to true */ +/* every time a new debugger command is issued that is an action */ +static debug_new_action; + +#define NO_LINE -1 /* if break point is not set by line number */ + +struct breakpoint { + int id; + char *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 */ + struct breakpoint *next, *previous; +}; + +static struct breakpoint *break_base = 0; +static int breakpoint_max_id = 0; + + + +static struct breakpoint * +breakpoint_new() +{ + struct breakpoint *b = (struct breakpoint *)ckalloc(sizeof(struct breakpoint)); + if (break_base) break_base->previous = b; + b->next = break_base; + b->previous = 0; + b->id = breakpoint_max_id++; + b->file = 0; + b->line = NO_LINE; + b->pat = 0; + b->re = 0; + b->expr = 0; + b->cmd = 0; + break_base = b; + return(b); +} + +static +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"); +} + +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; + } +} + +/* 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; +} + +static char *already_at_top_level = "already at top level"; + +/* similar to TclGetFrame but takes two frame ptrs and a direction. +If direction is up, search up stack from curFrame +If direction is down, simulate searching down stack by + seaching up stack from origFrame +*/ +static +int +TclGetFrame2(interp, origFramePtr, string, framePtrPtr, dir) + Tcl_Interp *interp; + CallFrame *origFramePtr; /* frame that is true top-of-stack */ + char *string; /* String describing frame. */ + CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL + * if global frame indicated). */ + enum debug_cmd dir; /* look up or down the stack */ +{ + Interp *iPtr = (Interp *) interp; + int level, result; + CallFrame *framePtr; /* frame currently being searched */ + + CallFrame *curFramePtr = iPtr->varFramePtr; + + /* + * Parse string to figure out which level number to go to. + */ + + result = 1; + if (*string == '#') { + if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) { + return TCL_ERROR; + } + if (level < 0) { + levelError: + Tcl_AppendResult(interp, "bad level \"", string, "\"", + (char *) NULL); + return TCL_ERROR; + } + framePtr = origFramePtr; /* start search here */ + + } else if (isdigit(*string)) { + if (Tcl_GetInt(interp, string, &level) != TCL_OK) { + return TCL_ERROR; + } + if (dir == up) { + if (curFramePtr == 0) { + Tcl_SetResult(interp,already_at_top_level,TCL_STATIC); + return TCL_ERROR; + } + level = curFramePtr->level - level; + framePtr = curFramePtr; /* start search here */ + } else { + if (curFramePtr != 0) { + level = curFramePtr->level + level; + } + framePtr = origFramePtr; /* start search here */ + } + } else { + level = curFramePtr->level - 1; + result = 0; + } + + /* + * Figure out which frame to use. + */ + + if (level == 0) { + framePtr = NULL; + } else { + for (;framePtr != NULL; framePtr = framePtr->callerVarPtr) { + if (framePtr->level == level) { + break; + } + } + if (framePtr == NULL) { + goto levelError; + } + } + *framePtrPtr = framePtr; + return result; +} + + +static char *printify(s) +char *s; +{ + static int destlen = 0; + char *d; /* ptr into dest */ + 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 +char * +print_argv(interp,argc,argv) +Tcl_Interp *interp; +int argc; +char *argv[]; +{ + static int buf_width_max = DEFAULT_WIDTH; + static char buf_basic[DEFAULT_WIDTH+1]; /* basic buffer */ + static char *buf = buf_basic; + int space; /* space remaining in buf */ + int len; + char *bufp; + int proc; /* if current command is "proc" */ + int arg_index; + + if (buf_width > buf_width_max) { + if (buf && (buf != buf_basic)) ckfree(buf); + buf = (char *)ckalloc(buf_width + 1); + buf_width_max = buf_width; + } + + proc = (0 == strcmp("proc",argv[0])); + sprintf(buf,"%.*s",buf_width,argv[0]); + len = strlen(buf); + space = buf_width - len; + bufp = buf + len; + argc--; argv++; + arg_index = 1; + + while (argc && (space > 0)) { + char *elementPtr; + 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 */ + /* proc's 2nd arg (the arg list), since people are */ + /* used to always seeing it this way. */ + + if (proc && (arg_index > 1)) wrap = TRUE; + else { + (void) TclFindElement(interp,*argv, +#if TCL_MAJOR_VERSION >= 8 + strlen(*argv), +#endif + &elementPtr, + &nextPtr,(int *)0,(int *)0); + if (*elementPtr == '\0') wrap = TRUE; + else if (*nextPtr == '\0') wrap = FALSE; + else wrap = TRUE; + } + + /* wrap lists (or null) in braces */ + if (wrap) { + sprintf(bufp," {%.*s}",space-3,*argv); + } else { + sprintf(bufp," %.*s",space-1,*argv); + } + len = strlen(buf); + space = buf_width - len; + bufp = buf + len; + argc--; argv++; + arg_index++; + } + + if (compress) { + /* this copies from our static buf to printify's static buf */ + /* and back to our static buf */ + strncpy(buf,printify(buf),buf_width); + } + + /* usually but not always right, but assume truncation if buffer is */ + /* full. this avoids tiny but odd-looking problem of appending "}" */ + /* to truncated lists during {}-wrapping earlier */ + if (strlen(buf) == (size_t) buf_width) { + buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.'; + } + + return(buf); +} + +static +void +PrintStackBelow(interp,curf,viewf) +Tcl_Interp *interp; +CallFrame *curf; /* current FramePtr */ +CallFrame *viewf; /* view FramePtr */ +{ + char ptr; /* graphically indicate where we are in the stack */ + + /* indicate where we are in the stack */ + ptr = ((curf == viewf)?'*':' '); + + if (curf == 0) { + print(interp,"%c0: %s\n", + ptr,print_argv(interp,main_argc,main_argv)); + } else { + PrintStackBelow(interp,curf->callerVarPtr,viewf); +#if TCL_MAJOR_VERSION < 8 + print(interp,"%c%d: %s\n",ptr,curf->level, + print_argv(interp,curf->argc,curf->argv)); +#else + if (1) { + char **argv; + int i, length; + argv = (char **) ckalloc(curf->objc * sizeof(char *)); + for (i = 0; i < curf->objc; i++) { + argv[i] = Tcl_GetStringFromObj(curf->objv[i], + &length); + } + print(interp,"%c%d: %s\n",ptr,curf->level, + print_argv(interp,curf->objc, argv)); + ckfree((char *) argv); + } +#endif + } +} + +static +void +PrintStack(interp,curf,viewf,argc,argv,level) +Tcl_Interp *interp; +CallFrame *curf; /* current FramePtr */ +CallFrame *viewf; /* view FramePtr */ +int argc; +char *argv[]; +char *level; +{ + PrintStackBelow(interp,curf,viewf); + + print(interp," %s: %s\n",level,print_argv(interp,argc,argv)); +} + +/* return 0 if goal matches current frame or goal can't be found */ +/* anywere in frame stack */ +/* else return 1 */ +/* This catches things like a proc called from a Tcl_Eval which in */ +/* turn was not called from a proc but some builtin such as source */ +/* or Tcl_Eval. These builtin calls to Tcl_Eval lose any knowledge */ +/* the FramePtr from the proc, so we have to search the entire */ +/* stack frame to see if it's still there. */ +static int +GoalFrame(goal,iptr) +CallFrame *goal; +Interp *iptr; +{ + CallFrame *cf = iptr->varFramePtr; + + /* if at current level, return success immediately */ + if (goal == cf) return 0; + + while (cf) { + cf = cf->callerVarPtr; + if (goal == cf) { + /* found, but since it's above us, fail */ + return 1; + } + } + return 0; +} + +/* debugger's trace handler */ +/*ARGSUSED*/ +static void +debugger_trap(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv) +ClientData clientData; /* not used */ +Tcl_Interp *interp; +int level; /* positive number if called by Tcl, -1 if */ + /* called by Dbg_On in which case we don't */ + /* know the level */ +char *command; +Tcl_CmdProc *cmdProc; /* not used */ +ClientData cmdClientData; +int argc; +char *argv[]; +{ + char level_text[6]; /* textual representation of level */ + + int break_status; + Interp *iPtr = (Interp *)interp; + + CallFrame *trueFramePtr; /* where the pc is */ + CallFrame *viewFramePtr; /* where up/down are */ + + int print_command_first_time = TRUE; + static int debug_suspended = FALSE; + + struct breakpoint *b; + + /* skip commands that are invoked interactively */ + if (debug_suspended) return; + + /* skip debugger commands */ + if (argv[0][1] == '\0') { + switch (argv[0][0]) { + case 'n': + case 's': + case 'c': + case 'r': + case 'w': + case 'b': + case 'u': + case 'd': return; + } + } + + if ((*ignoreproc)(interp,argv[0])) return; + + /* if level is unknown, use "?" */ + sprintf(level_text,(level == -1)?"?":"%d",level); + + /* save so we can restore later */ + trueFramePtr = iPtr->varFramePtr; + + /* do not allow breaking while testing breakpoints */ + debug_suspended = TRUE; + + /* test all breakpoints to see if we should break */ + /* if any successful breakpoints, start interactor */ + debug_new_action = FALSE; /* reset strobe */ + break_status = FALSE; /* no successful breakpoints yet */ + for (b = break_base;b;b=b->next) { + break_status |= breakpoint_test(interp,command,b); + } + if (break_status) { + if (!debug_new_action) goto start_interact; + + /* if s or n triggered by breakpoint, make "s 1" */ + /* (and so on) refer to next command, not this one */ +/* step_count++;*/ + goto end_interact; + } + + switch (debug_cmd) { + case cont: + goto finish; + case step: + step_count--; + if (step_count > 0) goto finish; + goto start_interact; + case next: + /* check if we are back at the same level where the next */ + /* command was issued. Also test */ + /* against all FramePtrs and if no match, assume that */ + /* we've missed a return, and so we should break */ +/* if (goalFramePtr != iPtr->varFramePtr) goto finish;*/ + if (GoalFrame(goalFramePtr,iPtr)) goto finish; + step_count--; + if (step_count > 0) goto finish; + goto start_interact; + case Next: + /* check if we are back at the same level where the next */ + /* command was issued. */ + if (goalNumLevel < iPtr->numLevels) goto finish; + step_count--; + if (step_count > 0) goto finish; + goto start_interact; + case ret: + /* same comment as in "case next" */ + if (goalFramePtr != iPtr->varFramePtr) goto finish; + goto start_interact; + } + +start_interact: + if (print_command_first_time) { + print(interp,"%s: %s\n", + level_text,print_argv(interp,1,&command)); + print_command_first_time = FALSE; + } + /* since user is typing a command, don't interrupt it immediately */ + debug_cmd = cont; + debug_suspended = TRUE; + + /* interactor won't return until user gives a debugger cmd */ + (*interactor)(interp,interdata); +end_interact: + + /* save this so it can be restored after "w" command */ + viewFramePtr = iPtr->varFramePtr; + + if (debug_cmd == up || debug_cmd == down) { + /* calculate new frame */ + if (-1 == TclGetFrame2(interp,trueFramePtr,viewFrameName, + &iPtr->varFramePtr,debug_cmd)) { + print(interp,"%s\n",interp->result); + Tcl_ResetResult(interp); + } + goto start_interact; + } + + /* reset view back to normal */ + iPtr->varFramePtr = trueFramePtr; + +#if 0 + /* allow trapping */ + debug_suspended = FALSE; +#endif + + switch (debug_cmd) { + case cont: + case step: + goto finish; + case next: + goalFramePtr = iPtr->varFramePtr; + goto finish; + case Next: + goalNumLevel = iPtr->numLevels; + goto finish; + case ret: + goalFramePtr = iPtr->varFramePtr; + if (goalFramePtr == 0) { + print(interp,"nowhere to return to\n"); + break; + } + goalFramePtr = goalFramePtr->callerVarPtr; + goto finish; + case where: + PrintStack(interp,iPtr->varFramePtr,viewFramePtr,argc,argv,level_text); + break; + } + + /* restore view and restart interactor */ + iPtr->varFramePtr = viewFramePtr; + goto start_interact; + + finish: + debug_suspended = FALSE; +} + +/*ARGSUSED*/ +static +int +cmdNext(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + debug_new_action = TRUE; + debug_cmd = *(enum debug_cmd *)clientData; + last_action_cmd = debug_cmd; + + step_count = (argc == 1)?1:atoi(argv[1]); + last_step_count = step_count; + return(TCL_RETURN); +} + +/*ARGSUSED*/ +static +int +cmdDir(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + debug_cmd = *(enum debug_cmd *)clientData; + + if (argc == 1) argv[1] = "1"; + strncpy(viewFrameName,argv[1],FRAMENAMELEN); + + return TCL_RETURN; +} + +/*ARGSUSED*/ +static +int +cmdSimple(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + debug_new_action = TRUE; + debug_cmd = *(enum debug_cmd *)clientData; + last_action_cmd = debug_cmd; + + return TCL_RETURN; +} + +static +void +breakpoint_destroy(b) +struct breakpoint *b; +{ + if (b->file) ckfree(b->file); + if (b->pat) ckfree(b->pat); + if (b->re) ckfree((char *)b->re); + if (b->cmd) ckfree(b->cmd); + + /* unlink from chain */ + if ((b->previous == 0) && (b->next == 0)) { + break_base = 0; + } else if (b->previous == 0) { + break_base = b->next; + b->next->previous = 0; + } else if (b->next == 0) { + b->previous->next = 0; + } else { + b->previous->next = b->next; + b->next->previous = b->previous; + } + + ckfree((char *)b); +} + +static void +savestr(straddr,str) +char **straddr; +char *str; +{ + *straddr = ckalloc(strlen(str)+1); + strcpy(*straddr,str); +} + +/* return 1 if a string is substring of a flag */ +static int +flageq(flag,string,minlen) +char *flag; +char *string; +int minlen; /* at least this many chars must match */ +{ + for (;*flag;flag++,string++,minlen--) { + if (*string == '\0') break; + if (*string != *flag) return 0; + } + if (*string == '\0' && minlen <= 0) return 1; + return 0; +} + +/*ARGSUSED*/ +static +int +cmdWhere(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + if (argc == 1) { + debug_cmd = where; + return TCL_RETURN; + } + + argc--; argv++; + + while (argc) { + if (flageq("-width",*argv,2)) { + argc--; argv++; + if (*argv) { + buf_width = atoi(*argv); + argc--; argv++; + } else print(interp,"%d\n",buf_width); + } else if (flageq("-compress",*argv,2)) { + argc--; argv++; + if (*argv) { + compress = atoi(*argv); + argc--; argv++; + } else print(interp,"%d\n",compress); + } else { + print(interp,"usage: w [-width #] [-compress 0|1]\n"); + return TCL_ERROR; + } + } + return TCL_OK; +} + +#define breakpoint_fail(msg) {error_msg = msg; goto break_fail;} + +/*ARGSUSED*/ +static +int +cmdBreak(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + struct breakpoint *b; + char *error_msg; + + argc--; argv++; + + if (argc < 1) { + for (b = break_base;b;b=b->next) breakpoint_print(interp,b); + return(TCL_OK); + } + + if (argv[0][0] == '-') { + if (argv[0][1] == '\0') { + while (break_base) { + breakpoint_destroy(break_base); + } + breakpoint_max_id = 0; + return(TCL_OK); + } else if (isdigit(argv[0][1])) { + int id = atoi(argv[0]+1); + + for (b = break_base;b;b=b->next) { + if (b->id == id) { + breakpoint_destroy(b); + if (!break_base) breakpoint_max_id = 0; + return(TCL_OK); + } + } + Tcl_SetResult(interp,"no such breakpoint",TCL_STATIC); + return(TCL_ERROR); + } + } + + 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++; + } else { + breakpoint_fail("bad regular expression") + } + } else if (flageq("-glob",argv[0],2)) { + argc--; argv++; + if (argc > 0) { + savestr(&b->pat,argv[0]); + argc--; argv++; + } else { + breakpoint_fail("no pattern?"); + } + } else if ((!(flageq("if",*argv,1)) && (!(flageq("then",*argv,1))))) { + /* look for [file:]line */ + char *colon; + char *linep; /* pointer to beginning of line number */ + + colon = strchr(argv[0],':'); + if (colon) { + *colon = '\0'; + savestr(&b->file,argv[0]); + *colon = ':'; + linep = colon + 1; + } else { + linep = argv[0]; + /* get file from current scope */ + /* savestr(&b->file, ?); */ + } + + if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) { + 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 (argc > 0) { + int do_if = FALSE; + + if (flageq("if",argv[0],1)) { + argc--; argv++; + do_if = TRUE; + } else if (!flageq("then",argv[0],1)) { + do_if = TRUE; + } + + if (do_if) { + if (argc < 1) { + breakpoint_fail("if what"); + } + + savestr(&b->expr,argv[0]); + argc--; argv++; + } + } + + if (argc > 0) { + if (flageq("then",argv[0],1)) { + argc--; argv++; + } + + if (argc < 1) { + breakpoint_fail("then what?"); + } + + savestr(&b->cmd,argv[0]); + } + + sprintf(interp->result,"%d",b->id); + return(TCL_OK); + + break_fail: + breakpoint_destroy(b); + Tcl_SetResult(interp,error_msg,TCL_STATIC); + return(TCL_ERROR); +} + +static char *help[] = { +"s [#] step into procedure", +"n [#] step over procedure", +"N [#] step over procedures, commands, and arguments", +"c continue", +"r continue until return to caller", +"u [#] move scope up level", +"d [#] move scope down level", +" go to absolute frame if # is prefaced by \"#\"", +"w show stack (\"where\")", +"w -w [#] show/set width", +"w -c [0|1] show/set compress", +"b show breakpoints", +"b [-r regexp-pattern] [if expr] [then command]", +"b [-g glob-pattern] [if expr] [then command]", +"b [[file:]#] [if expr] [then command]", +" if pattern given, break if command resembles pattern", +" if # given, break on line #", +" if expr given, break if expr true", +" if command given, execute command at breakpoint", +"b -# delete breakpoint", +"b - delete all breakpoints", +0}; + +/*ARGSUSED*/ +static +int +cmdHelp(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + char **hp; + + for (hp=help;*hp;hp++) { + print(interp,"%s\n",*hp); + } + + return(TCL_OK); +} + +/* occasionally, we print things larger buf_max but not by much */ +/* see print statements in PrintStack routines for examples */ +#define PAD 80 + +/*VARARGS*/ +static void +print TCL_VARARGS_DEF(Tcl_Interp *,arg1) +{ + Tcl_Interp *interp; + char *fmt; + va_list args; + + interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args); + fmt = va_arg(args,char *); + if (!printproc) vprintf(fmt,args); + else { + static int buf_width_max = DEFAULT_WIDTH+PAD; + static char buf_basic[DEFAULT_WIDTH+PAD+1]; + static char *buf = buf_basic; + + if (buf_width+PAD > buf_width_max) { + if (buf && (buf != buf_basic)) ckfree(buf); + buf = (char *)ckalloc(buf_width+PAD+1); + buf_width_max = buf_width+PAD; + } + + vsprintf(buf,fmt,args); + (*printproc)(interp,buf,printdata); + } + va_end(args); +} + +/*ARGSUSED*/ +Dbg_InterStruct +Dbg_Interactor(interp,inter_proc,data) +Tcl_Interp *interp; +Dbg_InterProc *inter_proc; +ClientData data; +{ + Dbg_InterStruct tmp; + + tmp.func = interactor; + tmp.data = interdata; + interactor = (inter_proc?inter_proc:simple_interactor); + interdata = data; + return tmp; +} + +/*ARGSUSED*/ +Dbg_IgnoreFuncsProc * +Dbg_IgnoreFuncs(interp,proc) +Tcl_Interp *interp; +Dbg_IgnoreFuncsProc *proc; +{ + Dbg_IgnoreFuncsProc *tmp = ignoreproc; + ignoreproc = (proc?proc:zero); + return tmp; +} + +/*ARGSUSED*/ +Dbg_OutputStruct +Dbg_Output(interp,proc,data) +Tcl_Interp *interp; +Dbg_OutputProc *proc; +ClientData data; +{ + Dbg_OutputStruct tmp; + + tmp.func = printproc; + tmp.data = printdata; + printproc = proc; + printdata = data; + return tmp; +} + +/*ARGSUSED*/ +int +Dbg_Active(interp) +Tcl_Interp *interp; +{ + return debugger_active; +} + +char ** +Dbg_ArgcArgv(argc,argv,copy) +int argc; +char *argv[]; +int copy; +{ + char **alloc; + + main_argc = argc; + + if (!copy) { + main_argv = argv; + alloc = 0; + } else { + main_argv = alloc = (char **)ckalloc((argc+1)*sizeof(char *)); + while (argc-- >= 0) { + *main_argv++ = *argv++; + } + main_argv = alloc; + } + return alloc; +} + +static struct cmd_list { + char *cmdname; + Tcl_CmdProc *cmdproc; + enum debug_cmd cmdtype; +} cmd_list[] = { + {"n", cmdNext, next}, + {"s", cmdNext, step}, + {"N", cmdNext, Next}, + {"c", cmdSimple, cont}, + {"r", cmdSimple, ret}, + {"w", cmdWhere, none}, + {"b", cmdBreak, none}, + {"u", cmdDir, up}, + {"d", cmdDir, down}, + {"h", cmdHelp, none}, + {0} +}; + +/* this may seem excessive, but this avoids the explicit test for non-zero */ +/* in the caller, and chances are that that test will always be pointless */ +/*ARGSUSED*/ +static int zero(interp,string) +Tcl_Interp *interp; +char *string; +{ + return 0; +} + +static int +simple_interactor(interp, clientData) +Tcl_Interp *interp; +ClientData clientData; +{ + int rc; + char *ccmd; /* pointer to complete command */ + char line[BUFSIZ+1]; /* space for partial command */ + int newcmd = TRUE; + Interp *iPtr = (Interp *)interp; + + Tcl_DString dstring; + Tcl_DStringInit(&dstring); + + newcmd = TRUE; + while (TRUE) { + struct cmd_list *c; + + if (newcmd) { + print(interp,"dbg%d> ",iPtr->numLevels); + } else { + print(interp,"dbg+> "); + } + fflush(stdout); + +#ifdef __WIN32__ + if (1) { + Tcl_Obj *objv[3]; + char *end; + + objv[0] = Tcl_NewStringObj("gets", -1); + objv[1] = Tcl_NewStringObj("stdin", -1); + objv[2] = Tcl_NewStringObj("ExpectTmpDbgVarX0X0X0Y", -1); + rc = Tcl_GetsObjCmd(NULL, interp, 3, objv); + Tcl_DecrRefCount(objv[0]); + Tcl_DecrRefCount(objv[1]); + Tcl_DecrRefCount(objv[2]); + if (rc == TCL_ERROR) { + return TCL_ERROR; + } + if (interp->result[0] == '-') { + Tcl_AppendResult(interp, + "error: stdin is non-blocking, can't debug", NULL); + return TCL_ERROR; + } + rc = strtoul(interp->result, &end, 10); + strcpy(line, interp->result); + } +#else + if (0 >= (rc = read(0,line,BUFSIZ))) { + if (!newcmd) line[0] = 0; + else exit(0); + } else line[rc] = '\0'; +#endif + + ccmd = Tcl_DStringAppend(&dstring,line,rc); + if (!Tcl_CommandComplete(ccmd)) { + newcmd = FALSE; + continue; /* continue collecting command */ + } + newcmd = TRUE; + + /* if user pressed return with no cmd, use previous one */ + if ((ccmd[0] == '\n' || ccmd[0] == '\r') && ccmd[1] == '\0') { + + /* this loop is guaranteed to exit through break */ + for (c = cmd_list;c->cmdname;c++) { + if (c->cmdtype == last_action_cmd) break; + } + + /* recreate textual version of command */ + Tcl_DStringAppend(&dstring,c->cmdname,-1); + + if (c->cmdtype == step || + c->cmdtype == next || + c->cmdtype == Next) { + char num[10]; + + sprintf(num," %d",last_step_count); + Tcl_DStringAppend(&dstring,num,-1); + } + } + +#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4 + rc = Tcl_RecordAndEval(interp,ccmd,0); +#else + rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL); + rc = Tcl_Eval(interp,ccmd); +#endif + Tcl_DStringFree(&dstring); + + switch (rc) { + case TCL_OK: + if (*interp->result != 0) + print(interp,"%s\n",interp->result); + continue; + case TCL_ERROR: + print(interp,"%s\n",Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY)); + /* since user is typing by hand, we expect lots + of errors, and want to give another chance */ + continue; + case TCL_BREAK: + case TCL_CONTINUE: +#define finish(x) {rc = x; goto done;} + finish(rc); + case TCL_RETURN: + finish(TCL_OK); + default: + /* note that ccmd has trailing newline */ + print(interp,"error %d: %s\n",rc,ccmd); + continue; + } + } + /* cannot fall thru here, must jump to label */ + done: + Tcl_DStringFree(&dstring); + + return(rc); +} + +static char init_auto_path[] = "lappend auto_path $dbg_library"; + +static void +init_debugger(interp) +Tcl_Interp *interp; +{ + struct cmd_list *c; + + for (c = cmd_list;c->cmdname;c++) { + Tcl_CreateCommand(interp,c->cmdname,c->cmdproc, + (ClientData)&c->cmdtype,(Tcl_CmdDeleteProc *)0); + } + + debug_handle = Tcl_CreateTrace(interp, + 10000,debugger_trap,(ClientData)0); + + debugger_active = TRUE; + Tcl_SetVar2(interp,Dbg_VarName,"active","1",0); +#ifdef DBG_SCRIPTDIR + Tcl_SetVar(interp,"dbg_library",DBG_SCRIPTDIR,0); +#endif + Tcl_Eval(interp,init_auto_path); + +} + +/* allows any other part of the application to jump to the debugger */ +/*ARGSUSED*/ +void +Dbg_On(interp,immediate) +Tcl_Interp *interp; +int immediate; /* if true, stop immediately */ + /* should only be used in safe places */ + /* i.e., when Tcl_Eval can be called */ +{ + if (!debugger_active) init_debugger(interp); + + debug_cmd = step; + step_count = 1; + + if (immediate) { + static char *fake_cmd = "--interrupted-- (command_unknown)"; + + debugger_trap((ClientData)0,interp,-1,fake_cmd,(Tcl_CmdProc *)0, + (ClientData)0,1,&fake_cmd); +/* (*interactor)(interp);*/ + } +} + +void +Dbg_Off(interp) +Tcl_Interp *interp; +{ + struct cmd_list *c; + + if (!debugger_active) return; + + for (c = cmd_list;c->cmdname;c++) { + Tcl_DeleteCommand(interp,c->cmdname); + } + + Tcl_DeleteTrace(interp,debug_handle); + debugger_active = FALSE; + Tcl_UnsetVar(interp,Dbg_VarName,TCL_GLOBAL_ONLY); +} ADDED generic/Dbg.h Index: generic/Dbg.h ================================================================== --- /dev/null +++ generic/Dbg.h @@ -0,0 +1,60 @@ +/* Dbg.h - Tcl Debugger include file + +Written by: Don Libes, NIST, 3/23/93 + +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. + +*/ + +/* _DEBUG or _DBG is just too likely, use something more unique */ +#ifndef _NIST_DBG +#define _NIST_DBG + +#include "tcl.h" + +typedef int (Dbg_InterProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData data)); +typedef int (Dbg_IgnoreFuncsProc) _ANSI_ARGS_(( + Tcl_Interp *interp, + char *funcname)); +typedef void (Dbg_OutputProc) _ANSI_ARGS_(( + Tcl_Interp *interp, + char *output, + ClientData data)); + +typedef struct { + Dbg_InterProc *func; + ClientData data; +} Dbg_InterStruct; + +typedef struct { + Dbg_OutputProc *func; + ClientData data; +} Dbg_OutputStruct; + +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 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[], + int copy)); +EXTERN int Dbg_Active _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN Dbg_InterStruct Dbg_Interactor _ANSI_ARGS_(( + Tcl_Interp *interp, + Dbg_InterProc *interactor, + ClientData data)); +EXTERN Dbg_IgnoreFuncsProc *Dbg_IgnoreFuncs _ANSI_ARGS_(( + Tcl_Interp *interp, + Dbg_IgnoreFuncsProc *)); +EXTERN Dbg_OutputStruct Dbg_Output _ANSI_ARGS_(( + Tcl_Interp *interp, + Dbg_OutputProc *, + ClientData data)); + +#endif /* _NIST_DBG */ ADDED generic/exp.decls Index: generic/exp.decls ================================================================== --- /dev/null +++ generic/exp.decls @@ -0,0 +1,522 @@ +# ---------------------------------------------------------------------------- +# exp.decls -- +# +# This file contains the declarations for all supported public +# functions that are exported by the Expect library via the stubs table. +# This file is used to generate the expDecls.h, expPlatDecls.h, +# expIntDecls.h, and expStubLib.c files. +# +# ---------------------------------------------------------------------------- +# +# Written by: Don Libes, libes@cme.nist.gov, 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. +# +# Copyright (c) 1997 Mitel Corporation +# work by Gordon Chaffee for the WinNT port. +# +# Copyright (c) 2001-2002 Telindustrie, LLC +# work by David Gravereaux for any Win32 OS. +# +# ---------------------------------------------------------------------------- +# URLs: http://expect.nist.gov/ +# http://expect.sf.net/ +# http://bmrc.berkeley.edu/people/chaffee/expectnt.html +# ---------------------------------------------------------------------------- +# RCS: @(#) $Id: exp.decls,v 1.1.4.6 2002/03/07 02:49:36 davygrvy Exp $ +# ---------------------------------------------------------------------------- + +library exp + +# Define the tcl interface with several sub interfaces: +# expPlat - platform specific public +# expInt - generic private +# expIntPlat - platform specific private + +interface exp +hooks {expPlat expInt expIntPlat} + +# Declare each of the functions in the public Expect interface. Note that +# the an index should never be reused for a different function in order +# to preserve backwards compatibility. + +declare 0 generic { + int Expect_Init (Tcl_Interp *interp) +} +#declare 1 generic { +# int Expect_SafeInit (Tcl_Interp *interp) +#} + +### The command procs. +### +### I'm not sure _exactly_ why, but I think they should be in the Stubs table as +### they are functions. + +#declare 2 generic { +# int Exp_CloseObjCmd (ClientData clientData, Tcl_Interp *interp, +# int argc, char *argv[]) +#} +declare 3 generic { + int Exp_ExpInternalCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +#declare 4 generic { +# int Exp_DisconnectCmd (ClientData clientData, Tcl_Interp *interp, +# int argc, char *argv[]) +#} +declare 5 generic { + int Exp_ExitCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 6 generic { + int Exp_ExpContinueCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +#declare 7 generic { +# int Exp_ForkCmd (ClientData clientData, Tcl_Interp *interp, +# int argc, char *argv[]) +#} +declare 8 generic { + int Exp_ExpPidCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 9 generic { + int Exp_GetpidDeprecatedCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +#declare 10 generic { +# int Exp_InterpreterObjCmd (ClientData clientData, +# Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) +#} +declare 11 generic { + int Exp_LogFileCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 12 generic { + int Exp_LogUserCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 13 generic { + int Exp_OpenCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +#declare 14 generic { +# int Exp_OverlayCmd (ClientData clientData, Tcl_Interp *interp, +# int argc, char *argv[]) +#} +#declare 15 generic { +# int Exp_InterReturnObjCmd (ClientData clientData, +# Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) +#} +#declare 16 generic { +# int Exp_SendObjCmd (ClientData clientData, +# Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]) +#} +declare 17 generic { + int Exp_SendLogCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 18 generic { + int Exp_SleepCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 19 generic { + int Exp_SpawnCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 20 generic { + int Exp_StraceCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 21 generic { + int Exp_WaitCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 22 generic { + int Exp_ExpVersionCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 23 generic { + int Exp_Prompt1Cmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 24 generic { + int Exp_Prompt2Cmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 25 generic { + int Exp_TrapCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 26 generic { + int Exp_SttyCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 27 generic { + int Exp_SystemCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 28 generic { + int Exp_ExpectCmd (ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) +} +declare 29 generic { + int Exp_ExpectGlobalCmd (ClientData clientData, Tcl_Interp *interp, + int argc, Tcl_Obj *CONST objv[]) +} +declare 30 generic { + int Exp_MatchMaxCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 31 generic { + int Exp_RemoveNullsCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 32 generic { + int Exp_ParityCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 33 generic { + int Exp_TimestampCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 34 generic { + int Exp_CloseCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 35 generic { + int Exp_InterpreterCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 36 generic { + int Exp_SendCmd (ClientData clientData, Tcl_Interp *interp, + int argc, char *argv[]) +} +declare 37 generic { + int Exp_KillCmd (ClientData clientData,Tcl_Interp *interp, + int argc, char *argv[]) +} + +### From the old exp_printify.h +declare 40 generic { + char *exp_printify (char *s) +} + +### From the old exp_log.h +declare 50 generic { + void exp_errorlog (char *fmt, ...) +} +declare 51 generic { + void exp_log (int force_stdout, ...) +} +declare 52 generic { + void exp_debuglog (char *fmt, ...) +} +declare 53 generic { + void exp_nflog (char *buf, int force_stdout) +} +declare 54 generic { + void exp_nferrorlog (char *buf, int force_stdout) +} +declare 55 generic { + void exp_error (Tcl_Interp *interp, ...) +} + + +## all below are NOT final -> +declare 60 generic { + void exp_parse_argv (Tcl_Interp *interp, int argc, char **argv) +} +declare 61 generic { + int exp_interpreter (Tcl_Interp *interp) +} +declare 62 generic { + int exp_interpret_cmdfile (Tcl_Interp *interp, Tcl_Channel cmdfile) +} +declare 63 generic { + int exp_interpret_cmdfilename (Tcl_Interp *interp, char *filename) +} +declare 64 generic { + void exp_interpret_rcfiles (Tcl_Interp *interp, int my_rc, int sys_rc) +} +declare 65 generic { + char *exp_cook (CONST char *s, int *len) +} +#declare 66 generic { +# void expCloseOnExec (int fd) +#} +declare 67 generic { + int exp_getpidproc (void) +} +declare 68 generic { + Tcl_Channel ExpCreateSpawnChannel (Tcl_Interp *interp, Tcl_Channel chan) +} +declare 69 generic { + int ExpPlatformSpawnOutput (ClientData instanceData, CONST char *bufPtr, + int toWrite, int *errorPtr) +} +declare 70 generic { + void exp_init_main_cmds (Tcl_Interp *interp) +} +declare 71 generic { + void exp_init_expect_cmds (Tcl_Interp *interp) +} +declare 72 generic { + void exp_init_most_cmds (Tcl_Interp *interp) +} +declare 73 generic { + void exp_init_trap_cmds (Tcl_Interp *interp) +} +declare 74 generic { + void exp_init_interact_cmds (Tcl_Interp *interp) +} +declare 75 generic { + int exp_init_tty_cmds (Tcl_Interp *interp) +} +#declare 76 generic { +# int exp_getpidproc (void) +#} +#declare 77 generic { +# void exp_busy (int fd) +#} +declare 78 generic { + Tcl_Channel ExpCreatePairChannel (Tcl_Interp *interp, CONST char *chanInId, + CONST char *chanOutId, CONST char *chanName) +} +declare 79 generic { + int ExpSpawnOpen (Tcl_Interp *interp, char *chanId, int leaveopen) +} +declare 80 generic { + struct exp_f * exp_update_master (Tcl_Interp *interp ,int opened, + int adjust) +} +declare 81 generic { + CONST char * exp_get_var (Tcl_Interp *interp, char *var) +} +declare 82 generic { + void exp_exit (Tcl_Interp *interp, int status) +} + +### From exp_event.h +declare 83 generic { + int exp_dsleep (Tcl_Interp *interp, double sec) +} +declare 84 generic { + void exp_init_event (void) +} +#declare 85 generic { +# void exp_event_exit (Tcl_Interp *interp) +#} +declare 86 generic { + void exp_background_filehandler (ClientData clientData, int mask) +} +declare 87 generic { + void exp_exit_handlers (ClientData clientData) +} +declare 88 generic { + void exp_close_on_exec (int fd) +} +declare 89 generic { + int exp_flageq_code (char *flag, char *string, int minlen) +} +declare 90 generic { + void exp_close_tcl_files (void) +} +declare 91 generic { + void exp_lowmemcpy (char *dest, CONST char *src, int n) +} +declare 92 generic { + void exp_timestamp (Tcl_Interp *interp, time_t *timeval, char *array) +} + +interface expPlat + +interface expInt + +declare 1 generic { + int Exp_StringMatch (CONST char *string, CONST char *pattern, int *offset) +} +declare 2 generic { + int Exp_StringMatch2 (CONST char *string, CONST char *pattern) +} +#declare 3 generic { +# void exp_console_set (void) +#} +declare 4 generic { + struct exp_i *exp_new_i_complex (Tcl_Interp *interp, char *arg, + int duration, Tcl_VarTraceProc *updateproc, CONST char *msg) +} +declare 5 generic { + struct exp_i *exp_new_i_simple (struct exp_f *fd, int duration) +} +declare 6 generic { + struct exp_fs_list *exp_new_fs (struct exp_f *f) +} +declare 7 generic { + void exp_free_i (Tcl_Interp *interp ,struct exp_i *i, + Tcl_VarTraceProc *updateproc) +} +declare 8 generic { + void exp_free_fs (struct exp_fs_list *fs_first) +} +declare 9 generic { + void exp_free_fs_single (struct exp_fs_list *fs) +} +declare 10 generic { + void exp_i_update (Tcl_Interp *interp, struct exp_i *i) +} +declare 11 generic { + void exp_pty_exit (void) +} +declare 12 generic { + void exp_init_spawn_ids (Tcl_Interp *interp) +} +declare 13 generic { + void exp_init_pty (Tcl_Interp *interp) +} +declare 14 generic { + void exp_init_tty (Tcl_Interp *interp) +} +declare 15 generic { + void exp_init_stdio (void) +} +declare 16 generic { + void exp_init_sig (void) +} +declare 17 generic { + void exp_init_trap (void) +} +declare 18 generic { + void exp_init_unit_random (void) +} +declare 19 generic { + void exp_init_spawn_id_vars (Tcl_Interp *interp) +} +declare 20 generic { + void exp_adjust (struct exp_f *f) +} +declare 21 generic { + void exp_ecmd_remove_f_direct_and_indirect (Tcl_Interp *interp, + struct exp_f *f) +} +declare 22 generic { + void exp_rearm_sigchld (Tcl_Interp *interp) +} +declare 23 generic { + struct exp_f * exp_chan2f (Tcl_Interp *interp, CONST char *chan, + int opened, int adjust, CONST char *msg) +} +declare 24 generic { + int exp_fcheck (Tcl_Interp *interp, struct exp_f *f, int opened, + int adjust, CONST char *msg) +} +declare 25 generic { + int exp_close (Tcl_Interp *interp, struct exp_f *f) +} +declare 26 generic { + void exp_strftime (char *format, const struct tm *timeptr, + Tcl_DString *dstring) +} +declare 27 generic { + void exp_create_commands (Tcl_Interp *interp, struct exp_cmd_data *c) +} +declare 28 generic { + void exp_tty_break (Tcl_Interp *interp, struct exp_f *f) +} +declare 29 generic { + void exp_event_disarm (struct exp_f *f) +} +declare 30 generic { + void exp_arm_background_filehandler (struct exp_f *f) +} +declare 31 generic { + void exp_disarm_background_filehandler (struct exp_f *f) +} +declare 32 generic { + void exp_disarm_background_filehandler_force (struct exp_f *f) +} +declare 33 generic { + void exp_unblock_background_filehandler (struct exp_f *f) +} +declare 34 generic { + void exp_block_background_filehandler (struct exp_f *f) +} +declare 35 generic { + int exp_get_next_event (Tcl_Interp *interp, struct exp_f **masters, int n, + struct exp_f **master_out, int timeout, int key) +} +declare 36 generic { + int exp_get_next_event_info (Tcl_Interp *interp, struct exp_f *fd, int ready_mask) +} +declare 37 generic { + struct exp_f * exp_f_find (Tcl_Interp *interp, char *spawnId) +} +declare 38 generic { + struct exp_f * exp_f_new (Tcl_Interp *interp, Tcl_Channel chan, + char *spawnId, int pid) +} +declare 39 generic { + int exp_f_new_platform (struct exp_f *f) +} +declare 40 generic { + void exp_f_free (struct exp_f *f) +} +declare 41 generic { + void exp_f_free_platform (struct exp_f *f) +} +declare 42 generic { + int exp_exact_write (struct exp_f * f, char *buffer, int rembytes) +} +#declare 43 generic { +# void exp_sys_close (int fd, struct exp_f *f) +#} + + + +interface expIntPlat + +#==================================================================================== +# UNIX specific publics. + + +#==================================================================================== +# WIN32 specific privates. +declare 0 win { + DWORD ExpWinApplicationType(const char *originalName, + Tcl_DString *fullPath) +} +declare 1 win { + DWORD ExpWinCreateProcess (int argc, char *const *argv, HANDLE inputHandle, + HANDLE outputHandle, HANDLE errorHandle, int allocConsole, + int hideConsole, int debug, int newProcessGroup, HANDLE *processPtr, + PDWORD globalPidPtr) +} +declare 2 win { + void ExpWinSyslog (DWORD errId, ...) +} +declare 3 win { + char *ExpSyslogGetSysMsg (DWORD errId) +} +declare 4 win { + Tcl_Pid Exp_WaitPid (Tcl_Pid pid, int *statPtr, int options) +} +declare 5 win { + void Exp_KillProcess (Tcl_Pid pid) +} +declare 6 win { + void ExpWinInit (void) +} +declare 7 win { + void BuildCommandLine (CONST char *executable, int argc, char *const *argv, + Tcl_DString *linePtr) +} + + +#==================================================================================== +# MAC specific publics. + +### We aren't doing Mac... sorry.. + + ADDED generic/exp.h Index: generic/exp.h ================================================================== --- /dev/null +++ generic/exp.h @@ -0,0 +1,219 @@ +/* ---------------------------------------------------------------------------- + * exp.h -- + * + * Public include file for using the Expect extension. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.8 2002/03/06 02:18:20 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#ifndef _EXP +#define _EXP + + +#ifndef _TCL +# include "tcl.h" +#endif + +/* + * Version stuff. + */ + +#define EXP_MAJOR_VERSION 6 +#define EXP_MINOR_VERSION 0 +#define EXP_RELEASE_LEVEL TCL_ALPHA_RELEASE +#define EXP_RELEASE_SERIAL 0 + +#define EXP_VERSION STRINGIFY(JOIN(EXP_MAJOR_VERSION,JOIN(.,EXP_MINOR_VERSION))) + +#if EXP_RELEASE_LEVEL == TCL_ALPHA_RELEASE +# define EXP_PATCH_LEVEL \ + STRINGIFY( \ + JOIN(JOIN(EXP_MAJOR_VERSION, \ + JOIN(., EXP_MINOR_VERSION)), \ + JOIN(a, EXP_RELEASE_SERIAL))) + +#elif EXP_RELEASE_LEVEL == TCL_BETA_RELEASE +# define EXP_PATCH_LEVEL \ + STRINGIFY( \ + JOIN(JOIN(EXP_MAJOR_VERSION, \ + JOIN(., EXP_MINOR_VERSION)), \ + JOIN(b, EXP_RELEASE_SERIAL))) + +#elif EXP_RELEASE_LEVEL == TCL_FINAL_RELEASE +# define EXP_PATCH_LEVEL \ + STRINGIFY( \ + JOIN(JOIN(EXP_MAJOR_VERSION, \ + JOIN(., EXP_MINOR_VERSION)), \ + JOIN(., EXP_RELEASE_SERIAL))) + +#else +# include "bad/release/level/used" +#endif + +/* + * The windows resource compiler defines this by default. Skip the rest of this + * file when included from an rc script. + */ +#ifndef RC_INVOKED + + +#undef TCL_STORAGE_CLASS +#if defined(BUILD_spawndriver) +# define TCL_STORAGE_CLASS +#elif defined(BUILD_exp) +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_EXP_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + + +/* Fix the Borland bug in tcl.h */ +#ifndef TCL_EXTERN +# undef DLLIMPORT +# undef DLLEXPORT +# if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) \ + || (defined(__GNUC__) && defined(__DECLSPEC_SUPPORTED)))) \ + || (defined(MAC_TCL) && FUNCTION_DECLSPEC) +# define DLLIMPORT __declspec(dllimport) +# define DLLEXPORT __declspec(dllexport) +# elif defined(__BORLANDC__) +# define OLD_BORLAND 1 +# define DLLIMPORT __import +# define DLLEXPORT __export +# else +# define DLLIMPORT +# define DLLEXPORT +# endif + /* Avoid name mangling. */ +# ifdef __cplusplus +# define TCL_CPP "C" +# else +# define TCL_CPP +# endif + /* Pre 5.5 Borland requires the attributes be placed after the return type. */ +# if OLD_BORLAND +# define TCL_EXTERN(rtnType) extern TCL_CPP rtnType TCL_STORAGE_CLASS +# else +# define TCL_EXTERN(rtnType) extern TCL_CPP TCL_STORAGE_CLASS rtnType +# endif +#endif + + +/* needed by some exports */ +#ifdef TIME_WITH_SYS_TIME +# include +# include +#else +# ifdef HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif + + +#define SCRIPTDIR "example/" +#define EXECSCRIPTDIR "example/" + + +/* 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 */ + /* usual sense to check errors in system */ + /* calls */ +#define EXP_TIMEOUT -2 +#define EXP_TCLERROR -3 +#define EXP_FULLBUFFER -5 +#define EXP_MATCH -6 +#define EXP_NOMATCH -7 +/*#define EXP_CANTMATCH EXP_NOMATCH +#define EXP_CANMATCH -8*/ +#define EXP_DATA_NEW -9 /* if select says there is new data */ +#define EXP_DATA_OLD -10 /* if we already read data in another cmd */ +#define EXP_EOF -11 +#define EXP_RECONFIGURE -12 /* changes to indirect spawn id lists */ + /* require us to reconfigure things */ + +/* in the unlikely event that a signal handler forces us to return this */ +/* through expect's read() routine, we temporarily convert it to this. */ +#define EXP_TCLRET -20 +#define EXP_TCLCNT -21 +#define EXP_TCLCNTTIMER -22 +#define EXP_TCLBRK -23 +#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 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 + + +/* + * Include the public function declarations that are accessible via + * the stubs table. + */ + +#include "expDecls.h" + +/* + * Include platform specific public function declarations that are + * accessible via the stubs table. + */ + +#include "expPlatDecls.h" + +/* + * Exp_InitStubs is used by apps/extensions that want to link + * against the expect stubs library. If we are not using stubs, + * then this won't be declared. + */ + +#ifdef USE_EXP_STUBS +extern TCL_CPP +CONST char *Exp_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, + int exact)); +#endif + + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* RC_INVOKED */ +#endif /* _EXP */ ADDED generic/expChan.c Index: generic/expChan.c ================================================================== --- /dev/null +++ generic/expChan.c @@ -0,0 +1,673 @@ +/* ---------------------------------------------------------------------------- + * expChan.c -- + * + * Implements the exp_pair channel id. What this really does + * is wrap the input and output channels into a single, duplex + * channel. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +static void ExpPairInputCloseHandler _ANSI_ARGS_((ClientData clientData)); +static void ExpPairOutputCloseHandler _ANSI_ARGS_((ClientData clientData)); + +static Tcl_DriverCloseProc ExpPairClose; +static Tcl_DriverInputProc ExpPairInput; +static Tcl_DriverOutputProc ExpPairOutput; +static Tcl_DriverSetOptionProc ExpPairSetOption; +static Tcl_DriverGetOptionProc ExpPairGetOption; +static Tcl_DriverWatchProc ExpPairWatch; +static Tcl_DriverGetHandleProc ExpPairGetHandle; +static Tcl_DriverBlockModeProc ExpPairBlock; +static void ExpPairReadable _ANSI_ARGS_((ClientData clientData, int mask)); +static void ExpPairWritable _ANSI_ARGS_((ClientData clientData, int mask)); + +static Tcl_ChannelType ExpPairChannelType = { + "exp_pair", + TCL_CHANNEL_VERSION_2, + ExpPairClose, + ExpPairInput, + ExpPairOutput, + NULL, /* Can't seek! */ + ExpPairSetOption, + ExpPairGetOption, + ExpPairWatch, + ExpPairGetHandle, + 0, + ExpPairBlock, + 0, + 0 +}; + +typedef struct { + Tcl_Channel thisChannelPtr; /* The toplevel channel */ + Tcl_Channel inChannelPtr; /* The input child channel */ + Tcl_Channel outChannelPtr; /* The output child channel */ + int watchMask; /* Events that are being checked for */ + int blockingPropagate; /* Propagate a blocking option to children */ +} ExpPairState; + +static int expPairCount = 0; +static int initialized = 0; + +/* + *---------------------------------------------------------------------- + * + * ExpPairInit -- + * + * Initialize the pair event mechanism. Currently, it + * does nothing because it may not be needed. If it is + * needed, it will need to call platform specific event + * code. + * + * Results: + * None + * + * Side Effects: + * None currently + * + *---------------------------------------------------------------------- + */ + +static void +ExpPairInit() +{ + initialized = 1; +} + +/* + *---------------------------------------------------------------------- + * + * ExpCreatePairChannel -- + * + * Routine that wraps an input channel and an output channel + * into a single channel. By default, no translation or buffering + * occurs in this channel. + * + * Results: + * A Tcl_Channel. + * + * Side Effects: + * Allocates memory. + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +ExpCreatePairChannel(interp, chanInId, chanOutId, chanName) + Tcl_Interp *interp; + CONST char *chanInId; + CONST char *chanOutId; + CONST char *chanName; /* Name of resulting channel to create. + * If NULL, it gets created here */ +{ + Tcl_Channel chanIn, chanOut, chan; + ExpPairState *ssPtr; + char channelNameStr[10]; + int mode; + + chanIn = Tcl_GetChannel(interp, chanInId, &mode); + if (chanIn) { + if ((mode & TCL_READABLE) == 0) { + Tcl_AppendResult(interp, chanInId, " is not a readable channel", + (char *) NULL); + return NULL; + } + } else { + return NULL; + } + + chanOut = Tcl_GetChannel(interp, chanOutId, &mode); + if (chanOut) { + if ((mode & TCL_WRITABLE) == 0) { + Tcl_AppendResult(interp, chanInId, " is not a writable channel", + (char *) NULL); + return NULL; + } + } else { + return NULL; + } + + if (chanName == NULL) { + sprintf(channelNameStr, "exp_pair%d", expPairCount++); + chanName = channelNameStr; + } + ssPtr = (ExpPairState *) ckalloc(sizeof(ExpPairState)); + ssPtr->inChannelPtr = chanIn; + ssPtr->outChannelPtr = chanOut; + + /* + * Setup the expect channel to always flush immediately + */ + + if (chanName == NULL) { + sprintf(channelNameStr, "exp_pair%d", expPairCount++); + chanName = channelNameStr; + } + chan = Tcl_CreateChannel(&ExpPairChannelType, chanName, + (ClientData) ssPtr, TCL_READABLE|TCL_WRITABLE); + if (chan == NULL) { + free(ssPtr); + return NULL; + } + ssPtr->thisChannelPtr = chan; + ssPtr->watchMask = 0; + ssPtr->blockingPropagate = 0; + + Tcl_CreateCloseHandler(chanIn, ExpPairInputCloseHandler, + (ClientData) ssPtr); + Tcl_CreateCloseHandler(chanOut, ExpPairOutputCloseHandler, + (ClientData) ssPtr); + + Tcl_SetChannelOption(interp, chan, "-buffering", "none"); + Tcl_SetChannelOption(interp, chan, "-translation","binary"); + Tcl_SetChannelOption(interp, chan, "-blockingpropagate", "off"); + Tcl_SetChannelOption(interp, chan, "-blocking", "off"); + return chan; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairInputCloseHandler -- + * + * This gets called when the underlying input channel is closed. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +static void +ExpPairInputCloseHandler(clientData) + ClientData clientData; +{ + ExpPairState *ssPtr = (ExpPairState *) clientData; + ssPtr->inChannelPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairOutputCloseHandler -- + * + * This gets called when the underlying output channel is closed. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +static void +ExpPairOutputCloseHandler(clientData) + ClientData clientData; +{ + ExpPairState *ssPtr = (ExpPairState *) clientData; + ssPtr->outChannelPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairBlock -- + * + * Generic routine to set I/O to blocking or non-blocking. + * + * Results: + * TCL_OK or TCL_ERROR. + * + * Side Effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpPairBlock(instanceData, mode) + ClientData instanceData; + int mode; /* (in) Block or not */ +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + Tcl_Channel inChannelPtr = ssPtr->inChannelPtr; + Tcl_Channel outChannelPtr = ssPtr->outChannelPtr; + int ret; + + if (! ssPtr->blockingPropagate) { + return TCL_OK; + } + if (inChannelPtr && Tcl_GetChannelType(inChannelPtr)->blockModeProc) { + ret = (Tcl_GetChannelType(inChannelPtr)->blockModeProc) + (Tcl_GetChannelInstanceData(inChannelPtr), mode); + if (ret == TCL_ERROR) { + return ret; + } + } + if (outChannelPtr && Tcl_GetChannelType(outChannelPtr)->blockModeProc) { + return (Tcl_GetChannelType(outChannelPtr)->blockModeProc) + (Tcl_GetChannelInstanceData(outChannelPtr), mode); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairInput -- + * + * Generic read routine for expect console + * + * Returns: + * Amount read or -1 with errorcode in errorPtr. + * + * Side Effects: + * Buffer is updated. + * + *---------------------------------------------------------------------- + */ + +static int +ExpPairInput(instanceData, bufPtr, bufSize, errorPtr) + ClientData instanceData; + char *bufPtr; /* (in) Ptr to buffer */ + int bufSize; /* (in) sizeof buffer */ + int *errorPtr; /* (out) error code */ +{ + ExpPairState *ssPtr = (ExpPairState *)instanceData; + Tcl_Channel channelPtr = ssPtr->inChannelPtr; + + if (! channelPtr) { + *errorPtr = EPIPE; + return -1; + } + + if (channelPtr && Tcl_GetChannelType(channelPtr)->inputProc) { + return (Tcl_GetChannelType(channelPtr)->inputProc) + (Tcl_GetChannelInstanceData(channelPtr), bufPtr, bufSize, errorPtr); + } + *errorPtr = EINVAL; + return -1; +} + + +/* + *---------------------------------------------------------------------- + * + * ExpPairOutput -- + * + * Write routine for expect console + * + * Results: + * Amount written or -1 with errorcode in errorPtr + * + * Side Effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpPairOutput(instanceData, bufPtr, toWrite, errorPtr) + ClientData instanceData; + CONST char *bufPtr; /* (in) Ptr to buffer */ + int toWrite; /* (in) amount to write */ + int *errorPtr; /* (out) error code */ +{ + ExpPairState *ssPtr = (ExpPairState *)instanceData; + Tcl_Channel channelPtr = ssPtr->outChannelPtr; + + if (! channelPtr) { + *errorPtr = EPIPE; + return -1; + } + + if (channelPtr && (Tcl_GetChannelType(channelPtr)->outputProc)) { + return (Tcl_GetChannelType(channelPtr)->outputProc) + (Tcl_GetChannelInstanceData(channelPtr), bufPtr, toWrite, errorPtr); + } + *errorPtr = EINVAL; + return -1; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairClose -- + * + * Generic routine to close the expect console + * + * Results: + * 0 if successful or a POSIX errorcode with + * interp updated. + * + * Side Effects: + * Channel is deleted. + * + *---------------------------------------------------------------------- + */ + +static int +ExpPairClose(instanceData, interp) + ClientData instanceData; + Tcl_Interp *interp; +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + if (ssPtr->inChannelPtr) { + Tcl_DeleteCloseHandler(ssPtr->inChannelPtr, ExpPairOutputCloseHandler, + (ClientData) ssPtr); + } + if (ssPtr->outChannelPtr) { + Tcl_DeleteCloseHandler(ssPtr->inChannelPtr, ExpPairOutputCloseHandler, + (ClientData) ssPtr); + } + ckfree((char *)ssPtr); + + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * + * ExpPairSetOption -- + * + * Set the value of an ExpPair channel option + * + * Results: + * TCL_OK and dsPtr updated with the value or TCL_ERROR. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpPairSetOption(instanceData, interp, nameStr, valStr) + ClientData instanceData; + Tcl_Interp *interp; + CONST char *nameStr; /* (in) Name of option */ + CONST char *valStr; /* (in) New value of option */ +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + Tcl_Channel inChannelPtr = ssPtr->inChannelPtr; + Tcl_Channel outChannelPtr = ssPtr->outChannelPtr; + int ret1, ret2; + Tcl_DString dString; + int len; + int newMode; + + len = strlen(nameStr); + if (strcmp(nameStr, "-blockingpropagate") == 0) { + if (Tcl_GetBoolean(interp, valStr, &newMode) == TCL_ERROR) { + return TCL_ERROR; + } + ssPtr->blockingPropagate = newMode; + return TCL_OK; + } + + /* + * If the option can be applied to either channel, the result is OK. + */ + ret1 = ret2 = TCL_OK; + if (inChannelPtr && (Tcl_GetChannelType(inChannelPtr)->setOptionProc)) { + ret1 = (Tcl_GetChannelType(inChannelPtr)->setOptionProc) + (Tcl_GetChannelInstanceData(inChannelPtr), interp, nameStr, valStr); + } + if (outChannelPtr && (Tcl_GetChannelType(outChannelPtr)->setOptionProc)) { + Tcl_DStringInit(&dString); + Tcl_DStringGetResult(interp, &dString); + ret2 = (Tcl_GetChannelType(outChannelPtr)->setOptionProc) + (Tcl_GetChannelInstanceData(outChannelPtr), interp, nameStr, valStr); + if (ret1 == TCL_OK && ret2 != TCL_OK) { + Tcl_DStringResult(interp, &dString); + } + Tcl_DStringFree(&dString); + } + + if (ret1 == TCL_OK && ret2 == TCL_OK) { + return TCL_OK; + } + return TCL_ERROR; +} + + +/* + *---------------------------------------------------------------------- + * + * ExpPairGetOption -- + * + * Queries ExpPair channel for the current value of + * the given option. + * + * Results: + * TCL_OK and dsPtr updated with the value or TCL_ERROR. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpPairGetOption(instanceData, interp, nameStr, dsPtr) + ClientData instanceData; + Tcl_Interp *interp; + CONST char *nameStr; /* (in) Name of option to retrieve */ + Tcl_DString *dsPtr; /* (in) String to place value */ +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + Tcl_Channel inChannelPtr = ssPtr->inChannelPtr; + Tcl_Channel outChannelPtr = ssPtr->outChannelPtr; + int ret; + int len; + + len = nameStr ? strlen(nameStr) : 0; + + if (strcmp(nameStr, "-blockingpropagate") == 0) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-blockingpropagate"); + } + Tcl_DStringAppendElement(dsPtr, + (ssPtr->blockingPropagate) ? "0" : "1"); + if (len > 0) { + return TCL_OK; + } + } + + if (inChannelPtr && (Tcl_GetChannelType(inChannelPtr)->getOptionProc)) { + ret = (Tcl_GetChannelType(inChannelPtr)->getOptionProc) + (Tcl_GetChannelInstanceData(inChannelPtr), interp, nameStr, dsPtr); + if (ret == TCL_OK) { + return ret; + } + } + if (outChannelPtr && (Tcl_GetChannelType(outChannelPtr)->getOptionProc)) { + return (Tcl_GetChannelType(outChannelPtr)->getOptionProc) + (Tcl_GetChannelInstanceData(outChannelPtr), interp, nameStr, dsPtr); + } + + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairGetHandle -- + * + * Get the Tcl_File for the appropriate direction in from the + * Tcl_Channel. + * + * Results: + * NULL because ExpPair ids are handled through other channel + * types. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpPairGetHandle(instanceData, direction, handlePtr) + ClientData instanceData; + int direction; + ClientData *handlePtr; +{ + Tcl_Channel inChannelPtr = ((ExpPairState *)instanceData)->inChannelPtr; + Tcl_Channel outChannelPtr = ((ExpPairState *)instanceData)->outChannelPtr; + + if (direction == TCL_READABLE) { + if (inChannelPtr && (Tcl_GetChannelType(inChannelPtr)->getHandleProc)) { + return (Tcl_GetChannelType(inChannelPtr)->getHandleProc) + (Tcl_GetChannelInstanceData(inChannelPtr), direction, handlePtr); + } else { + *handlePtr = NULL; + return TCL_ERROR; + } + } else { + if (outChannelPtr && (Tcl_GetChannelType(outChannelPtr)->getHandleProc)) { + return (Tcl_GetChannelType(outChannelPtr)->getHandleProc) + (Tcl_GetChannelInstanceData(outChannelPtr), direction, handlePtr); + } else { + *handlePtr = NULL; + return TCL_ERROR; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairWatch -- + * + * Sets up event handling on a expect console Tcl_Channel using + * the underlying channel type. + * + * Results: + * Nothing + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +void +ExpPairWatch(instanceData, mask) + ClientData instanceData; + int mask; +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + Tcl_Channel inChannelPtr = ssPtr->inChannelPtr; + Tcl_Channel outChannelPtr = ssPtr->outChannelPtr; + int old_mask = ssPtr->watchMask; + + if (mask & TCL_READABLE) { + if (inChannelPtr && (Tcl_GetChannelType(inChannelPtr)->watchProc)) { + (Tcl_GetChannelType(inChannelPtr)->watchProc) + (Tcl_GetChannelInstanceData(inChannelPtr), mask & (~TCL_WRITABLE)); + } + if (! (old_mask & TCL_READABLE)) { + Tcl_CreateChannelHandler(inChannelPtr, TCL_READABLE, + ExpPairReadable, instanceData); + } + } else if (old_mask & TCL_READABLE) { + Tcl_DeleteChannelHandler(inChannelPtr, ExpPairReadable, instanceData); + } + if (mask & TCL_WRITABLE) { + if (outChannelPtr && (Tcl_GetChannelType(outChannelPtr)->watchProc)) { + (Tcl_GetChannelType(outChannelPtr)->watchProc) + (Tcl_GetChannelInstanceData(outChannelPtr), mask & (~TCL_READABLE)); + } + if (! (old_mask & TCL_WRITABLE)) { + Tcl_CreateChannelHandler(outChannelPtr, TCL_WRITABLE, + ExpPairWritable, instanceData); + } + } else if (old_mask & TCL_WRITABLE) { + Tcl_DeleteChannelHandler(outChannelPtr, ExpPairWritable, instanceData); + } + ssPtr->watchMask = mask; + return; +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairReadable -- + * + * Callback when an event occurs in the input channel. + * + * Results: + * None + * + * Side Effects: + * An event is generated for this channel. + * + *---------------------------------------------------------------------- + */ + +static void +ExpPairReadable(ClientData instanceData, int mask) +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + Tcl_Channel channel = ssPtr->thisChannelPtr; + + if (! initialized) { + initialized = 1; + ExpPairInit(); + } + Tcl_NotifyChannel(channel, mask); +} + +/* + *---------------------------------------------------------------------- + * + * ExpPairWritable -- + * + * Callback when an event occurs in the output channel. + * + * Results: + * None + * + * Side Effects: + * An event is generated for this channel. + * + *---------------------------------------------------------------------- + */ + +static void +ExpPairWritable(ClientData instanceData, int mask) +{ + ExpPairState *ssPtr = (ExpPairState *) instanceData; + Tcl_Channel channel = ssPtr->thisChannelPtr; + + if (!initialized) { + initialized = 1; + ExpPairInit(); + } + Tcl_NotifyChannel(channel, mask); +} ADDED generic/expChannel.c Index: generic/expChannel.c ================================================================== --- /dev/null +++ generic/expChannel.c @@ -0,0 +1,386 @@ +/* + * expChannel.c -- + * + * Implements the Expect_Channel + * + * XXX: This has not been implemented yet but the idea is this: + * Change expect to use channel ids instead of just expect ids. + * This allows more flexibility. + * + * Copyright (c) 1997 by Mitel Corporation + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + */ + +#include "exp_port.h" +#include "tclInt.h" +#include "tclPort.h" + +int ExpectBlock _ANSI_ARGS_((ClientData instanceData, + int mode)); +int ExpectInput _ANSI_ARGS_((ClientData instanceData, + char *bufPtr, int bufSize, int *errorPtr)); +int ExpectOutput _ANSI_ARGS_((ClientData instanceData, + char *bufPtr, int toWrite, int *errorPtr)); +int ExpectClose _ANSI_ARGS_((ClientData instanceData, + Tcl_Interp *interp)); +int ExpectSetOption _ANSI_ARGS_((ClientData instanceData, + Tcl_Interp *interp, char *nameStr, char *val)); +int ExpectGetOption _ANSI_ARGS_((ClientData instanceData, + char *nameStr, Tcl_DString *dsPtr)); +Tcl_File ExpectGetFile _ANSI_ARGS_((ClientData instanceData, + int direction)); +int ExpectReady _ANSI_ARGS_((ClientData instanceData, + int direction)); +void ExpectWatch _ANSI_ARGS_((ClientData instanceData, + int mask)); + +static Tcl_ChannelType expectChannelType = { + "expect", + ExpectBlock, + ExpectClose, + ExpectInput, + ExpectOutput, + NULL, /* Can't seek! */ + ExpectSetOption, + ExpectGetOption, + ExpectWatch, + ExpectReady, + ExpectGetFile +}; + + +/* + *---------------------------------------------------------------------- + * + * ExpOpenExpectChannel -- + * + * Generic routine to open a expect channel + * + * Results: + * A Tcl_Channel. + * + * Side Effects: + * Allocates memory. + * + * Notes: + * XXX: This will be called from Exp_SpawnCmd() to create a new + * channel. + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +ExpOpenExpectChannel(interp, argc, argv) + Tcl_Interp *interp; + int argc; + char **argv; +{ + Tcl_Channel chan; + ExpectState *ssPtr; + char devStr[15]; + char channelNameStr[10]; + + /* + * XXX: A bunch of other stuff should be done here first + */ + + ssPtr = (ExpectState *) ckalloc(sizeof(ExpectState)); + if (ExppOpenExpectChannel(interp, (ClientData)ssPtr, devStr, flags) + != TCL_OK) { + ckfree((char *)ssPtr); + return NULL; + } + ssPtr->theFile = Tcl_GetFile((ClientData)ssPtr->fd, EXPECT_HANDLE); + + /* + * Setup the expect channel to always flush immediately + */ + + sprintf(channelNameStr, "expect%d", expectCount++); + chan = Tcl_CreateChannel(&expectChannelType, channelNameStr, + (ClientData) ssPtr, mode); + + if (Tcl_SetChannelOption(interp, chan, "-buffering", "none") + != TCL_OK) { + ExpClose(interp, chan); + return NULL; + } + + return chan; + +arg_missing: + Tcl_AppendResult(interp, "Value for \"", argv[i], + "\" missing", NULL); + return NULL; +} + + +/* + *---------------------------------------------------------------------- + * + * ExpectBlock -- + * + * Generic routine to set I/O to blocking or non-blocking. + * + * Results: + * TCL_OK or TCL_ERROR. + * + * Side Effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpectBlock(instanceData, mode) + ClientData instanceData; + int mode; /* (in) Block or not */ +{ + return ExppExpectBlock(instanceData, mode); +} + + +/* + *---------------------------------------------------------------------- + * + * ExpectInput -- + * + * Generic read routine for expect ports + * + * Returns: + * Amount read or -1 with errorcode in errorPtr. + * + * Side Effects: + * Buffer is updated. + * + *---------------------------------------------------------------------- + */ + +int +ExpectInput(instanceData, bufPtr, bufSize, errorPtr) + ClientData instanceData; + char *bufPtr; /* (in) Ptr to buffer */ + int bufSize; /* (in) sizeof buffer */ + int *errorPtr; /* (out) error code */ +{ + Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr; + + return (Tcl_GetChannelType(channelPtr)->inputProc) + (Tcl_GetChannelInstanceData(channelPtr), bufPtr, bufSize, errorPtr); +} + + +/* + *---------------------------------------------------------------------- + * + * ExpectOutput -- + * + * Generic write routine for expect ports + * + * Results: + * Amount written or -1 with errorcode in errorPtr + * + * Side Effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpectOutput(instanceData, bufPtr, toWrite, errorPtr) + ClientData instanceData; + char *bufPtr; /* (in) Ptr to buffer */ + int toWrite; /* (in) amount to write */ + int *errorPtr; /* (out) error code */ +{ + Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr; + + return (Tcl_GetChannelType(channelPtr)->outputProc) + (Tcl_GetChannelInstanceData(channelPtr), bufPtr, toWrite, errorPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ExpectClose -- + * + * Generic routine to close the expect port + * + * Results: + * 0 if successful or a POSIX errorcode with + * interp updated. + * + * Side Effects: + * Channel is deleted. + * + *---------------------------------------------------------------------- + */ + +int +ExpectClose(instanceData, interp) + ClientData instanceData; + Tcl_Interp *interp; +{ + ExpectState *ssPtr = (ExpectState *) instanceData; + int rc = TCL_OK; + + rc = ExppExpectClose(instanceData); + if ((rc != 0) && (interp != NULL)) { + Tcl_SetErrno(rc); + Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_VOLATILE); + } + Tcl_FreeFile(ssPtr->theFile); + ckfree((char *)ssPtr); + return rc; +} + + +/* + *---------------------------------------------------------------------- + * + * ExpectSetOption -- + * + * Set the value of an expect channel option + * + * Results: + * TCL_OK and dsPtr updated with the value or TCL_ERROR. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpectSetOption(instanceData, interp, nameStr, valStr) + ClientData instanceData; + Tcl_Interp *interp; + char *nameStr; /* (in) Name of option */ + char *valStr; /* (in) New value of option */ +{ + ExpectState *ssPtr = (ExpectState *) instanceData; + int optVal, option; + char errorStr[80]; + int optBool; + + Tcl_AppendResult (interp, "Illegal option \"", nameStr, + "\" -- must be a standard channel option", NULL); + return TCL_ERROR; +} + + +/* + *---------------------------------------------------------------------- + * + * ExpectGetOption -- + * + * Queries expect channel for the current value of + * the given option. + * + * Results: + * TCL_OK and dsPtr updated with the value or TCL_ERROR. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpectGetOption(instanceData, nameStr, dsPtr) + ClientData instanceData; + char *nameStr; /* (in) Name of option to retrieve */ + Tcl_DString *dsPtr; /* (in) String to place value */ +{ + ExpectState *ssPtr = (ExpectState *) instanceData; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ExpectGetFile -- + * + * Get the Tcl_File for the appropriate direction in from the + * Tcl_Channel. + * + * Results: + * NULL because expect ids are handled through other channel + * types. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_File +ExpectGetFile(instanceData, direction) + ClientData instanceData; + int direction; +{ + return (Tcl_File)NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ExpectReady -- + * + * Determines whether expect port has data to be + * read or is OK for writing. + * + * Results: + * A bitmask of the events that were found by checking the + * underlying channel. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpectReady(instanceData, direction) + ClientData instanceData; + int direction; +{ + Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr; + + return (Tcl_GetChannelType(channelPtr)->channelReadyProc) + (Tcl_GetChannelInstanceData(channelPtr), mask); +} + +/* + *---------------------------------------------------------------------- + * + * ExpectWatch -- + * + * Sets up event handling on a expect port Tcl_Channel using + * the underlying channel type. + * + * Results: + * Nothing + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +void +ExpectWatch(instanceData, mask) + ClientData instanceData; + int mask; +{ + Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr; + + (Tcl_GetChannelType(channelPtr)->watchChannelProc) + (Tcl_GetChannelInstanceData(channelPtr), mask); + return; +} + ADDED generic/expCommand.c Index: generic/expCommand.c ================================================================== --- /dev/null +++ generic/expCommand.c @@ -0,0 +1,2824 @@ +/* ---------------------------------------------------------------------------- + * expCommand.c -- + * + * The bulk of the Expect commands, platform generic. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expCommand.c,v 1.1.2.1.2.4 2002/02/10 12:04:22 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" +#include + +/* Tcl needs commands in writable space (or at least used to) */ +static char close_cmd[] = "close"; + +/* + * exp_configure_count is incremented whenever a spawned process is closed + * or an indirect list is modified. This forces any (stack of) expect or + * 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?"; + +/* + * 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 + * reexamine the state of the spawned process. + */ +int expect_key = 0; + +/* + * The table is used to map channels to exp_f structures. + */ +Tcl_HashTable *exp_f_table = NULL; + +/* + * The 'exp_any' spawn identifier + */ +struct exp_f *exp_f_any = NULL; + +static void tcl_tracer _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int level, char *command, + Tcl_CmdProc *cmdProc, ClientData cmdClientData, + int argc, char *argv[])); +static void exp_i_add_f _ANSI_ARGS_((struct exp_i *, + struct exp_f *fs)); +static void exp_f_closed _ANSI_ARGS_((struct exp_f *)); + + +/* + *---------------------------------------------------------------------- + * + * exp_error -- + * + * Formats an error message into the interp. Do not terminate + * format strings with \n!!!. + * + * Results: + * None + * + * Side Effects: + * An error message is written into interp->result + * + *---------------------------------------------------------------------- + */ + +void +exp_error TCL_VARARGS_DEF(Tcl_Interp *,arg1) +{ + Tcl_Interp *interp; + char *fmt; + va_list args; + + interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args); + fmt = va_arg(args,char *); + vsprintf(interp->result,fmt,args); + va_end(args); +} + +/* + *---------------------------------------------------------------------- + * + * exp_wait_zero -- + * + * Zero out the wait status field + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ +static void +exp_wait_zero(status) + WAIT_STATUS_TYPE *status; +{ + int i; + + for (i=0;iuser_closed)) { + if (adjust) { + exp_adjust(f); + } + return 1; + } + + exp_error(interp,"%s: invalid spawn id (%s)", msg, f->spawnId); + return(0); +} + +/* + *---------------------------------------------------------------------- + * + * exp_chan2f -- + * + * For a given channel name, returns the exp_f structure + * for that channel. + * + * Results: + * An exp_f structure if found and usable, NULL if not. + * + * Side Effects: + * None + * + *---------------------------------------------------------------------- + */ + +struct exp_f * +exp_chan2f(interp,chan,opened,adjust,msg) + Tcl_Interp *interp; + CONST char *chan; /* Channel name */ + int opened; /* check not closed */ + int adjust; /* adjust buffer sizes */ + CONST char *msg; +{ + Tcl_HashEntry *hPtr; + struct exp_f *f; + + hPtr = Tcl_FindHashEntry(exp_f_table, chan); + if (hPtr != NULL) { + f = (struct exp_f *) Tcl_GetHashValue(hPtr); + if ((!opened) || !f->user_closed) { + if (adjust) { + exp_adjust(f); + } + return f; + } + } + exp_error(interp,"%s: invalid spawn id (%s)",msg,chan); + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * exp_close -- + * + * Close a connection. + * + * Results: + * None + * + * Side Effects: + * A native file handle is closed + * + *---------------------------------------------------------------------- + */ + +int +exp_close(interp, f) + Tcl_Interp *interp; + struct exp_f *f; +{ + /* + * Check if this is an id that should never be deleted + */ + if (f->alwaysopen) { + exp_error(interp, "cannot close permanent id %s", f->spawnId); + return TCL_ERROR; + } + + f->user_closed = TRUE; + + if (! f->leaveopen) { + /* + * Tcl_UnregisterChannel() will call Tcl_Close() if needed + */ + if (f->channel) { + return Tcl_UnregisterChannel(interp, f->channel); + } + return TCL_OK; + } else { + if (--f->leaveopen >= 0) { + return TCL_OK; + } + if (f->channel) { + Tcl_DeleteCloseHandler(f->channel, (Tcl_CloseProc *) exp_f_closed, + (ClientData) f); + } + exp_f_closed(f); + } + + return(TCL_OK); +} + +/* + *---------------------------------------------------------------------- + * + * exp_f_find -- + * + * Try to find an existing exp_f structure in the spawn id table. + * + * Results: + * The structure if found, NULL if not. + * + *---------------------------------------------------------------------- + */ + +struct exp_f * +exp_f_find(interp,spawnId) + Tcl_Interp *interp; + char *spawnId; +{ + Tcl_HashEntry *hPtr; + + hPtr = Tcl_FindHashEntry(exp_f_table, spawnId); + if (! hPtr) { + return NULL; + } + return (struct exp_f *) Tcl_GetHashValue(hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * exp_f_new -- + * + * Create a new exp_f structure for a given channel and enter + * it into the spawn id hash table. If spawnId is given, it + * is entered under that name. If not, it is entered under + * the channel identifier. This means that either a channel + * and/or a spawnId must be passed in. + * + * Results: + * The new structure if successful, NULL if not. + * + *---------------------------------------------------------------------- + */ + +struct exp_f * +exp_f_new(interp,chan,spawnId,pid) + Tcl_Interp *interp; + Tcl_Channel chan; + char *spawnId; + int pid; +{ + struct exp_f *f; + Tcl_HashEntry *hPtr; + int new; + + if (!chan && !spawnId) { + return NULL; + } + + spawnId = spawnId ? spawnId : Tcl_GetChannelName(chan); + hPtr = Tcl_CreateHashEntry(exp_f_table, spawnId, &new); + if (!new) { + panic("Exp_SpawnCmd: old entry found in table"); + f = (struct exp_f *) Tcl_GetHashValue(hPtr); + return f; + } + + f = (struct exp_f *) ckalloc(sizeof(struct exp_f)); + f->interp = interp; + f->pid = pid; + f->size = 0; + f->msize = 0; + f->buffer = 0; + f->printed = 0; + f->echoed = 0; + f->rm_nulls = exp_default_rm_nulls; + f->parity = exp_default_parity; + f->key = expect_key++; + f->force_read = FALSE; + f->fg_armed = FALSE; + f->umsize = exp_default_match_max; + f->valid = TRUE; + f->user_closed = FALSE; + f->user_waited = (EXP_NOPID == pid) ? TRUE : FALSE; + f->sys_waited = (EXP_NOPID == pid) ? TRUE : FALSE; + if (f->sys_waited) { + exp_wait_zero(&f->wait); + } + f->bg_interp = 0; + f->bg_status = unarmed; + f->bg_ecount = 0; + f->channel = chan; + f->leaveopen = 0; + f->alwaysopen = 0; + f->matched = 0; /* Used only by expectlib */ + f->Master = NULL; + f->event_proc = NULL; + f->event_data = 0; + exp_f_new_platform(f); + + Tcl_SetHashValue(hPtr, f); + f->hashPtr = hPtr; + f->spawnId = ckalloc(strlen(spawnId) + 1); + strcpy(f->spawnId, spawnId); + + if (chan) { + Tcl_CreateCloseHandler(chan, (Tcl_CloseProc *) exp_f_closed, + (ClientData) f); + } + + return f; +} + +/* + *---------------------------------------------------------------------- + * + * exp_f_free -- + * + * Frees an exp_f structure. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_f_free(f) + struct exp_f *f; +{ + if (f->buffer) { + 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); + f->fg_armed = FALSE; + } + ckfree(f->lower); + } + ckfree(f->spawnId); + f->fg_armed = FALSE; + Tcl_DeleteHashEntry(f->hashPtr); + + exp_f_free_platform(f); + ckfree((char *) f); +} + +/* + *---------------------------------------------------------------------- + * + * exp_f_closed -- + * + * A channel was closed, so we need to make it unavailable + * for anything except the wait command. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +static void +exp_f_closed(f) + struct exp_f *f; +{ + exp_ecmd_remove_f_direct_and_indirect(f->interp,f); + + exp_configure_count++; + + f->fg_armed = FALSE; + f->valid = FALSE; + + if (f->user_waited) { + exp_f_free(f); + } +} + +/* + *---------------------------------------------------------------------- + * + * Exp_ExpPidCmd -- + * + * Implements the "exp_pid" command + * + * Results: + * A standard Tcl result + * + * Side Effects: + * None + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_ExpPidCmd(clientData,interp,argc,argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + struct exp_f *f; + char *chanId = NULL; + char *argv0 = argv[0]; + + argc--; argv++; + + for (;argc>0;argc--,argv++) { + if (streq(*argv,"-i")) { + argc--; argv++; + if (!*argv) goto usage; + chanId = *argv; + } else goto usage; + } + + if (chanId == NULL) { + f = exp_update_master(interp,0,0); + } else { + f = exp_chan2f(interp, chanId, 1, 0, argv0); + } + if (f == NULL) { + return(TCL_ERROR); + } + + sprintf(interp->result,"%d",f->pid); + return TCL_OK; + usage: + exp_error(interp,"usage: -i spawn_id"); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * Exp_GetpidDeprecatedCmd -- + * + * Implements the old 'getpid' command. This command is has + * been deprecated and may not be supported in the future + * + * Results: + * A standard Tcl result + * + * Side Effects: + * None + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_GetpidDeprecatedCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + exp_debuglog("getpid is deprecated, use pid\r\n"); + sprintf(interp->result,"%d",exp_getpidproc()); + return(TCL_OK); +} + +/* + *---------------------------------------------------------------------- + * + * exp_update_master -- + * + * Get the current master (via out-parameter) + * + * Results: + * An exp_f structure or NULL if not found + * + * Note: Since exp_chan2f calls tcl_error, this may be + * immediately followed by a "return(TCL_ERROR)"!!! + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +struct exp_f * +exp_update_master(interp,opened,adjust) + Tcl_Interp *interp; + int opened; + int adjust; +{ + CONST char *s = exp_get_var(interp,EXP_SPAWN_ID_VARNAME); + if (s == NULL) { + s = EXP_SPAWN_ID_USER; + } + return exp_chan2f(interp,s,opened,adjust,s); +} + +/* + *---------------------------------------------------------------------- + * + * Exp_SleepCmd -- + * + * Implements the 'sleep' (alias 'exp_sleep') command. + * Can sleep for fractional seconds. + * + * Results: + * A standard Tcl result + * + * Side Effects: + * May not return immediately, and it may service other + * events during the sleep period + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_SleepCmd(clientData,interp,argc,argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + argc--; argv++; + + if (argc != 1) { + exp_error(interp,"must have one arg: seconds"); + return TCL_ERROR; + } + + return(exp_dsleep(interp,(double)atof(*argv))); +} + +struct slow_arg { + int size; + double time; +}; + +/* + *---------------------------------------------------------------------- + * + * get_slow_args -- + * + * Get the arguments the the 'send -s' command + * + * Results: + * 0 on success, -1 on failure + * + * Side Effects: + * The slow_arg structure is filled in + * + *---------------------------------------------------------------------- + */ + +/* returns 0 for success, -1 for failure */ +static int +get_slow_args(interp,x) + Tcl_Interp *interp; + struct slow_arg *x; +{ + int sc; /* return from scanf */ + CONST char *s = exp_get_var(interp,"send_slow"); + if (!s) { + exp_error(interp,"send -s: send_slow has no value"); + return(-1); + } + if (2 != (sc = sscanf(s,"%d %lf",&x->size,&x->time))) { + exp_error(interp,"send -s: found %d value(s) in send_slow but need 2",sc); + return(-1); + } + if (x->size <= 0) { + exp_error(interp,"send -s: size (%d) in send_slow must be positive", x->size); + return(-1); + } + if (x->time <= 0) { + exp_error(interp,"send -s: time (%f) in send_slow must be larger",x->time); + return(-1); + } + return(0); +} + +/* + *---------------------------------------------------------------------- + * + * slow_write -- + * + * Write some bytes s l o w l y + * + * Results: + * 0 on success, -1 on failure, positive for standard Tcl result + * + * Side Effects: + * Data is written to an output object + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +static int +slow_write(interp,f,buffer,rembytes,arg) + Tcl_Interp *interp; + struct exp_f *f; + char *buffer; + int rembytes; + struct slow_arg *arg; +{ + int rc; + + while (rembytes > 0) { + int len; + + len = (arg->sizesize:rembytes); + if (0 > exp_exact_write(f,buffer,len)) return(-1); + rembytes -= arg->size; + buffer += arg->size; + + /* skip sleep after last write */ + if (rembytes > 0) { + rc = exp_dsleep(interp,arg->time); + if (rc>0) return rc; + } + } + return(0); +} + +struct human_arg { + float alpha; /* average interarrival time in seconds */ + float alpha_eow; /* as above but for eow transitions */ + float c; /* shape */ + float min, max; +}; + + +/* + *---------------------------------------------------------------------- + * + * get_human_args -- + * + * Get the arguments the the 'send -h' command + * + * Results: + * 0 on success, -1 on failure + * + * Side Effects: + * The human_arg structure is filled in + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +static int +get_human_args(interp,x) + Tcl_Interp *interp; + struct human_arg *x; +{ + int sc; /* return from scanf */ + CONST char *s = exp_get_var(interp,"send_human"); + + if (!s) { + exp_error(interp,"send -h: send_human has no value"); + return(-1); + } + if (5 != (sc = sscanf(s,"%f %f %f %f %f", + &x->alpha,&x->alpha_eow,&x->c,&x->min,&x->max))) { + if (sc == EOF) sc = 0; /* make up for overloaded return */ + exp_error(interp,"send -h: found %d value(s) in send_human but need 5",sc); + return(-1); + } + if (x->alpha < 0 || x->alpha_eow < 0) { + exp_error(interp,"send -h: average interarrival times (%f %f) must be non-negative in send_human", x->alpha,x->alpha_eow); + return(-1); + } + if (x->c <= 0) { + exp_error(interp,"send -h: variability (%f) in send_human must be positive",x->c); + return(-1); + } + x->c = 1/x->c; + + if (x->min < 0) { + exp_error(interp,"send -h: minimum (%f) in send_human must be non-negative",x->min); + return(-1); + } + if (x->max < 0) { + exp_error(interp,"send -h: maximum (%f) in send_human must be non-negative",x->max); + return(-1); + } + if (x->max < x->min) { + exp_error(interp,"send -h: maximum (%f) must be >= minimum (%f) in send_human",x->max,x->min); + return(-1); + } + return(0); +} + +/* + *---------------------------------------------------------------------- + * + * unit_random -- + * + * Compute random numbers from 0 to 1, for expect's send -h + * This implementation sacrifices beauty for portability. + * Current implementation is pathetic but works + * + * Results: + * A floating point number between 0 and 1 + * + * Side Effects: + * None + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +static float +unit_random() +{ + /* 99991 is largest prime in my CRC - can't hurt, eh? */ + return((float)(1+(rand()%99991))/(float) 99991.0); +} + +/* + *---------------------------------------------------------------------- + * + * exp_init_unit_random -- + * + * Initialize the random number generator + * + * Results: + * None + * + * Side Effects: + * None + * + * Notes: + * OS independent + * + *---------------------------------------------------------------------- + */ + +void +exp_init_unit_random() +{ + srand(exp_getpidproc()); +} + +/* + *---------------------------------------------------------------------- + * + * exp_init_unit_random -- + * + * This function is my implementation of the Weibull distribution. + * 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. + * + * Results: + * 0 for success, -1 for failure, positive for standard Tcl result + * + * Side Effects: + * None + * + *---------------------------------------------------------------------- + */ + +static int +human_write(interp,f,buffer,arg) + Tcl_Interp *interp; + struct exp_f *f; + char *buffer; + struct human_arg *arg; +{ + char *sp; + float t; + float alpha; + int in_word = TRUE; + int wc; + + exp_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 * (float) 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);*/ + /* skip sleep before writing first character */ + if (sp != buffer) { + wc = exp_dsleep(interp,(double)t); + if (wc > 0) return wc; + } + + wc = exp_exact_write(f, sp, 1); + if (wc == -1) { + return -1; + } + } + return(0); +} + +struct exp_i *exp_i_pool = 0; +struct exp_fs_list *exp_fs_list_pool = 0; + +#define EXP_I_INIT_COUNT 10 +#define EXP_FS_INIT_COUNT 10 + +struct exp_i * +exp_new_i() +{ + int n; + struct exp_i *i; + + if (!exp_i_pool) { + /* none avail, generate some new ones */ + exp_i_pool = i = (struct exp_i *)ckalloc( + EXP_I_INIT_COUNT * sizeof(struct exp_i)); + for (n=0;nnext = i+1; + } + i->next = 0; + } + + /* now that we've made some, unlink one and give to user */ + + i = exp_i_pool; + exp_i_pool = exp_i_pool->next; + i->value = 0; + i->variable = 0; + i->fs_list = 0; + i->ecount = 0; + i->next = 0; + return i; +} + +/* + *---------------------------------------------------------------------- + * + * exp_new_fs -- + * + * Get a new exp_f structure. + * + * Results: + * A structure pointer if successful. + * + * Side Effects: + * Removes one from the pool if there are any in the pool. + * If none are in pool, more are allocated for the pool. + * + *---------------------------------------------------------------------- + */ + +struct exp_fs_list * +exp_new_fs(f) + struct exp_f *f; +{ + int n; + struct exp_fs_list *fs; + + if (!exp_fs_list_pool) { + exp_fs_list_pool = fs = (struct exp_fs_list *) + ckalloc(EXP_FS_INIT_COUNT * sizeof(struct exp_fs_list)); + for (n=0;nnext = fs+1; + } + fs->next = 0; + } + + fs = exp_fs_list_pool; + exp_fs_list_pool = exp_fs_list_pool->next; + fs->f = f; + return fs; +} + +/* + *---------------------------------------------------------------------- + * + * exp_free_fs -- + * + * Add an exp_f structure list to the free pool. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_free_fs(fs_first) + struct exp_fs_list *fs_first; +{ + struct exp_fs_list *fs, *penultimate; + + if (!fs_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 + */ + + /* run to end */ + for (fs = fs_first;fs;fs=fs->next) { + penultimate = fs; + } + penultimate->next = exp_fs_list_pool; + exp_fs_list_pool = fs_first; +} + +/* + *---------------------------------------------------------------------- + * + * exp_free_fs_single -- + * + * Remove an exp_f structure from the list and put it back + * in the free pool + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_free_fs_single(fs) + struct exp_fs_list *fs; +{ + fs->next = exp_fs_list_pool; + exp_fs_list_pool = fs; +} + +void +exp_free_i(interp,i,updateproc) + Tcl_Interp *interp; + 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_fs(i->fs_list); + + if (i->direct == EXP_INDIRECT) { + Tcl_UntraceVar(interp,i->variable, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES, + updateproc,(ClientData)i); + } + + /* + * here's the long form + * if duration & direct free(var) free(val) + * PERM DIR 1 + * PERM INDIR 1 1 + * TMP DIR + * TMP INDIR 1 + * Also if i->variable was a bogus variable name, i->value might not be + * set, so test i->value to protect this + * TMP in this case does NOT mean from the "expect" command. Rather + * it means "an implicit spawn id from any expect or expect_XXX + * command". In other words, there was no variable name provided. + */ + if (i->value + && (((i->direct == EXP_DIRECT) && (i->duration == EXP_PERMANENT)) + || ((i->direct == EXP_INDIRECT) && (i->duration == EXP_TEMPORARY)))) + { + ckfree(i->value); + } else if (i->duration == EXP_PERMANENT) { + if (i->value) ckfree(i->value); + if (i->variable) ckfree(i->variable); + } + + i->next = exp_i_pool; + exp_i_pool = i; +} + +/* + *---------------------------------------------------------------------- + * + * exp_new_i_complex -- + * + * Generate a descriptor for a "-i" flag. This tries to + * be backward compatible, but it can't be perfect. If + * a channel exists, it assumes that the channel is what + * was intended. If it doesn't, it checks the identifier + * as a variable. If the variable exists, the it uses + * the variable name as an indirect pointer to the channel + * to use. If the variable doesn't exist, it falls back + * to assuming the identifier is a channel identifier. + * + * Results: + * A new descriptor structure. Cannot fail currently. + * + * Side Effects: + * Memory is allocated and a Tcl variable trace may be setup + * + *---------------------------------------------------------------------- + */ + +struct exp_i * +exp_new_i_complex(interp,arg,duration,updateproc,msg) + Tcl_Interp *interp; + char *arg; /* spawn id list or a variable containing a list */ + int duration; /* if we have to copy the args */ + /* should only need do this in expect_before/after */ + Tcl_VarTraceProc *updateproc; /* proc to invoke if indirect is written */ + CONST char *msg;/* Error message identifier */ +{ + struct exp_i *i; + char **stringp; + Tcl_DString dString; + + if (!exp_chan2f(interp, arg, 1, 0, msg)) { + Tcl_DStringInit(&dString); + Tcl_DStringGetResult(interp, &dString); + if (Tcl_GetVar(interp, arg, 0)) { + Tcl_DStringFree(&dString); + i = exp_new_i(); + i->direct = EXP_INDIRECT; + stringp = &i->variable; + } else { + Tcl_DStringResult(interp, &dString); + Tcl_DStringFree(&dString); + return NULL; + } + } else { + i = exp_new_i(); + i->direct = EXP_DIRECT; + stringp = &i->value; + } + + i->duration = duration; + if (duration == EXP_PERMANENT) { + *stringp = ckalloc(strlen(arg)+1); + strcpy(*stringp,arg); + } else { + *stringp = arg; + } + + i->fs_list = 0; + exp_i_update(interp,i); + + /* if indirect, ask Tcl to tell us when variable is modified */ + + if (i->direct == EXP_INDIRECT) { + Tcl_TraceVar(interp, i->variable, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES, + updateproc, (ClientData) i); + } + + return i; +} + +/* + *---------------------------------------------------------------------- + * + * exp_i_add_f -- + * + * Add to a list of descriptors + * + * Results: + * None + * + * Side Effects: + * A list grows + * + *---------------------------------------------------------------------- + */ + +static void +exp_i_add_f(i,f) + struct exp_i *i; + struct exp_f *f; +{ + struct exp_fs_list *new_fs; + + new_fs = exp_new_fs(f); + new_fs->next = i->fs_list; + i->fs_list = new_fs; +} + +/* + *---------------------------------------------------------------------- + * + * exp_i_parse_channels + * + * Parses a string containing a list of channel identifiers and + * adds the resulting exp_f structures to a list. + * + * Results: + * None + * + * Side Effects: + * A list grows + * + *---------------------------------------------------------------------- + */ + +void +exp_i_parse_channels(interp, i) + Tcl_Interp *interp; + struct exp_i *i; +{ + char *p = i->value; + char *b; + char s; + struct exp_f *f; + + while (1) { + while (isspace(*p)) { + p++; + } + if (*p == 0) break; + b = p; + while (*p && !isspace(*p)) { + p++; + } + s = *p; + *p = 0; + + f = exp_chan2f(interp, b, 1, 0, ""); + if (f) { + exp_i_add_f(i,f); + } + + *p = s; + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_i_update -- + * + * updates a single exp_i struct + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_i_update(interp,i) + Tcl_Interp *interp; + struct exp_i *i; +{ + CONST 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_fs(i->fs_list); + i->fs_list = 0; + } else { + /* no free, because this should only be called on */ + /* "direct" i's once */ + i->fs_list = 0; + } + exp_i_parse_channels(interp, i); +} + +/* + *---------------------------------------------------------------------- + * + * exp_new_i_simple -- + * + * Not quite sure what this does (GCC) + * + * Results: + * An exp_i structure + * + *---------------------------------------------------------------------- + */ + +struct exp_i * +exp_new_i_simple(f,duration) + struct exp_f *f; + int duration; /* if we have to copy the args */ + /* should only need do this in expect_before/after */ +{ + struct exp_i *i; + + i = exp_new_i(); + + i->direct = EXP_DIRECT; + i->duration = duration; + + exp_i_add_f(i,f); + + return i; +} + +/* + *---------------------------------------------------------------------- + * + * exp_exact_write -- + * + * Write exactly this many bytes, i.e. retry partial writes. + * + * Results: + * 0 on success, -1 on failure + * + * Side Effects: + * Data is written to an output object + * + *---------------------------------------------------------------------- + */ + +int +exp_exact_write(f,buffer,rembytes) + struct exp_f *f; + char *buffer; + int rembytes; +{ + int n; + while (rembytes) { + n = Tcl_Write(f->channel, buffer, rembytes); + if (-1 == n) { + return -1; + } + if (0 == n) { + Tcl_Sleep(1000); + exp_debuglog("write() failed to write anything but returned - sleeping and retrying...\n"); + } + buffer += n; + rembytes -= n; + } + return(0); +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnOpen -- + * + * Handle the 'spawn -open' command. Called from Exp_SpawnCmd. + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +int +ExpSpawnOpen(interp, chanId, leaveopen) + Tcl_Interp *interp; + char *chanId; + int leaveopen; +{ + Tcl_Channel chan; + int mode; + struct exp_f *f; + + if (!(chan = Tcl_GetChannel(interp, chanId, &mode))) { + return TCL_ERROR; + } + if (!mode) { + exp_error(interp,"%s: channel is neither readable nor writable", + chanId); + return TCL_ERROR; + } + + f = exp_f_find(interp, chanId); + if (! f) { + f = exp_f_new(interp, chan, NULL, EXP_NOPID); + f->leaveopen = leaveopen; + + exp_wait_zero(&f->wait); + } else { + /* + * Reference count this thing + */ + + f->leaveopen += leaveopen; + } + + /* tell user id of new process */ + Tcl_SetVar(interp,EXP_SPAWN_ID_VARNAME,chanId,0); + + sprintf(interp->result,"%d",EXP_NOPID); + exp_debuglog("spawn: returns {%s}\r\n",interp->result); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Exp_SendLogCmd -- + * + * Implements the send_log command. + * + * Results: + * A standard Tcl result + * + * Side Effects: + * Messages are written to a log file + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_SendLogCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + char *string; + int len; + + argv++; + argc--; + + if (argc) { + if (streq(*argv,"--")) { + argc--; argv++; + } + } + + if (argc != 1) { + exp_error(interp,"usage: send [args] string"); + return TCL_ERROR; + } + + string = *argv; + + len = strlen(string); + + if (exp_debugfile) Tcl_Write(exp_debugfile, string, len); + if (exp_logfile) Tcl_Write(exp_logfile, string, len); + + return(TCL_OK); +} + +/* + *---------------------------------------------------------------------- + * + * Exp_SendCmd -- + * + * Sends data to a subprocess or over some channel + * + * Results: + * Standard Tcl result + * + * Notes: + * (Don) 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. + * + * (GCC) This uses Tcl channels. By default, the channel + * translation will be binary for channels created with + * spawn . The clientData argument, if non-NULL, + * holds the name of the channel to use. + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_SendCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + 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_fs_list *fs; + struct exp_i *i; + char *arg; + struct exp_f *f = NULL; + char *argv0 = argv[0]; + + 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: %s -i spawn_id", argv0); + 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: %s [args] string", argv0); + return TCL_ERROR; + } + string = *argv; + } + len = strlen(string); + + if (clientData != NULL) { + f = exp_chan2f(interp, (char *) clientData, 1, 0, argv0); + } 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 fs and then convert it from 0 to 1 if necessary + */ + f = exp_update_master(interp,0,0); + if (f == NULL) { + return(TCL_ERROR); + } + } + + /* + * if f != NULL, then it holds desired master, else i_masters does + */ + + if (f) { + i = exp_new_i_simple(f,EXP_TEMPORARY); + } else { + i = exp_new_i_complex(interp,i_masters,FALSE, + (Tcl_VarTraceProc *)NULL,argv0); + if (i == NULL) { + return TCL_ERROR; + } + } + + if (clientData == NULL) { + /* This seems to be the standard send call (send_to_proc) */ + want_cooked = FALSE; + exp_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 (exp_debugfile) { + Tcl_Write(exp_debugfile, string, len); + } + /* send_to_user ? */ + if (((strcmp((char *) clientData, "exp_user") == 0 || + strcmp((char *) clientData, exp_dev_tty_id) == 0 || + strcmp((char *) clientData, "exp_tty") == 0) && exp_logfile_all) || + exp_logfile) { + if (exp_logfile) { + Tcl_Write(exp_logfile, string, len); + } + } + } + + for (fs=i->fs_list;fs;fs=fs->next) { + f = fs->f; + + if (clientData == NULL) { + /* send_to_proc */ + exp_debuglog(" %s ", f->spawnId); + } + + /* check validity of each - i.e., are they open */ + if (! exp_fcheck(interp, f, 1, 0, "send")) { + rc = TCL_ERROR; + goto finish; + } + + if (want_cooked) string = exp_cook(string,&len); + + switch (send_style) { + case SEND_STYLE_PLAIN: + rc = exp_exact_write(f,string,len); + break; + case SEND_STYLE_SLOW: + rc = slow_write(interp,f,string,len,&slow_args); + break; + case SEND_STYLE_HUMAN: + rc = human_write(interp,f,string,&human_args); + break; + case SEND_STYLE_ZERO: + for (;zeros>0;zeros--) + rc = exp_exact_write(f, "", 1); + /* catching error on last write is sufficient */ + break; + case SEND_STYLE_BREAK: + exp_tty_break(interp,f); + rc = 0; + break; + } + + if (rc != 0) { + if (rc == -1) { + exp_error(interp,"write(spawn_id=%s): %s", f->spawnId, + Tcl_PosixError(interp)); + rc = TCL_ERROR; + } + goto finish; + } + } + if (clientData == NULL) { + /* send_to_proc */ + exp_debuglog("}\r\n"); + } + + rc = TCL_OK; + finish: + exp_free_i(interp,i,(Tcl_VarTraceProc *)0); + return rc; +} + +/* + *---------------------------------------------------------------------- + * + * Exp_LogFileCmd -- + * + * Implements the 'log_file' and 'exp_log_file' commands. + * Opens a logfile. + * + * Results: + * A standard Tcl result. + * + * Side Effects: + * A file may be opened, or a currently open file may be + * changed to unbuffered + * + *---------------------------------------------------------------------- + */ + +/*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 = exp_logfile_all; + Tcl_Channel old_logfile = exp_logfile; + char *old_openarg = openarg; + int old_leaveopen = leaveopen; + + int aflag = FALSE; + int append = TRUE; + char *filename = 0; + char *type; + int usage_error_occurred = FALSE; + + openarg = 0; + leaveopen = FALSE; + + if (first_time) { + Tcl_DStringInit(&dstring); + first_time = FALSE; + } + +#define usage_error {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 (exp_logfile) { + if (exp_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 + } + + exp_logfile = 0; + exp_logfile_all = aflag; + + current_append = append; + + type = (append?"a":"w"); + + if (filename) { + exp_logfile = Tcl_OpenFileChannel(interp, filename, type, O_CREAT|S_IWRITE); + if (exp_logfile == (Tcl_Channel) NULL) { + exp_error(interp,"%s: %s",filename,Tcl_PosixError(interp)); + goto error; + } + } else if (openarg) { + int mode; + + Tcl_DStringTrunc(&dstring,0); + + if (!(exp_logfile = Tcl_GetChannel(interp,openarg,&mode))) { + return TCL_ERROR; + } + if (!(mode & TCL_WRITABLE)) { + exp_error(interp,"channel is not writable"); + } + + 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 (exp_logfile) { + Tcl_SetChannelOption(interp, exp_logfile, "-buffering", "none"); + } + + if (old_logfile) { + if (!old_openarg || !old_leaveopen) { + Tcl_Close(interp, old_logfile); + } + if (old_openarg) { + ckfree(old_openarg); + } + } + + return TCL_OK; + + error: + if (old_logfile) { + exp_logfile = old_logfile; + exp_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; +} + +/* + *---------------------------------------------------------------------- + * + * Exp_LogUserCmd -- + * + * Implements the 'loguser' and 'exp_loguser' commands. + * Can turn logging to stdout on or off, and returns the + * previous logging status. + * + * Results: + * A standard TCL result + * + * Side Effects: + * Logging can be enabled or disabled. + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_LogUserCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + int old_loguser = exp_loguser; + + if (argc == 0 || (argc == 2 && streq(argv[1],"-info"))) { + /* do nothing */ + } else if (argc == 2) { + if (0 == atoi(argv[1])) exp_loguser = FALSE; + else exp_loguser = TRUE; + } else { + exp_error(interp, "usage: [-info|1|0]"); + } + + Tcl_SetObjResult(interp, Tcl_NewIntObj(old_loguser)); + + return(TCL_OK); +} + +#ifdef TCL_DEBUGGER +/* + *---------------------------------------------------------------------- + * + * Exp_DebugCmd -- + * + * Implements the 'debug' and 'exp_debug' commands + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_DebugCmd(clientData, interp, argc, argv) + 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 /* TCL_DEBUGGER */ + +/*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 (exp_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 (exp_debugfile) { + Tcl_Close(interp, exp_debugfile); + } + + exp_debugfile = Tcl_OpenFileChannel(interp, argv[0], "a", O_APPEND|S_IWRITE); + if (exp_debugfile == (Tcl_Channel) NULL) { + exp_error(interp,"%s: %s",argv[0],Tcl_PosixError(interp)); + goto error; + } + Tcl_DStringAppend(&dstring,argv[0],-1); + + Tcl_SetChannelOption(interp, exp_debugfile, "-buffering", "none"); + fopened = TRUE; + argc--;argv++; + } + + if (argc != 1) goto usage; + + /* if no -f given, close file */ + if (fopened == FALSE && exp_debugfile) { + Tcl_Close(interp, exp_debugfile); + exp_debugfile = NULL; + Tcl_DStringFree(&dstring); + } + + exp_is_debugging = atoi(*argv); + return(TCL_OK); + usage: + exp_error(interp,"usage: [-f file] expr"); + error: + Tcl_DStringFree(&dstring); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * Exp_ExitCmd -- + * + * Called on exit to do cleanup. + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +char *exp_onexit_action = 0; + +/*ARGSUSED*/ +static int +Exp_ExitCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + int value = 0; + + argv++; + + if (*argv) { + if (exp_flageq(*argv,"-onexit",3)) { + argv++; + if (*argv) { + int len = strlen(*argv); + if (exp_onexit_action) + ckfree(exp_onexit_action); + exp_onexit_action = ckalloc(len + 1); + strcpy(exp_onexit_action,*argv); + } else if (exp_onexit_action) { + Tcl_AppendResult(interp,exp_onexit_action,(char *)0); + } + return TCL_OK; + } else if (exp_flageq(*argv,"-noexit",3)) { + argv++; + exp_exit_handlers((ClientData)interp); + return TCL_OK; + } + } + + if (*argv) { + if (Tcl_GetInt(interp, *argv, &value) != TCL_OK) { + return TCL_ERROR; + } + } + + exp_exit(interp,value); + /*NOTREACHED*/ + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Exp_CloseCmd -- + * + * Currently closes a channel or sets up handlers for + * when the channel closes. + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_CloseCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + char *close_onexec = NULL; + int slave_flag = FALSE; + char *argv0 = argv[0]; + struct exp_f *f; +#if 0 + int slave; +#endif + char *chanId = NULL; + + int argc_orig = argc; + char **argv_orig = argv; + + 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); + } + chanId = *argv; + } else if (streq(*argv,"-slave")) { + slave_flag = TRUE; + } else if (streq(*argv,"-onexec")) { + argc--; argv++; + if (!*argv) { + exp_error(interp,"usage: -onexec channelId"); + return(TCL_ERROR); + } + close_onexec = *argv; + } 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. */ + + /* So what! the global namespace belongs to the core. */ + /*Tcl_Obj **objv; + int i, result; + Tcl_CmdInfo info; + + Tcl_ResetResult(interp); + objv = (Tcl_Obj **) ckalloc((argc+1)*sizeof(Tcl_Obj *)); + objv[0] = Tcl_NewStringObj("close", -1); + for (i = 0; i < argc; i++) { + objv[i+1] = Tcl_NewStringObj(argv[i], -1); + } + + if (0 == Tcl_GetCommandInfo(interp,"close",&info)) { + info.clientData = 0; + } + result = Tcl_CloseObjCmd(info.objClientData,interp,argc+1,objv); + for (i = 0; i < argc+1; i++) { + Tcl_DecrRefCount(objv[i]); + } + ckfree((char *) objv); + return result;*/ + Tcl_SetResult(interp, + "Cannot close the channel as it isn't an expect channel.", + TCL_STATIC); + return TCL_ERROR; + } + + if (chanId == NULL) { + f = exp_update_master(interp, 1, 0); + } else if (slave_flag) { + f = exp_chan2f(interp, chanId, 1, 0, "-slave"); + } else { + f = exp_chan2f(interp, chanId, 1, 0, argv0); + } + if (f == NULL) { + return TCL_ERROR; + } + + if (slave_flag) { + if (f->slave_fd) { +#ifndef __WIN32__ /* XXX: This still needs some looking at */ + close(f->slave_fd); + f->slave_fd = EXP_NOFD; + + exp_slave_control(f,1); +#endif + return TCL_OK; + } + exp_error(interp,"no such slave"); + return TCL_ERROR; + } + +#ifdef XXX /* I'm not sure this is a good idea to support */ + 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; + } +#endif + + return exp_close(interp, f); +} + +/*ARGSUSED*/ +static void +tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv) + ClientData clientData; + Tcl_Interp *interp; + int level; + char *command; + Tcl_CmdProc *cmdProc; + ClientData cmdClientData; + int argc; + char *argv[]; +{ + int i; + + /* come out on stderr, by using errorlog */ + exp_errorlog("%2d",level); + for (i = 0;i 1 && streq(argv[1],"-info")) { + sprintf(interp->result,"%d",trace_level); + return TCL_OK; + } + + if (argc != 2) { + exp_error(interp,"usage: trace level"); + return(TCL_ERROR); + } + /* tracing already in effect, undo it */ + if (trace_level > 0) Tcl_DeleteTrace(interp,trace_handle); + + /* get and save new trace level */ + trace_level = atoi(argv[1]); + if (trace_level > 0) + trace_handle = Tcl_CreateTrace(interp, + trace_level,tcl_tracer,(ClientData)0); + return(TCL_OK); +} + +/* + *---------------------------------------------------------------------- + * + * Exp_WaitCmd -- + * + * Implements the 'wait' and 'exp_wait' commands. When a process + * has been spawned, the wait call must be made before it will + * go away. + * + * Results: + * A standard Tcl result + * + * Notes: + * XXX: This might need to go into the platform specific file. + * Need to make sure that we do the right thing when exp_open + * has been called on an identifier. + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +Exp_WaitCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + int master_supplied = FALSE; + struct exp_f *f; /* ditto */ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + struct forked_proc *fp = 0; /* handle to a pure forked proc */ + +#ifdef XXX + struct exp_f ftmp; /* temporary memory for either f or fp */ +#endif + + int nowait = FALSE; + int nohang = FALSE; + char *chanId = NULL; + char *argv0 = argv[0]; + Tcl_Pid result = 0; /* 0 means child was successfully waited on */ + + /* -1 means an error occurred */ + /* -2 means no eligible children to wait on */ +#define NO_CHILD ((Tcl_Pid) -2) + + 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); + } + chanId = *argv; + } else if (streq(*argv,"-nowait")) { + nowait = TRUE; + } else if (streq(*argv,"-nohang")) { + nohang = TRUE; + } + } + + if (chanId == NULL) { + f = exp_update_master(interp, 0, 0); + } else { + f = exp_chan2f(interp, chanId, 0, 0, argv0); + } + if (f == NULL) { + return TCL_ERROR; + } + + if (f != exp_f_any) { + /* + * Check if waited on already. Things opened by "open", set + * with -nowait, or are special expect ids 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. + */ + Tcl_DetachPids(1,&f->tclPid); + exp_wait_zero(&f->wait); + f->sys_waited = 1; + f->user_waited = 1; + + } else if (nohang) { + exp_wait_zero(&f->wait); + result = Tcl_WaitPid(f->tclPid,&f->wait,WNOHANG); + + } else { + while (1) { + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(rc); + } + + exp_wait_zero(&f->wait); + result = Tcl_WaitPid(f->tclPid,&f->wait,0); + if (result == f->tclPid) break; + if (result == (Tcl_Pid) -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. + */ + + hPtr = Tcl_FirstHashEntry(exp_f_table, &search); + while (hPtr) { + f = (struct exp_f *) Tcl_GetHashValue(hPtr); + + if (!f->valid) continue; + if (f->pid == EXP_NOPID) continue; + if (f->pid == exp_getpid) continue; /* skip ourself */ + if (f->user_waited) continue; /* one wait only! */ + if (f->sys_waited) break; + restart: + exp_wait_zero(&f->wait); + result = Tcl_WaitPid(f->tclPid,&f->wait,WNOHANG); + if (result == f->tclPid) break; + if (result == 0) continue; /* busy, try next */ + if (result == (Tcl_Pid) -1) { + if (errno == EINTR) goto restart; + else break; + } + hPtr = Tcl_NextHashEntry(&search); + } + +#ifdef XXX + /* 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; + } + } +#endif /* XXX */ + + if (hPtr == NULL && fp == NULL) { + result = NO_CHILD; /* no children */ + Tcl_ReapDetachedProcs(); + } + exp_rearm_sigchld(interp); + } + +#ifdef XXX + /* 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->tclPid = fp->pid; + f->wait = fp->wait_status; + } +#endif + /* non-portable assumption that pid_t can be printed with %d */ + + if (result == (Tcl_Pid) -1) { + sprintf(interp->result,"%d %s -1 %d POSIX %s %s", + f->pid,f->spawnId,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno)); + result = TCL_OK; + f->sys_waited = TRUE; + f->user_waited = TRUE; + } else if (result == NO_CHILD) { + interp->result = "no children"; + return TCL_ERROR; + } else { + sprintf(interp->result,"%d %s 0 %d", + f->pid,f->spawnId,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 (nohang && result == 0) { + Tcl_AppendElement(interp,"NOEXIT"); + } + if (result > 0 && WIFEXITED(f->wait)) { + f->sys_waited = TRUE; + f->user_waited = TRUE; + } + } + +#ifdef XXX + if (fp) { + fp->link_status = not_in_use; + return ((result == -1)?TCL_ERROR:TCL_OK); + } +#endif + + /* + * if user has already called close, make sure fd really is closed + * and forget about this entry entirely + */ + if (f->user_closed) { + exp_f_free(f); + } + return ((result == (Tcl_Pid) -1)?TCL_ERROR:TCL_OK); +} + +/*ARGSUSED*/ +int +Exp_InterpreterCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + if (argc != 1) { + exp_error(interp,"no arguments allowed"); + return(TCL_ERROR); + } + +#ifdef __WIN32__ + exp_error(interp, "not implemented on Windows NT"); + return TCL_ERROR; +#endif + return(exp_interpreter(interp)); + /* errors and ok, are caught by exp_interpreter() and discarded */ + /* to return TCL_OK, type "return" */ +} + +/* this command supercede's Tcl's builtin CONTINUE command */ +/*ARGSUSED*/ +int +Exp_ExpContinueDeprecatedCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + if (argc == 1) return(TCL_CONTINUE); + else if (argc == 2) { + if (streq(argv[1],"-expect")) { + exp_debuglog("continue -expect is deprecated, use exp_continue\r\n"); + return(EXP_CONTINUE); + } + } + exp_error(interp,"usage: continue [-expect]\n"); + return(TCL_ERROR); +} + +/* this command supercede's Tcl's builtin CONTINUE command */ +/*ARGSUSED*/ +int +Exp_ExpContinueCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + if (argc == 1) { + return EXP_CONTINUE; + } else if ((argc == 2) && (streq(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*/ + +/* Why is this here? +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; +#if TCL_MAJOR_VERSION >= 8 + Tcl_Obj **objv; + int i; + + objv = (Tcl_Obj **) ckalloc(argc*sizeof(Tcl_Obj *)); + for (i = 0; i < argc; i++) { + objv[i] = Tcl_NewStringObj(argv[i], -1); + } + result = Tcl_ReturnObjCmd(clientData,interp,argc,objv); + for (i = 0; i < argc; i++) { + Tcl_DecrRefCount(objv[i]); + } + ckfree((char *) objv); +#else + result = Tcl_ReturnCmd(clientData,interp,argc,argv); +#endif + + if (result == TCL_RETURN) + result = EXP_TCL_RETURN; + return result; + +}*/ + +/* + *---------------------------------------------------------------------- + * + * Exp_OpenCmd -- + * + * Implements the exp_open command. Makes a spawn id available + * to Tcl. Since this happens by default, we don't have to do + * anything in the -leaveopen case. In the normal case, we + * need to clean up the spawn identifier and that is all. + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +int +Exp_OpenCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + struct exp_f *f; + int leaveopen = FALSE; + char *chanId = NULL; + char *argv0 = argv[0]; + + 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; + } + chanId = *argv; + } else if (streq(*argv,"-leaveopen")) { + leaveopen = TRUE; + argc--; argv++; + } else break; + } + + if (chanId == NULL) { + f = exp_update_master(interp,0,0); + } else { + f = exp_chan2f(interp, chanId, 1, 0, argv0); + } + if (f == NULL) { + return(TCL_ERROR); + } + if (f->channel == NULL) { + exp_error(interp, + "%s: %s is an internal spawn id that cannot be expected as a channel id", + argv0, chanId); + return TCL_ERROR; + } + if (! leaveopen) { + /* + * Don't do any reference count check on f->leaveopen. Just force + * the spawn id closed + */ + if (f->channel) { + Tcl_DeleteCloseHandler(f->channel, (Tcl_CloseProc *) exp_f_free, + (ClientData) f); + } + exp_f_free(f); + } + + Tcl_AppendResult(interp, Tcl_GetChannelName(f->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 +exp_flageq_code(flag,string,minlen) +char *flag; +char *string; +int minlen; /* at least this many chars must match */ +{ + for (;*flag;flag++,string++,minlen--) { + if (*string == '\0') break; + if (*string != *flag) return 0; + } + if (*string == '\0' && minlen <= 0) return 1; + return 0; +} + +void +exp_create_commands(interp,c) + Tcl_Interp *interp; + struct exp_cmd_data *c; +{ + Namespace *expNsPtr = (Namespace *) Tcl_FindNamespace(interp, "::exp", NULL, 0); + //char cmdnamebuf[80]; + + for (;c->name;c++) { + /* if already defined, don't redefine */ + if (!expNsPtr || !(Tcl_FindHashEntry(&expNsPtr->cmdTable,c->name))) { + //sprintf(cmdnamebuf, "::exp::%s",c->name); + if (c->objproc) { + Tcl_CreateObjCommand(interp,c->name,c->objproc,c->data,NULL); + } else { + Tcl_CreateCommand(interp,c->name,c->proc,c->data,NULL); + } + } + } +} + +static struct exp_cmd_data cmd_data[] = { + {"exp_close", 0, Exp_CloseCmd, 0, 0}, +#ifdef TCL_DEBUGGER + {"debug", 0, Exp_DebugCmd, 0, 0}, +#endif + {"exp_internal", 0, Exp_ExpInternalCmd, 0, 0}, +#ifdef XXX + {"::exp::disconnect", 0, Exp_DisconnectCmd, 0, 0}, +#endif + {"exp_exit", 0, Exp_ExitCmd, 0, 0}, +/*{"exp::_continue", 0, Exp_ExpContinueDeprecatedCmd,0,0},*/ + {"exp_continue",0,Exp_ExpContinueCmd,0, 0}, +#ifdef XXX + {"::exp::fork", 0, Exp_ForkCmd, 0, 0}, +#endif + {"exp_pid", 0, Exp_ExpPidCmd, 0, 0}, + {"exp_getpid", 0, Exp_GetpidDeprecatedCmd,0, 0}, + {"exp_interpreter", 0, Exp_InterpreterCmd, 0, 0}, + {"kill", 0, Exp_KillCmd, 0, 0}, + {"log_file", 0, Exp_LogFileCmd, 0, 0}, + {"log_user", 0, Exp_LogUserCmd, 0, 0}, + {"exp_open", 0, Exp_OpenCmd, 0, 0}, +#ifdef XXX + {"overlay", 0, Exp_OverlayCmd, 0, 0}, +#endif + /*{"::exp::inter_return",0, Exp_InterReturnCmd, 0, 0}, why is this here?*/ + {"send", 0, Exp_SendCmd, (ClientData)NULL, 0}, + /*{"exp::send_spawn", 0, Exp_SendCmd, (ClientData)NULL, 0},deprecat*/ + {"send_error", 0, Exp_SendCmd, (ClientData)"stderr", 0}, + {"send_log", 0, Exp_SendLogCmd, 0, 0}, + {"send_tty", 0, Exp_SendCmd, (ClientData)"exp_tty", 0}, + {"send_user", 0, Exp_SendCmd, (ClientData)"exp_user", 0}, + {"sleep", 0, Exp_SleepCmd, 0, 0}, + {"spawn", 0, Exp_SpawnCmd, 0, 0}, + {"strace", 0, Exp_StraceCmd, 0, 0}, + {"wait", 0, Exp_WaitCmd, 0, 0}, + {0} +}; + +/* + *---------------------------------------------------------------------- + * + * exp_init_most_cmds -- + * + * Initialize the large majority of commands that are used + * in expect + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_init_most_cmds(interp) + Tcl_Interp *interp; +{ + exp_create_commands(interp,cmd_data); + + exp_close_in_child = exp_close_tcl_files; +} + +void +exp_init_spawn_id_vars(interp) + Tcl_Interp *interp; +{ + Tcl_SetVar(interp,"::exp::user_spawn_id",EXP_SPAWN_ID_USER,0); + Tcl_SetVar(interp,"::exp::error_spawn_id",EXP_SPAWN_ID_ERROR,0); + Tcl_SetVar(interp,"::exp::tty_spawn_id","exp_tty",0); +} + +/* + *---------------------------------------------------------------------- + * + * exp_init_spawn_ids -- + * + * Create the structures for the standard spawn ids. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_init_spawn_ids(interp) + Tcl_Interp *interp; +{ + Tcl_Channel chan, chanIn, chanOut; + struct exp_f *f; + + exp_f_table = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(exp_f_table, TCL_STRING_KEYS); + + chan = ExpCreatePairChannel(interp, "stdin", "stdout", "exp_user"); + f = exp_f_new(interp, chan, NULL, EXP_NOPID); + Tcl_RegisterChannel(interp, chan); + + chan = Tcl_GetStdChannel(TCL_STDIN); + f = exp_f_new(interp, chan, NULL, + (isatty(0) ? exp_getpid : EXP_NOPID)); + f->leaveopen = 1; + if (strcmp(Tcl_GetChannelName(chan), "stdin") != 0) { + f = exp_f_new(interp, chan, "stdin", + (isatty(0) ? exp_getpid : EXP_NOPID)); + f->leaveopen = 1; + } + chanIn = chan; + + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan != chanIn) { + f = exp_f_new(interp, chan, NULL, + (isatty(1) ? exp_getpid : EXP_NOPID)); + f->leaveopen = 1; + } + if (strcmp(Tcl_GetChannelName(chan), "stdout") != 0) { + f = exp_f_new(interp, chan, "stdout", + (isatty(1) ? exp_getpid : EXP_NOPID)); + f->leaveopen = 1; + } + chanOut = chan; + + chan = Tcl_GetStdChannel(TCL_STDERR); + if ((chan != chanIn) && (chan != chanOut)) { + f = exp_f_new(interp, chan, NULL, + (isatty(2) ? exp_getpid : EXP_NOPID)); + f->leaveopen = 1; + } + if (strcmp(Tcl_GetChannelName(chan), "stderr") != 0) { + f = exp_f_new(interp, chan, "stderr", + (isatty(2) ? exp_getpid : EXP_NOPID)); + f->leaveopen = 1; + } + + /* + * Create the 'exp_any' spawn id that is meant to many any spawn ids. + */ + + f = exp_f_new(interp, NULL, "exp_any", exp_getpid); + f->alwaysopen = 1; + exp_f_any = f; + +#ifdef XXX + /* really should be in interpreter() but silly to do on every call */ + exp_adjust(&exp_fs[0]); +#endif +} ADDED generic/expDecls.h Index: generic/expDecls.h ================================================================== --- /dev/null +++ generic/expDecls.h @@ -0,0 +1,678 @@ +/* ---------------------------------------------------------------------------- + * expDecls.h -- + * + * Declarations of functions in the platform independent public + * Expect API. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expDecls.h,v 1.1.4.2 2002/02/10 12:04:22 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#ifndef _EXPDECLS +#define _EXPDECLS + +/* + * WARNING: This file is automatically generated by the $(TCLROOT)/tools/genStubs.tcl + * script. Any modifications to the function declarations below should be made + * in the generic/exp.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* 0 */ +TCL_EXTERN(int) Expect_Init _ANSI_ARGS_((Tcl_Interp * interp)); +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* 3 */ +TCL_EXTERN(int) Exp_ExpInternalCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char * argv[])); +/* Slot 4 is reserved */ +/* 5 */ +TCL_EXTERN(int) Exp_ExitCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 6 */ +TCL_EXTERN(int) Exp_ExpContinueCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char * argv[])); +/* Slot 7 is reserved */ +/* 8 */ +TCL_EXTERN(int) Exp_ExpPidCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 9 */ +TCL_EXTERN(int) Exp_GetpidDeprecatedCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char * argv[])); +/* Slot 10 is reserved */ +/* 11 */ +TCL_EXTERN(int) Exp_LogFileCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 12 */ +TCL_EXTERN(int) Exp_LogUserCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 13 */ +TCL_EXTERN(int) Exp_OpenCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* Slot 14 is reserved */ +/* Slot 15 is reserved */ +/* Slot 16 is reserved */ +/* 17 */ +TCL_EXTERN(int) Exp_SendLogCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 18 */ +TCL_EXTERN(int) Exp_SleepCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 19 */ +TCL_EXTERN(int) Exp_SpawnCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 20 */ +TCL_EXTERN(int) Exp_StraceCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 21 */ +TCL_EXTERN(int) Exp_WaitCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 22 */ +TCL_EXTERN(int) Exp_ExpVersionCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 23 */ +TCL_EXTERN(int) Exp_Prompt1Cmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 24 */ +TCL_EXTERN(int) Exp_Prompt2Cmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 25 */ +TCL_EXTERN(int) Exp_TrapCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 26 */ +TCL_EXTERN(int) Exp_SttyCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 27 */ +TCL_EXTERN(int) Exp_SystemCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 28 */ +TCL_EXTERN(int) Exp_ExpectCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int objc, + Tcl_Obj *CONST objv[])); +/* 29 */ +TCL_EXTERN(int) Exp_ExpectGlobalCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, Tcl_Obj *CONST objv[])); +/* 30 */ +TCL_EXTERN(int) Exp_MatchMaxCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 31 */ +TCL_EXTERN(int) Exp_RemoveNullsCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char * argv[])); +/* 32 */ +TCL_EXTERN(int) Exp_ParityCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 33 */ +TCL_EXTERN(int) Exp_TimestampCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 34 */ +TCL_EXTERN(int) Exp_CloseCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 35 */ +TCL_EXTERN(int) Exp_InterpreterCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp * interp, + int argc, char * argv[])); +/* 36 */ +TCL_EXTERN(int) Exp_SendCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* 37 */ +TCL_EXTERN(int) Exp_KillCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp * interp, int argc, char * argv[])); +/* Slot 38 is reserved */ +/* Slot 39 is reserved */ +/* 40 */ +TCL_EXTERN(char *) exp_printify _ANSI_ARGS_((char * s)); +/* Slot 41 is reserved */ +/* Slot 42 is reserved */ +/* Slot 43 is reserved */ +/* Slot 44 is reserved */ +/* Slot 45 is reserved */ +/* Slot 46 is reserved */ +/* Slot 47 is reserved */ +/* Slot 48 is reserved */ +/* Slot 49 is reserved */ +/* 50 */ +TCL_EXTERN(void) exp_errorlog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); +/* 51 */ +TCL_EXTERN(void) exp_log _ANSI_ARGS_(TCL_VARARGS(int,force_stdout)); +/* 52 */ +TCL_EXTERN(void) exp_debuglog _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); +/* 53 */ +TCL_EXTERN(void) exp_nflog _ANSI_ARGS_((char * buf, int force_stdout)); +/* 54 */ +TCL_EXTERN(void) exp_nferrorlog _ANSI_ARGS_((char * buf, + int force_stdout)); +/* 55 */ +TCL_EXTERN(void) exp_error _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); +/* Slot 56 is reserved */ +/* Slot 57 is reserved */ +/* Slot 58 is reserved */ +/* Slot 59 is reserved */ +/* 60 */ +TCL_EXTERN(void) exp_parse_argv _ANSI_ARGS_((Tcl_Interp * interp, + int argc, char ** argv)); +/* 61 */ +TCL_EXTERN(int) exp_interpreter _ANSI_ARGS_((Tcl_Interp * interp)); +/* 62 */ +TCL_EXTERN(int) exp_interpret_cmdfile _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Channel cmdfile)); +/* 63 */ +TCL_EXTERN(int) exp_interpret_cmdfilename _ANSI_ARGS_(( + Tcl_Interp * interp, char * filename)); +/* 64 */ +TCL_EXTERN(void) exp_interpret_rcfiles _ANSI_ARGS_(( + Tcl_Interp * interp, int my_rc, int sys_rc)); +/* 65 */ +TCL_EXTERN(char *) exp_cook _ANSI_ARGS_((CONST char * s, int * len)); +/* Slot 66 is reserved */ +/* 67 */ +TCL_EXTERN(int) exp_getpidproc _ANSI_ARGS_((void)); +/* 68 */ +TCL_EXTERN(Tcl_Channel) ExpCreateSpawnChannel _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Channel chan)); +/* 69 */ +TCL_EXTERN(int) ExpPlatformSpawnOutput _ANSI_ARGS_(( + ClientData instanceData, CONST char * bufPtr, + int toWrite, int * errorPtr)); +/* 70 */ +TCL_EXTERN(void) exp_init_main_cmds _ANSI_ARGS_((Tcl_Interp * interp)); +/* 71 */ +TCL_EXTERN(void) exp_init_expect_cmds _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 72 */ +TCL_EXTERN(void) exp_init_most_cmds _ANSI_ARGS_((Tcl_Interp * interp)); +/* 73 */ +TCL_EXTERN(void) exp_init_trap_cmds _ANSI_ARGS_((Tcl_Interp * interp)); +/* 74 */ +TCL_EXTERN(void) exp_init_interact_cmds _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 75 */ +TCL_EXTERN(int) exp_init_tty_cmds _ANSI_ARGS_((Tcl_Interp * interp)); +/* Slot 76 is reserved */ +/* Slot 77 is reserved */ +/* 78 */ +TCL_EXTERN(Tcl_Channel) ExpCreatePairChannel _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * chanInId, + CONST char * chanOutId, + CONST char * chanName)); +/* 79 */ +TCL_EXTERN(int) ExpSpawnOpen _ANSI_ARGS_((Tcl_Interp * interp, + char * chanId, int leaveopen)); +/* 80 */ +TCL_EXTERN(struct exp_f *) exp_update_master _ANSI_ARGS_(( + Tcl_Interp * interp, int opened, int adjust)); +/* 81 */ +TCL_EXTERN(CONST char *) exp_get_var _ANSI_ARGS_((Tcl_Interp * interp, + char * var)); +/* 82 */ +TCL_EXTERN(void) exp_exit _ANSI_ARGS_((Tcl_Interp * interp, + int status)); +/* 83 */ +TCL_EXTERN(int) exp_dsleep _ANSI_ARGS_((Tcl_Interp * interp, + double sec)); +/* 84 */ +TCL_EXTERN(void) exp_init_event _ANSI_ARGS_((void)); +/* Slot 85 is reserved */ +/* 86 */ +TCL_EXTERN(void) exp_background_filehandler _ANSI_ARGS_(( + ClientData clientData, int mask)); +/* 87 */ +TCL_EXTERN(void) exp_exit_handlers _ANSI_ARGS_((ClientData clientData)); +/* 88 */ +TCL_EXTERN(void) exp_close_on_exec _ANSI_ARGS_((int fd)); +/* 89 */ +TCL_EXTERN(int) exp_flageq_code _ANSI_ARGS_((char * flag, + char * string, int minlen)); +/* 90 */ +TCL_EXTERN(void) exp_close_tcl_files _ANSI_ARGS_((void)); +/* 91 */ +TCL_EXTERN(void) exp_lowmemcpy _ANSI_ARGS_((char * dest, + CONST char * src, int n)); +/* 92 */ +TCL_EXTERN(void) exp_timestamp _ANSI_ARGS_((Tcl_Interp * interp, + time_t * timeval, char * array)); + +typedef struct ExpStubHooks { + struct ExpPlatStubs *expPlatStubs; + struct ExpIntStubs *expIntStubs; + struct ExpIntPlatStubs *expIntPlatStubs; +} ExpStubHooks; + +typedef struct ExpStubs { + int magic; + struct ExpStubHooks *hooks; + + int (*expect_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */ + void *reserved1; + void *reserved2; + int (*exp_ExpInternalCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 3 */ + void *reserved4; + int (*exp_ExitCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 5 */ + int (*exp_ExpContinueCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 6 */ + void *reserved7; + int (*exp_ExpPidCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 8 */ + int (*exp_GetpidDeprecatedCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 9 */ + void *reserved10; + int (*exp_LogFileCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 11 */ + int (*exp_LogUserCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 12 */ + int (*exp_OpenCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 13 */ + void *reserved14; + void *reserved15; + void *reserved16; + int (*exp_SendLogCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 17 */ + int (*exp_SleepCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 18 */ + int (*exp_SpawnCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 19 */ + int (*exp_StraceCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 20 */ + int (*exp_WaitCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 21 */ + int (*exp_ExpVersionCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 22 */ + int (*exp_Prompt1Cmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 23 */ + int (*exp_Prompt2Cmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 24 */ + int (*exp_TrapCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 25 */ + int (*exp_SttyCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 26 */ + int (*exp_SystemCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 27 */ + int (*exp_ExpectCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 28 */ + int (*exp_ExpectGlobalCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, Tcl_Obj *CONST objv[])); /* 29 */ + int (*exp_MatchMaxCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 30 */ + int (*exp_RemoveNullsCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 31 */ + int (*exp_ParityCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 32 */ + int (*exp_TimestampCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 33 */ + int (*exp_CloseCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 34 */ + int (*exp_InterpreterCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 35 */ + int (*exp_SendCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 36 */ + int (*exp_KillCmd) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char * argv[])); /* 37 */ + void *reserved38; + void *reserved39; + char * (*exp_printify) _ANSI_ARGS_((char * s)); /* 40 */ + void *reserved41; + void *reserved42; + void *reserved43; + void *reserved44; + void *reserved45; + void *reserved46; + void *reserved47; + void *reserved48; + void *reserved49; + void (*exp_errorlog) _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); /* 50 */ + void (*exp_log) _ANSI_ARGS_(TCL_VARARGS(int,force_stdout)); /* 51 */ + void (*exp_debuglog) _ANSI_ARGS_(TCL_VARARGS(char *,fmt)); /* 52 */ + void (*exp_nflog) _ANSI_ARGS_((char * buf, int force_stdout)); /* 53 */ + void (*exp_nferrorlog) _ANSI_ARGS_((char * buf, int force_stdout)); /* 54 */ + void (*exp_error) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 55 */ + void *reserved56; + void *reserved57; + void *reserved58; + void *reserved59; + void (*exp_parse_argv) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv)); /* 60 */ + int (*exp_interpreter) _ANSI_ARGS_((Tcl_Interp * interp)); /* 61 */ + int (*exp_interpret_cmdfile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel cmdfile)); /* 62 */ + int (*exp_interpret_cmdfilename) _ANSI_ARGS_((Tcl_Interp * interp, char * filename)); /* 63 */ + void (*exp_interpret_rcfiles) _ANSI_ARGS_((Tcl_Interp * interp, int my_rc, int sys_rc)); /* 64 */ + char * (*exp_cook) _ANSI_ARGS_((CONST char * s, int * len)); /* 65 */ + void *reserved66; + int (*exp_getpidproc) _ANSI_ARGS_((void)); /* 67 */ + Tcl_Channel (*expCreateSpawnChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 68 */ + int (*expPlatformSpawnOutput) _ANSI_ARGS_((ClientData instanceData, CONST char * bufPtr, int toWrite, int * errorPtr)); /* 69 */ + void (*exp_init_main_cmds) _ANSI_ARGS_((Tcl_Interp * interp)); /* 70 */ + void (*exp_init_expect_cmds) _ANSI_ARGS_((Tcl_Interp * interp)); /* 71 */ + void (*exp_init_most_cmds) _ANSI_ARGS_((Tcl_Interp * interp)); /* 72 */ + void (*exp_init_trap_cmds) _ANSI_ARGS_((Tcl_Interp * interp)); /* 73 */ + void (*exp_init_interact_cmds) _ANSI_ARGS_((Tcl_Interp * interp)); /* 74 */ + int (*exp_init_tty_cmds) _ANSI_ARGS_((Tcl_Interp * interp)); /* 75 */ + void *reserved76; + void *reserved77; + Tcl_Channel (*expCreatePairChannel) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanInId, CONST char * chanOutId, CONST char * chanName)); /* 78 */ + int (*expSpawnOpen) _ANSI_ARGS_((Tcl_Interp * interp, char * chanId, int leaveopen)); /* 79 */ + struct exp_f * (*exp_update_master) _ANSI_ARGS_((Tcl_Interp * interp, int opened, int adjust)); /* 80 */ + CONST char * (*exp_get_var) _ANSI_ARGS_((Tcl_Interp * interp, char * var)); /* 81 */ + void (*exp_exit) _ANSI_ARGS_((Tcl_Interp * interp, int status)); /* 82 */ + int (*exp_dsleep) _ANSI_ARGS_((Tcl_Interp * interp, double sec)); /* 83 */ + void (*exp_init_event) _ANSI_ARGS_((void)); /* 84 */ + void *reserved85; + void (*exp_background_filehandler) _ANSI_ARGS_((ClientData clientData, int mask)); /* 86 */ + void (*exp_exit_handlers) _ANSI_ARGS_((ClientData clientData)); /* 87 */ + void (*exp_close_on_exec) _ANSI_ARGS_((int fd)); /* 88 */ + int (*exp_flageq_code) _ANSI_ARGS_((char * flag, char * string, int minlen)); /* 89 */ + void (*exp_close_tcl_files) _ANSI_ARGS_((void)); /* 90 */ + void (*exp_lowmemcpy) _ANSI_ARGS_((char * dest, CONST char * src, int n)); /* 91 */ + void (*exp_timestamp) _ANSI_ARGS_((Tcl_Interp * interp, time_t * timeval, char * array)); /* 92 */ +} ExpStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern ExpStubs *expStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifndef Expect_Init +#define Expect_Init \ + (expStubsPtr->expect_Init) /* 0 */ +#endif +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +#ifndef Exp_ExpInternalCmd +#define Exp_ExpInternalCmd \ + (expStubsPtr->exp_ExpInternalCmd) /* 3 */ +#endif +/* Slot 4 is reserved */ +#ifndef Exp_ExitCmd +#define Exp_ExitCmd \ + (expStubsPtr->exp_ExitCmd) /* 5 */ +#endif +#ifndef Exp_ExpContinueCmd +#define Exp_ExpContinueCmd \ + (expStubsPtr->exp_ExpContinueCmd) /* 6 */ +#endif +/* Slot 7 is reserved */ +#ifndef Exp_ExpPidCmd +#define Exp_ExpPidCmd \ + (expStubsPtr->exp_ExpPidCmd) /* 8 */ +#endif +#ifndef Exp_GetpidDeprecatedCmd +#define Exp_GetpidDeprecatedCmd \ + (expStubsPtr->exp_GetpidDeprecatedCmd) /* 9 */ +#endif +/* Slot 10 is reserved */ +#ifndef Exp_LogFileCmd +#define Exp_LogFileCmd \ + (expStubsPtr->exp_LogFileCmd) /* 11 */ +#endif +#ifndef Exp_LogUserCmd +#define Exp_LogUserCmd \ + (expStubsPtr->exp_LogUserCmd) /* 12 */ +#endif +#ifndef Exp_OpenCmd +#define Exp_OpenCmd \ + (expStubsPtr->exp_OpenCmd) /* 13 */ +#endif +/* Slot 14 is reserved */ +/* Slot 15 is reserved */ +/* Slot 16 is reserved */ +#ifndef Exp_SendLogCmd +#define Exp_SendLogCmd \ + (expStubsPtr->exp_SendLogCmd) /* 17 */ +#endif +#ifndef Exp_SleepCmd +#define Exp_SleepCmd \ + (expStubsPtr->exp_SleepCmd) /* 18 */ +#endif +#ifndef Exp_SpawnCmd +#define Exp_SpawnCmd \ + (expStubsPtr->exp_SpawnCmd) /* 19 */ +#endif +#ifndef Exp_StraceCmd +#define Exp_StraceCmd \ + (expStubsPtr->exp_StraceCmd) /* 20 */ +#endif +#ifndef Exp_WaitCmd +#define Exp_WaitCmd \ + (expStubsPtr->exp_WaitCmd) /* 21 */ +#endif +#ifndef Exp_ExpVersionCmd +#define Exp_ExpVersionCmd \ + (expStubsPtr->exp_ExpVersionCmd) /* 22 */ +#endif +#ifndef Exp_Prompt1Cmd +#define Exp_Prompt1Cmd \ + (expStubsPtr->exp_Prompt1Cmd) /* 23 */ +#endif +#ifndef Exp_Prompt2Cmd +#define Exp_Prompt2Cmd \ + (expStubsPtr->exp_Prompt2Cmd) /* 24 */ +#endif +#ifndef Exp_TrapCmd +#define Exp_TrapCmd \ + (expStubsPtr->exp_TrapCmd) /* 25 */ +#endif +#ifndef Exp_SttyCmd +#define Exp_SttyCmd \ + (expStubsPtr->exp_SttyCmd) /* 26 */ +#endif +#ifndef Exp_SystemCmd +#define Exp_SystemCmd \ + (expStubsPtr->exp_SystemCmd) /* 27 */ +#endif +#ifndef Exp_ExpectCmd +#define Exp_ExpectCmd \ + (expStubsPtr->exp_ExpectCmd) /* 28 */ +#endif +#ifndef Exp_ExpectGlobalCmd +#define Exp_ExpectGlobalCmd \ + (expStubsPtr->exp_ExpectGlobalCmd) /* 29 */ +#endif +#ifndef Exp_MatchMaxCmd +#define Exp_MatchMaxCmd \ + (expStubsPtr->exp_MatchMaxCmd) /* 30 */ +#endif +#ifndef Exp_RemoveNullsCmd +#define Exp_RemoveNullsCmd \ + (expStubsPtr->exp_RemoveNullsCmd) /* 31 */ +#endif +#ifndef Exp_ParityCmd +#define Exp_ParityCmd \ + (expStubsPtr->exp_ParityCmd) /* 32 */ +#endif +#ifndef Exp_TimestampCmd +#define Exp_TimestampCmd \ + (expStubsPtr->exp_TimestampCmd) /* 33 */ +#endif +#ifndef Exp_CloseCmd +#define Exp_CloseCmd \ + (expStubsPtr->exp_CloseCmd) /* 34 */ +#endif +#ifndef Exp_InterpreterCmd +#define Exp_InterpreterCmd \ + (expStubsPtr->exp_InterpreterCmd) /* 35 */ +#endif +#ifndef Exp_SendCmd +#define Exp_SendCmd \ + (expStubsPtr->exp_SendCmd) /* 36 */ +#endif +#ifndef Exp_KillCmd +#define Exp_KillCmd \ + (expStubsPtr->exp_KillCmd) /* 37 */ +#endif +/* Slot 38 is reserved */ +/* Slot 39 is reserved */ +#ifndef exp_printify +#define exp_printify \ + (expStubsPtr->exp_printify) /* 40 */ +#endif +/* Slot 41 is reserved */ +/* Slot 42 is reserved */ +/* Slot 43 is reserved */ +/* Slot 44 is reserved */ +/* Slot 45 is reserved */ +/* Slot 46 is reserved */ +/* Slot 47 is reserved */ +/* Slot 48 is reserved */ +/* Slot 49 is reserved */ +#ifndef exp_errorlog +#define exp_errorlog \ + (expStubsPtr->exp_errorlog) /* 50 */ +#endif +#ifndef exp_log +#define exp_log \ + (expStubsPtr->exp_log) /* 51 */ +#endif +#ifndef exp_debuglog +#define exp_debuglog \ + (expStubsPtr->exp_debuglog) /* 52 */ +#endif +#ifndef exp_nflog +#define exp_nflog \ + (expStubsPtr->exp_nflog) /* 53 */ +#endif +#ifndef exp_nferrorlog +#define exp_nferrorlog \ + (expStubsPtr->exp_nferrorlog) /* 54 */ +#endif +#ifndef exp_error +#define exp_error \ + (expStubsPtr->exp_error) /* 55 */ +#endif +/* Slot 56 is reserved */ +/* Slot 57 is reserved */ +/* Slot 58 is reserved */ +/* Slot 59 is reserved */ +#ifndef exp_parse_argv +#define exp_parse_argv \ + (expStubsPtr->exp_parse_argv) /* 60 */ +#endif +#ifndef exp_interpreter +#define exp_interpreter \ + (expStubsPtr->exp_interpreter) /* 61 */ +#endif +#ifndef exp_interpret_cmdfile +#define exp_interpret_cmdfile \ + (expStubsPtr->exp_interpret_cmdfile) /* 62 */ +#endif +#ifndef exp_interpret_cmdfilename +#define exp_interpret_cmdfilename \ + (expStubsPtr->exp_interpret_cmdfilename) /* 63 */ +#endif +#ifndef exp_interpret_rcfiles +#define exp_interpret_rcfiles \ + (expStubsPtr->exp_interpret_rcfiles) /* 64 */ +#endif +#ifndef exp_cook +#define exp_cook \ + (expStubsPtr->exp_cook) /* 65 */ +#endif +/* Slot 66 is reserved */ +#ifndef exp_getpidproc +#define exp_getpidproc \ + (expStubsPtr->exp_getpidproc) /* 67 */ +#endif +#ifndef ExpCreateSpawnChannel +#define ExpCreateSpawnChannel \ + (expStubsPtr->expCreateSpawnChannel) /* 68 */ +#endif +#ifndef ExpPlatformSpawnOutput +#define ExpPlatformSpawnOutput \ + (expStubsPtr->expPlatformSpawnOutput) /* 69 */ +#endif +#ifndef exp_init_main_cmds +#define exp_init_main_cmds \ + (expStubsPtr->exp_init_main_cmds) /* 70 */ +#endif +#ifndef exp_init_expect_cmds +#define exp_init_expect_cmds \ + (expStubsPtr->exp_init_expect_cmds) /* 71 */ +#endif +#ifndef exp_init_most_cmds +#define exp_init_most_cmds \ + (expStubsPtr->exp_init_most_cmds) /* 72 */ +#endif +#ifndef exp_init_trap_cmds +#define exp_init_trap_cmds \ + (expStubsPtr->exp_init_trap_cmds) /* 73 */ +#endif +#ifndef exp_init_interact_cmds +#define exp_init_interact_cmds \ + (expStubsPtr->exp_init_interact_cmds) /* 74 */ +#endif +#ifndef exp_init_tty_cmds +#define exp_init_tty_cmds \ + (expStubsPtr->exp_init_tty_cmds) /* 75 */ +#endif +/* Slot 76 is reserved */ +/* Slot 77 is reserved */ +#ifndef ExpCreatePairChannel +#define ExpCreatePairChannel \ + (expStubsPtr->expCreatePairChannel) /* 78 */ +#endif +#ifndef ExpSpawnOpen +#define ExpSpawnOpen \ + (expStubsPtr->expSpawnOpen) /* 79 */ +#endif +#ifndef exp_update_master +#define exp_update_master \ + (expStubsPtr->exp_update_master) /* 80 */ +#endif +#ifndef exp_get_var +#define exp_get_var \ + (expStubsPtr->exp_get_var) /* 81 */ +#endif +#ifndef exp_exit +#define exp_exit \ + (expStubsPtr->exp_exit) /* 82 */ +#endif +#ifndef exp_dsleep +#define exp_dsleep \ + (expStubsPtr->exp_dsleep) /* 83 */ +#endif +#ifndef exp_init_event +#define exp_init_event \ + (expStubsPtr->exp_init_event) /* 84 */ +#endif +/* Slot 85 is reserved */ +#ifndef exp_background_filehandler +#define exp_background_filehandler \ + (expStubsPtr->exp_background_filehandler) /* 86 */ +#endif +#ifndef exp_exit_handlers +#define exp_exit_handlers \ + (expStubsPtr->exp_exit_handlers) /* 87 */ +#endif +#ifndef exp_close_on_exec +#define exp_close_on_exec \ + (expStubsPtr->exp_close_on_exec) /* 88 */ +#endif +#ifndef exp_flageq_code +#define exp_flageq_code \ + (expStubsPtr->exp_flageq_code) /* 89 */ +#endif +#ifndef exp_close_tcl_files +#define exp_close_tcl_files \ + (expStubsPtr->exp_close_tcl_files) /* 90 */ +#endif +#ifndef exp_lowmemcpy +#define exp_lowmemcpy \ + (expStubsPtr->exp_lowmemcpy) /* 91 */ +#endif +#ifndef exp_timestamp +#define exp_timestamp \ + (expStubsPtr->exp_timestamp) /* 92 */ +#endif + +#endif /* defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _EXPDECLS */ ADDED generic/expInt.h Index: generic/expInt.h ================================================================== --- /dev/null +++ generic/expInt.h @@ -0,0 +1,301 @@ +/* ---------------------------------------------------------------------------- + * expInt.h -- + * + * Declarations of things used internally by Expect. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expInt.h,v 1.1.4.4 2002/02/13 02:39:41 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#ifndef _EXPINT +#define _EXPINT + +#ifndef _EXP +# include "exp.h" +#endif + +#ifndef _TCLPORT +# include "tclPort.h" +#endif + + +#undef TCL_STORAGE_CLASS +#if defined(BUILD_slavedriver) +# define TCL_STORAGE_CLASS +#elif defined(BUILD_exp) +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_EXP_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * 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 + + +#define EXP_SPAWN_ID_VARNAME "spawn_id" +#define EXP_SPAWN_OUT "spawn_out" + +#define EXP_SPAWN_ID_ANY_VARNAME "any_spawn_id" +#define EXP_SPAWN_ID_ANY "exp_any" + +#define EXP_SPAWN_ID_ERROR "stderr" +#define EXP_SPAWN_ID_USER "exp_user" + +#define EXP_NOPID 0 /* Used when there is no associated pid to */ + /* wait for. For example: */ + /* 1) When fd opened by someone else, e.g., */ + /* Tcl's open */ + /* 2) When entry not in use */ + /* 3) To tell user pid of "spawn -open" */ + /* 4) stdin, out, error */ + +#define EXP_NOFD -1 + +/* these are occasionally useful to distinguish between various expect */ +/* commands and are also used as array indices into the per-fd eg[] arrays */ +#define EXP_CMD_BEFORE 0 +#define EXP_CMD_AFTER 1 +#define EXP_CMD_BG 2 +#define EXP_CMD_FG 3 + +#define streq(x,y) (0 == strcmp((x),(y))) +#define dprintify(x) ((exp_is_debugging || exp_debugfile)?exp_printify(x):0) + +#define exp_flageq(flag,string,minlen) \ +(((string)[0] == (flag)[0]) && (exp_flageq_code(((flag)+1),((string)+1),((minlen)-1)))) + +/* exp_flageq for single char flags */ +#define exp_flageq1(flag,string) \ + ((string[0] == flag) && (string[1] == '\0')) + + +/* 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 { + char *spawnId; /* Spawn identifier name */ + Tcl_HashEntry *hashPtr; /* The hash entry with this structure */ + Tcl_Interp *interp; + int pid; /* pid or EXP_NOPID if no pid */ + Tcl_Pid tclPid; /* The pid that tcl wants */ + 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 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 */ +#ifdef __WIN32__ + OVERLAPPED over; /* Overlapped result */ +#endif + Tcl_Channel channel;/* Tcl channel */ + Tcl_Channel Master; /* corresponds to master fd */ + /* + * explicit fds aren't necessary now, but since the code is already + * here from before Tcl required TclFile, we'll continue using + * the old fds. If we ever port this code to a non-UNIX system, + * we'll dump the fds totally. + */ + + int slave_fd; /* slave fd if "spawn -pty" used */ +#ifdef HAVE_PTYTRAP + char *slave_name; /* Full name of slave, i.e., /dev/ttyp0 */ +#endif + int leaveopen; /* If we should not call Tcl's close when we close - + * only relevant if Tcl does the original open. It + * also serves as a ref count to how many times this + * channel has been opened with spawn -leaveopen */ + int alwaysopen; /* Set if this is identifier that should always exist */ + 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; + + int matched; /* Chars matched. Used by expectlib */ + Tcl_ChannelProc *event_proc; /* Currently installed channel handler */ + ClientData event_data; /* Argument that was installed */ +}; + +struct exp_fs_list { + struct exp_f *f; + struct exp_fs_list *next; +}; + +/* describes a -i flag */ +struct exp_i { + int cmdtype; /* EXP_CMD_XXX. When an indirect update is */ + /* triggered by Tcl, this helps tell us in what */ + /* exp_i list to look in. */ + int direct; /* if EXP_DIRECT, then the spawn ids have been given */ + /* literally, else indirectly through a variable */ + int duration; /* if EXP_PERMANENT, char ptrs here had to be */ + /* malloc'd because Tcl command line went away - */ + /* i.e., in expect_before/after */ + char *variable; + char *value; /* if type == direct, this is the string that the */ + /* user originally supplied to the -i flag. It may */ + /* lose relevance as the fd_list is manipulated */ + /* over time. If type == direct, this is the */ + /* cached value of variable use this to tell if it */ + /* has changed or not, and ergo whether it's */ + /* necessary to reparse. */ + + int ecount; /* # of ecases this is used by */ + + struct exp_fs_list *fs_list; + struct exp_i *next; +}; + +#define EXP_TEMPORARY 1 /* expect */ +#define EXP_PERMANENT 2 /* expect_after, expect_before, expect_bg */ +#define EXP_DIRECT 1 +#define EXP_INDIRECT 2 + + +/* + * 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 */ +#define exp_proc(cmdproc) 0, cmdproc +#define exp_deleteProc ((Tcl_CmdDeleteProc *) NULL) +#define exp_deleteProc ((Tcl_CmdDeleteProc *) NULL) + +struct exp_cmd_data { + char *name; + Tcl_ObjCmdProc *objproc; + Tcl_CmdProc *proc; + ClientData data; + int flags; +}; + + + +#define EXP_TEMPORARY 1 /* expect */ +#define EXP_PERMANENT 2 /* expect_after, expect_before, expect_bg */ + +#define EXP_DIRECT 1 +#define EXP_INDIRECT 2 + +typedef struct { + Tcl_Channel channelPtr; + int toWrite; +} ExpSpawnState; + + +/* + * ---------------------------------------- + * Global variables that are externalized. + * ---------------------------------------- + */ + + +/* Table of struct exp_f */ +TCL_EXTERN(Tcl_HashTable *) exp_f_table; + +TCL_EXTERN(char *) exp_onexit_action; +TCL_EXTERN(Tcl_Channel) exp_debugfile; +TCL_EXTERN(Tcl_Channel) exp_logfile; +TCL_EXTERN(int) exp_logfile_all; +TCL_EXTERN(int) exp_loguser; +/* useful to know to avoid debug calls */ +TCL_EXTERN(int) exp_is_debugging; +TCL_EXTERN(struct exp_f *) exp_f_any; +TCL_EXTERN(int) exp_default_match_max; +TCL_EXTERN(int) exp_default_parity; +TCL_EXTERN(int) exp_default_rm_nulls; +TCL_EXTERN(struct exp_f *) exp_dev_tty; +TCL_EXTERN(char *) exp_dev_tty_id; +TCL_EXTERN(int) exp_stdin_is_tty; +TCL_EXTERN(int) exp_stdout_is_tty; +/* procedure to close files in child */ +TCL_EXTERN(void) (*exp_close_in_child) _ANSI_ARGS_((void)); +/* place to pass a string generated */ +TCL_EXTERN(char *) exp_pty_error; +/* pid of Expect itself */ +TCL_EXTERN(int) exp_getpid; +TCL_EXTERN(Tcl_Interp *) exp_interp; +TCL_EXTERN(void) (*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *interp)); +/* # of times descriptors have been closed + * or indirect lists have been changed */ +TCL_EXTERN(int) exp_configure_count; +/* TRUE if user has requested unrolling of + * stack with no trace */ +TCL_EXTERN(int) exp_nostack_dump; +TCL_EXTERN(int) expect_key; + +/* protos not yet moved to the Stubs table */ +//TCL_EXTERN(int) exp_fcheck _ANSI_ARGS_((Tcl_Interp *, struct exp_f *,int,int,char *)); +//TCL_EXTERN(void) exp_buffer_shuffle _ANSI_ARGS_((Tcl_Interp *,struct exp_f *,int,char *,char *)); +//TCL_EXTERN(int) exp_close_fd _ANSI_ARGS_((Tcl_Interp *,int)); +//TCL_EXTERN(void) exp_close_all _ANSI_ARGS_((Tcl_Interp *)); +//TCL_EXTERN(void) exp_trap_on _ANSI_ARGS_((int)); +//TCL_EXTERN(int) exp_trap_off _ANSI_ARGS_((char *)); +/*EXTERN(void) exp_init_expect _ANSI_ARGS_((Tcl_Interp *));*/ +//TCL_EXTERN(int) exp_tcl2_returnvalue _ANSI_ARGS_((int)); +//TCL_EXTERN(int) exp_2tcl_returnvalue _ANSI_ARGS_((int)); +//TCL_EXTERN(int) exp_string_to_signal _ANSI_ARGS_((Tcl_Interp *,char *)); + +#include "expIntDecls.h" + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* _EXPINT */ ADDED generic/expIntDecls.h Index: generic/expIntDecls.h ================================================================== --- /dev/null +++ generic/expIntDecls.h @@ -0,0 +1,399 @@ +/* + * expIntDecls.h -- + * + * Declarations of functions in the platform independent internal + * Expect API. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expIntDecls.h,v 1.1.4.4 2002/02/10 13:40:47 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#ifndef _EXPINTDECLS +#define _EXPINTDECLS + +/* + * WARNING: This file is automatically generated by the tools/genStubs.tcl + * script. Any modifications to the function declarations below should be made + * in the exp.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* Slot 0 is reserved */ +/* 1 */ +TCL_EXTERN(int) Exp_StringMatch _ANSI_ARGS_((CONST char * string, + CONST char * pattern, int * offset)); +/* 2 */ +TCL_EXTERN(int) Exp_StringMatch2 _ANSI_ARGS_((CONST char * string, + CONST char * pattern)); +/* Slot 3 is reserved */ +/* 4 */ +TCL_EXTERN(struct exp_i *) exp_new_i_complex _ANSI_ARGS_(( + Tcl_Interp * interp, char * arg, + int duration, Tcl_VarTraceProc * updateproc, + CONST char * msg)); +/* 5 */ +TCL_EXTERN(struct exp_i *) exp_new_i_simple _ANSI_ARGS_((struct exp_f * fd, + int duration)); +/* 6 */ +TCL_EXTERN(struct exp_fs_list *) exp_new_fs _ANSI_ARGS_((struct exp_f * f)); +/* 7 */ +TCL_EXTERN(void) exp_free_i _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_i * i, + Tcl_VarTraceProc * updateproc)); +/* 8 */ +TCL_EXTERN(void) exp_free_fs _ANSI_ARGS_(( + struct exp_fs_list * fs_first)); +/* 9 */ +TCL_EXTERN(void) exp_free_fs_single _ANSI_ARGS_(( + struct exp_fs_list * fs)); +/* 10 */ +TCL_EXTERN(void) exp_i_update _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_i * i)); +/* 11 */ +TCL_EXTERN(void) exp_pty_exit _ANSI_ARGS_((void)); +/* 12 */ +TCL_EXTERN(void) exp_init_spawn_ids _ANSI_ARGS_((Tcl_Interp * interp)); +/* 13 */ +TCL_EXTERN(void) exp_init_pty _ANSI_ARGS_((Tcl_Interp * interp)); +/* 14 */ +TCL_EXTERN(void) exp_init_tty _ANSI_ARGS_((Tcl_Interp * interp)); +/* 15 */ +TCL_EXTERN(void) exp_init_stdio _ANSI_ARGS_((void)); +/* 16 */ +TCL_EXTERN(void) exp_init_sig _ANSI_ARGS_((void)); +/* 17 */ +TCL_EXTERN(void) exp_init_trap _ANSI_ARGS_((void)); +/* 18 */ +TCL_EXTERN(void) exp_init_unit_random _ANSI_ARGS_((void)); +/* 19 */ +TCL_EXTERN(void) exp_init_spawn_id_vars _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 20 */ +TCL_EXTERN(void) exp_adjust _ANSI_ARGS_((struct exp_f * f)); +/* 21 */ +TCL_EXTERN(void) exp_ecmd_remove_f_direct_and_indirect _ANSI_ARGS_(( + Tcl_Interp * interp, struct exp_f * f)); +/* 22 */ +TCL_EXTERN(void) exp_rearm_sigchld _ANSI_ARGS_((Tcl_Interp * interp)); +/* 23 */ +TCL_EXTERN(struct exp_f *) exp_chan2f _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * chan, int opened, int adjust, + CONST char * msg)); +/* 24 */ +TCL_EXTERN(int) exp_fcheck _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_f * f, int opened, int adjust, + CONST char * msg)); +/* 25 */ +TCL_EXTERN(int) exp_close _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_f * f)); +/* 26 */ +TCL_EXTERN(void) exp_strftime _ANSI_ARGS_((char * format, + const struct tm * timeptr, + Tcl_DString * dstring)); +/* 27 */ +TCL_EXTERN(void) exp_create_commands _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_cmd_data * c)); +/* 28 */ +TCL_EXTERN(void) exp_tty_break _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_f * f)); +/* 29 */ +TCL_EXTERN(void) exp_event_disarm _ANSI_ARGS_((struct exp_f * f)); +/* 30 */ +TCL_EXTERN(void) exp_arm_background_filehandler _ANSI_ARGS_(( + struct exp_f * f)); +/* 31 */ +TCL_EXTERN(void) exp_disarm_background_filehandler _ANSI_ARGS_(( + struct exp_f * f)); +/* 32 */ +TCL_EXTERN(void) exp_disarm_background_filehandler_force _ANSI_ARGS_(( + struct exp_f * f)); +/* 33 */ +TCL_EXTERN(void) exp_unblock_background_filehandler _ANSI_ARGS_(( + struct exp_f * f)); +/* 34 */ +TCL_EXTERN(void) exp_block_background_filehandler _ANSI_ARGS_(( + struct exp_f * f)); +/* 35 */ +TCL_EXTERN(int) exp_get_next_event _ANSI_ARGS_((Tcl_Interp * interp, + struct exp_f ** masters, int n, + struct exp_f ** master_out, int timeout, + int key)); +/* 36 */ +TCL_EXTERN(int) exp_get_next_event_info _ANSI_ARGS_(( + Tcl_Interp * interp, struct exp_f * fd, + int ready_mask)); +/* 37 */ +TCL_EXTERN(struct exp_f *) exp_f_find _ANSI_ARGS_((Tcl_Interp * interp, + char * spawnId)); +/* 38 */ +TCL_EXTERN(struct exp_f *) exp_f_new _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_Channel chan, char * spawnId, int pid)); +/* 39 */ +TCL_EXTERN(int) exp_f_new_platform _ANSI_ARGS_((struct exp_f * f)); +/* 40 */ +TCL_EXTERN(void) exp_f_free _ANSI_ARGS_((struct exp_f * f)); +/* 41 */ +TCL_EXTERN(void) exp_f_free_platform _ANSI_ARGS_((struct exp_f * f)); +/* 42 */ +TCL_EXTERN(int) exp_exact_write _ANSI_ARGS_((struct exp_f * f, + char * buffer, int rembytes)); + +typedef struct ExpIntStubs { + int magic; + struct ExpIntStubHooks *hooks; + + void *reserved0; + int (*exp_StringMatch) _ANSI_ARGS_((CONST char * string, CONST char * pattern, int * offset)); /* 1 */ + int (*exp_StringMatch2) _ANSI_ARGS_((CONST char * string, CONST char * pattern)); /* 2 */ + void *reserved3; + struct exp_i * (*exp_new_i_complex) _ANSI_ARGS_((Tcl_Interp * interp, char * arg, int duration, Tcl_VarTraceProc * updateproc, CONST char * msg)); /* 4 */ + struct exp_i * (*exp_new_i_simple) _ANSI_ARGS_((struct exp_f * fd, int duration)); /* 5 */ + struct exp_fs_list * (*exp_new_fs) _ANSI_ARGS_((struct exp_f * f)); /* 6 */ + void (*exp_free_i) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_i * i, Tcl_VarTraceProc * updateproc)); /* 7 */ + void (*exp_free_fs) _ANSI_ARGS_((struct exp_fs_list * fs_first)); /* 8 */ + void (*exp_free_fs_single) _ANSI_ARGS_((struct exp_fs_list * fs)); /* 9 */ + void (*exp_i_update) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_i * i)); /* 10 */ + void (*exp_pty_exit) _ANSI_ARGS_((void)); /* 11 */ + void (*exp_init_spawn_ids) _ANSI_ARGS_((Tcl_Interp * interp)); /* 12 */ + void (*exp_init_pty) _ANSI_ARGS_((Tcl_Interp * interp)); /* 13 */ + void (*exp_init_tty) _ANSI_ARGS_((Tcl_Interp * interp)); /* 14 */ + void (*exp_init_stdio) _ANSI_ARGS_((void)); /* 15 */ + void (*exp_init_sig) _ANSI_ARGS_((void)); /* 16 */ + void (*exp_init_trap) _ANSI_ARGS_((void)); /* 17 */ + void (*exp_init_unit_random) _ANSI_ARGS_((void)); /* 18 */ + void (*exp_init_spawn_id_vars) _ANSI_ARGS_((Tcl_Interp * interp)); /* 19 */ + void (*exp_adjust) _ANSI_ARGS_((struct exp_f * f)); /* 20 */ + void (*exp_ecmd_remove_f_direct_and_indirect) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_f * f)); /* 21 */ + void (*exp_rearm_sigchld) _ANSI_ARGS_((Tcl_Interp * interp)); /* 22 */ + struct exp_f * (*exp_chan2f) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chan, int opened, int adjust, CONST char * msg)); /* 23 */ + int (*exp_fcheck) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_f * f, int opened, int adjust, CONST char * msg)); /* 24 */ + int (*exp_close) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_f * f)); /* 25 */ + void (*exp_strftime) _ANSI_ARGS_((char * format, const struct tm * timeptr, Tcl_DString * dstring)); /* 26 */ + void (*exp_create_commands) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_cmd_data * c)); /* 27 */ + void (*exp_tty_break) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_f * f)); /* 28 */ + void (*exp_event_disarm) _ANSI_ARGS_((struct exp_f * f)); /* 29 */ + void (*exp_arm_background_filehandler) _ANSI_ARGS_((struct exp_f * f)); /* 30 */ + void (*exp_disarm_background_filehandler) _ANSI_ARGS_((struct exp_f * f)); /* 31 */ + void (*exp_disarm_background_filehandler_force) _ANSI_ARGS_((struct exp_f * f)); /* 32 */ + void (*exp_unblock_background_filehandler) _ANSI_ARGS_((struct exp_f * f)); /* 33 */ + void (*exp_block_background_filehandler) _ANSI_ARGS_((struct exp_f * f)); /* 34 */ + int (*exp_get_next_event) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_f ** masters, int n, struct exp_f ** master_out, int timeout, int key)); /* 35 */ + int (*exp_get_next_event_info) _ANSI_ARGS_((Tcl_Interp * interp, struct exp_f * fd, int ready_mask)); /* 36 */ + struct exp_f * (*exp_f_find) _ANSI_ARGS_((Tcl_Interp * interp, char * spawnId)); /* 37 */ + struct exp_f * (*exp_f_new) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, char * spawnId, int pid)); /* 38 */ + int (*exp_f_new_platform) _ANSI_ARGS_((struct exp_f * f)); /* 39 */ + void (*exp_f_free) _ANSI_ARGS_((struct exp_f * f)); /* 40 */ + void (*exp_f_free_platform) _ANSI_ARGS_((struct exp_f * f)); /* 41 */ + int (*exp_exact_write) _ANSI_ARGS_((struct exp_f * f, char * buffer, int rembytes)); /* 42 */ +} ExpIntStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern ExpIntStubs *expIntStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) + +/* + * Inline function declarations: + */ + +/* Slot 0 is reserved */ +#ifndef Exp_StringMatch +#define Exp_StringMatch \ + (expIntStubsPtr->exp_StringMatch) /* 1 */ +#endif +#ifndef Exp_StringMatch2 +#define Exp_StringMatch2 \ + (expIntStubsPtr->exp_StringMatch2) /* 2 */ +#endif +/* Slot 3 is reserved */ +#ifndef exp_new_i_complex +#define exp_new_i_complex \ + (expIntStubsPtr->exp_new_i_complex) /* 4 */ +#endif +#ifndef exp_new_i_simple +#define exp_new_i_simple \ + (expIntStubsPtr->exp_new_i_simple) /* 5 */ +#endif +#ifndef exp_new_fs +#define exp_new_fs \ + (expIntStubsPtr->exp_new_fs) /* 6 */ +#endif +#ifndef exp_free_i +#define exp_free_i \ + (expIntStubsPtr->exp_free_i) /* 7 */ +#endif +#ifndef exp_free_fs +#define exp_free_fs \ + (expIntStubsPtr->exp_free_fs) /* 8 */ +#endif +#ifndef exp_free_fs_single +#define exp_free_fs_single \ + (expIntStubsPtr->exp_free_fs_single) /* 9 */ +#endif +#ifndef exp_i_update +#define exp_i_update \ + (expIntStubsPtr->exp_i_update) /* 10 */ +#endif +#ifndef exp_pty_exit +#define exp_pty_exit \ + (expIntStubsPtr->exp_pty_exit) /* 11 */ +#endif +#ifndef exp_init_spawn_ids +#define exp_init_spawn_ids \ + (expIntStubsPtr->exp_init_spawn_ids) /* 12 */ +#endif +#ifndef exp_init_pty +#define exp_init_pty \ + (expIntStubsPtr->exp_init_pty) /* 13 */ +#endif +#ifndef exp_init_tty +#define exp_init_tty \ + (expIntStubsPtr->exp_init_tty) /* 14 */ +#endif +#ifndef exp_init_stdio +#define exp_init_stdio \ + (expIntStubsPtr->exp_init_stdio) /* 15 */ +#endif +#ifndef exp_init_sig +#define exp_init_sig \ + (expIntStubsPtr->exp_init_sig) /* 16 */ +#endif +#ifndef exp_init_trap +#define exp_init_trap \ + (expIntStubsPtr->exp_init_trap) /* 17 */ +#endif +#ifndef exp_init_unit_random +#define exp_init_unit_random \ + (expIntStubsPtr->exp_init_unit_random) /* 18 */ +#endif +#ifndef exp_init_spawn_id_vars +#define exp_init_spawn_id_vars \ + (expIntStubsPtr->exp_init_spawn_id_vars) /* 19 */ +#endif +#ifndef exp_adjust +#define exp_adjust \ + (expIntStubsPtr->exp_adjust) /* 20 */ +#endif +#ifndef exp_ecmd_remove_f_direct_and_indirect +#define exp_ecmd_remove_f_direct_and_indirect \ + (expIntStubsPtr->exp_ecmd_remove_f_direct_and_indirect) /* 21 */ +#endif +#ifndef exp_rearm_sigchld +#define exp_rearm_sigchld \ + (expIntStubsPtr->exp_rearm_sigchld) /* 22 */ +#endif +#ifndef exp_chan2f +#define exp_chan2f \ + (expIntStubsPtr->exp_chan2f) /* 23 */ +#endif +#ifndef exp_fcheck +#define exp_fcheck \ + (expIntStubsPtr->exp_fcheck) /* 24 */ +#endif +#ifndef exp_close +#define exp_close \ + (expIntStubsPtr->exp_close) /* 25 */ +#endif +#ifndef exp_strftime +#define exp_strftime \ + (expIntStubsPtr->exp_strftime) /* 26 */ +#endif +#ifndef exp_create_commands +#define exp_create_commands \ + (expIntStubsPtr->exp_create_commands) /* 27 */ +#endif +#ifndef exp_tty_break +#define exp_tty_break \ + (expIntStubsPtr->exp_tty_break) /* 28 */ +#endif +#ifndef exp_event_disarm +#define exp_event_disarm \ + (expIntStubsPtr->exp_event_disarm) /* 29 */ +#endif +#ifndef exp_arm_background_filehandler +#define exp_arm_background_filehandler \ + (expIntStubsPtr->exp_arm_background_filehandler) /* 30 */ +#endif +#ifndef exp_disarm_background_filehandler +#define exp_disarm_background_filehandler \ + (expIntStubsPtr->exp_disarm_background_filehandler) /* 31 */ +#endif +#ifndef exp_disarm_background_filehandler_force +#define exp_disarm_background_filehandler_force \ + (expIntStubsPtr->exp_disarm_background_filehandler_force) /* 32 */ +#endif +#ifndef exp_unblock_background_filehandler +#define exp_unblock_background_filehandler \ + (expIntStubsPtr->exp_unblock_background_filehandler) /* 33 */ +#endif +#ifndef exp_block_background_filehandler +#define exp_block_background_filehandler \ + (expIntStubsPtr->exp_block_background_filehandler) /* 34 */ +#endif +#ifndef exp_get_next_event +#define exp_get_next_event \ + (expIntStubsPtr->exp_get_next_event) /* 35 */ +#endif +#ifndef exp_get_next_event_info +#define exp_get_next_event_info \ + (expIntStubsPtr->exp_get_next_event_info) /* 36 */ +#endif +#ifndef exp_f_find +#define exp_f_find \ + (expIntStubsPtr->exp_f_find) /* 37 */ +#endif +#ifndef exp_f_new +#define exp_f_new \ + (expIntStubsPtr->exp_f_new) /* 38 */ +#endif +#ifndef exp_f_new_platform +#define exp_f_new_platform \ + (expIntStubsPtr->exp_f_new_platform) /* 39 */ +#endif +#ifndef exp_f_free +#define exp_f_free \ + (expIntStubsPtr->exp_f_free) /* 40 */ +#endif +#ifndef exp_f_free_platform +#define exp_f_free_platform \ + (expIntStubsPtr->exp_f_free_platform) /* 41 */ +#endif +#ifndef exp_exact_write +#define exp_exact_write \ + (expIntStubsPtr->exp_exact_write) /* 42 */ +#endif + +#endif /* defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _EXPINTDECLS */ ADDED generic/expIntPlatDecls.h Index: generic/expIntPlatDecls.h ================================================================== --- /dev/null +++ generic/expIntPlatDecls.h @@ -0,0 +1,138 @@ +/* ---------------------------------------------------------------------------- + * expPlatIntDecls.h -- + * + * Declarations of platform specific internal Expect APIs. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expIntPlatDecls.h,v 1.1.4.4 2002/03/07 02:49:36 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#ifndef _EXPPLATINTDECLS +#define _EXPPLATINTDECLS + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +#ifdef __WIN32__ +/* 0 */ +TCL_EXTERN(DWORD) ExpWinApplicationType _ANSI_ARGS_(( + const char * originalName, + Tcl_DString * fullPath)); +/* 1 */ +TCL_EXTERN(DWORD) ExpWinCreateProcess _ANSI_ARGS_((int argc, + char *const * argv, HANDLE inputHandle, + HANDLE outputHandle, HANDLE errorHandle, + int allocConsole, int hideConsole, int debug, + int newProcessGroup, HANDLE * processPtr, + PDWORD globalPidPtr)); +/* 2 */ +TCL_EXTERN(void) ExpWinSyslog _ANSI_ARGS_(TCL_VARARGS(DWORD,errId)); +/* 3 */ +TCL_EXTERN(char *) ExpSyslogGetSysMsg _ANSI_ARGS_((DWORD errId)); +/* 4 */ +TCL_EXTERN(Tcl_Pid) Exp_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, + int options)); +/* 5 */ +TCL_EXTERN(void) Exp_KillProcess _ANSI_ARGS_((Tcl_Pid pid)); +/* 6 */ +TCL_EXTERN(void) ExpWinInit _ANSI_ARGS_((void)); +/* 7 */ +TCL_EXTERN(void) BuildCommandLine _ANSI_ARGS_(( + CONST char * executable, int argc, + char *const * argv, Tcl_DString * linePtr)); +#endif /* __WIN32__ */ + +typedef struct ExpIntPlatStubs { + int magic; + struct ExpIntPlatStubHooks *hooks; + +#ifdef __WIN32__ + DWORD (*expWinApplicationType) _ANSI_ARGS_((const char * originalName, Tcl_DString * fullPath)); /* 0 */ + DWORD (*expWinCreateProcess) _ANSI_ARGS_((int argc, char *const * argv, HANDLE inputHandle, HANDLE outputHandle, HANDLE errorHandle, int allocConsole, int hideConsole, int debug, int newProcessGroup, HANDLE * processPtr, PDWORD globalPidPtr)); /* 1 */ + void (*expWinSyslog) _ANSI_ARGS_(TCL_VARARGS(DWORD,errId)); /* 2 */ + char * (*expSyslogGetSysMsg) _ANSI_ARGS_((DWORD errId)); /* 3 */ + Tcl_Pid (*exp_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 4 */ + void (*exp_KillProcess) _ANSI_ARGS_((Tcl_Pid pid)); /* 5 */ + void (*expWinInit) _ANSI_ARGS_((void)); /* 6 */ + void (*buildCommandLine) _ANSI_ARGS_((CONST char * executable, int argc, char *const * argv, Tcl_DString * linePtr)); /* 7 */ +#endif /* __WIN32__ */ +} ExpIntPlatStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern ExpIntPlatStubs *expIntPlatStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifdef __WIN32__ +#ifndef ExpWinApplicationType +#define ExpWinApplicationType \ + (expIntPlatStubsPtr->expWinApplicationType) /* 0 */ +#endif +#ifndef ExpWinCreateProcess +#define ExpWinCreateProcess \ + (expIntPlatStubsPtr->expWinCreateProcess) /* 1 */ +#endif +#ifndef ExpWinSyslog +#define ExpWinSyslog \ + (expIntPlatStubsPtr->expWinSyslog) /* 2 */ +#endif +#ifndef ExpSyslogGetSysMsg +#define ExpSyslogGetSysMsg \ + (expIntPlatStubsPtr->expSyslogGetSysMsg) /* 3 */ +#endif +#ifndef Exp_WaitPid +#define Exp_WaitPid \ + (expIntPlatStubsPtr->exp_WaitPid) /* 4 */ +#endif +#ifndef Exp_KillProcess +#define Exp_KillProcess \ + (expIntPlatStubsPtr->exp_KillProcess) /* 5 */ +#endif +#ifndef ExpWinInit +#define ExpWinInit \ + (expIntPlatStubsPtr->expWinInit) /* 6 */ +#endif +#ifndef BuildCommandLine +#define BuildCommandLine \ + (expIntPlatStubsPtr->buildCommandLine) /* 7 */ +#endif +#endif /* __WIN32__ */ + +#endif /* defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _EXPPLATINTDECLS */ + + ADDED generic/expPlatDecls.h Index: generic/expPlatDecls.h ================================================================== --- /dev/null +++ generic/expPlatDecls.h @@ -0,0 +1,83 @@ +/* ---------------------------------------------------------------------------- + * expPlatDecls.h -- + * + * Declarations of platform specific Expect APIs. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expPlatDecls.h,v 1.1.4.1 2002/02/10 02:58:53 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#ifndef _EXPPLATDECLS +#define _EXPPLATDECLS + +/* + * Pull in the definition of TCHAR. Hopefully the compile flags + * of the core are matching against your project build for these + * public functions. BE AWARE. + */ +#ifdef __WIN32__ +# ifndef _TCHAR_DEFINED +# include +# ifndef _TCHAR_DEFINED + /* Borland seems to forget to set this. */ + typedef _TCHAR TCHAR; +# define _TCHAR_DEFINED +# endif +# endif +#endif + + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + + +typedef struct ExpPlatStubs { + int magic; + struct ExpPlatStubHooks *hooks; + +} ExpPlatStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern ExpPlatStubs *expPlatStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) + +/* + * Inline function declarations: + */ + + +#endif /* defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _EXPPLATDECLS */ + + ADDED generic/expPort.h Index: generic/expPort.h ================================================================== --- /dev/null +++ generic/expPort.h @@ -0,0 +1,26 @@ +/* + * expPort.h -- + * + * This header file handles porting issues that occur because + * of differences between systems. It reads in platform specific + * portability files. + * + * RCS: @(#) $Id: expPort.h,v 1.1.2.1 2001/10/28 01:02:39 davygrvy Exp $ + */ + +#ifndef _EXPPORT_H__ +#define _EXPPORT_H__ + +#define HAVE_MEMCPY + +#ifdef __WIN32__ +# include "../win/expWinPort.h" +#else +# if defined(MAC_TCL) +# include "../mac/expPort.h" +# else +# include "../unix/expUnixPort.h" +# endif +#endif + +#endif /* _EXPPORT_H__ */ ADDED generic/expSpawnChan.c Index: generic/expSpawnChan.c ================================================================== --- /dev/null +++ generic/expSpawnChan.c @@ -0,0 +1,342 @@ +/* ---------------------------------------------------------------------------- + * expWinChan.c -- + * + * Implements the exp_spawn channel id. This wraps a normal + * file channel in another channel so we can close the file + * channel normally but still have another id to wait on. + * The file channel is not exposed in any interps. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +static Tcl_DriverCloseProc ExpSpawnClose; +static Tcl_DriverInputProc ExpSpawnInput; +static Tcl_DriverOutputProc ExpSpawnOutput; +/*static Tcl_DriverSeekProc ExpSpawnSeek;*/ +static Tcl_DriverSetOptionProc ExpSpawnSetOption; +static Tcl_DriverGetOptionProc ExpSpawnGetOption; +static Tcl_DriverWatchProc ExpSpawnWatch; +static Tcl_DriverGetHandleProc ExpSpawnGetHandle; +static Tcl_DriverBlockModeProc ExpSpawnBlock; +/*static Tcl_DriverFlushProc ExpSpawnFlush;*/ +/*static Tcl_DriverHandlerProc ExpSpawnHandler;*/ + +static Tcl_ChannelType ExpSpawnChannelType = { + "exp_spawn", + TCL_CHANNEL_VERSION_2, + ExpSpawnClose, + ExpSpawnInput, + ExpSpawnOutput, + NULL, /* no seek! */ + ExpSpawnSetOption, + ExpSpawnGetOption, + ExpSpawnWatch, + ExpSpawnGetHandle, + NULL, /* no close2 */ + ExpSpawnBlock, + NULL, /* no flush */ + NULL /* no handler */ +}; + +/* + *---------------------------------------------------------------------- + * + * ExpCreateSpawnChannel -- + * + * Create an expect spawn identifier + * + * Results: + * A Tcl channel + * + * Side Effects: + * Allocates and registers a channel + * + *---------------------------------------------------------------------- + */ + +Tcl_Channel +ExpCreateSpawnChannel(interp, chan) + Tcl_Interp *interp; + Tcl_Channel chan; +{ + Tcl_Channel chan2; + ExpSpawnState *ssPtr; + + ssPtr = (ExpSpawnState *) ckalloc(sizeof(ExpSpawnState)); + ssPtr->channelPtr = chan; + ssPtr->toWrite = 0; + + chan2 = Tcl_StackChannel(interp, &ExpSpawnChannelType, + (ClientData) ssPtr, TCL_READABLE|TCL_WRITABLE, chan); + + /* + * Setup the expect channel to always flush immediately + */ + + Tcl_SetChannelOption(interp, chan2, "-buffering", "none"); + Tcl_SetChannelOption(interp, chan2, "-blocking", "0"); + Tcl_SetChannelOption(interp, chan2, "-translation","binary"); + + return chan2; +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnClose -- + * + * Generic routine to close the expect spawn channel and child. + * + * Results: + * 0 if successful or a POSIX errorcode with + * interp updated. + * + * Side Effects: + * Channel is deleted. + * + *---------------------------------------------------------------------- + */ + +static int +ExpSpawnClose(instanceData, interp) + ClientData instanceData; + Tcl_Interp *interp; +{ + ckfree((char *)(ExpSpawnState *)instanceData); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnInput -- + * + * Generic read routine for expect console + * + * Returns: + * Amount read or -1 with errorcode in errorPtr. + * + * Side Effects: + * Buffer is updated. + * + *---------------------------------------------------------------------- + */ + +static int +ExpSpawnInput(instanceData, bufPtr, bufSize, errorPtr) + ClientData instanceData; + char *bufPtr; /* (in) Ptr to buffer */ + int bufSize; /* (in) sizeof buffer */ + int *errorPtr; /* (out) error code */ +{ + Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr; + + return (Tcl_GetChannelType(channelPtr)->inputProc) + (Tcl_GetChannelInstanceData(channelPtr), bufPtr, bufSize, errorPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnOutput -- + * + * Write routine for expect console + * + * Results: + * Amount written or -1 with errorcode in errorPtr + * + * Side Effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpSpawnOutput(instanceData, bufPtr, toWrite, errorPtr) + ClientData instanceData; + CONST char *bufPtr; /* (in) Ptr to buffer */ + int toWrite; /* (in) amount to write */ + int *errorPtr; /* (out) error code */ +{ + return ExpPlatformSpawnOutput(instanceData, bufPtr, toWrite, errorPtr); +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnSetOption -- + * + * Set the value of an ExpSpawn channel option + * + * Results: + * TCL_OK and dsPtr updated with the value or TCL_ERROR. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpSpawnSetOption(instanceData, interp, nameStr, valStr) + ClientData instanceData; + Tcl_Interp *interp; + CONST char *nameStr; /* (in) Name of option */ + CONST char *valStr; /* (in) New value of option */ +{ + Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr; + Tcl_DriverSetOptionProc *setOpt; + + setOpt = Tcl_GetChannelType(channelPtr)->setOptionProc; + + if (setOpt) { + return (setOpt)(Tcl_GetChannelInstanceData(channelPtr), interp, + nameStr, valStr); + } else { + return Tcl_BadChannelOption(interp, nameStr, ""); + } +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnGetOption -- + * + * Queries ExpSpawn channel for the current value of + * the given option. + * + * Results: + * TCL_OK and dsPtr updated with the value or TCL_ERROR. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpSpawnGetOption(instanceData, interp, nameStr, dsPtr) + ClientData instanceData; + Tcl_Interp *interp; + CONST char *nameStr; /* (in) Name of option to retrieve */ + Tcl_DString *dsPtr; /* (in) String to place value */ +{ + Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr; + Tcl_DriverGetOptionProc *getOpt; + + getOpt = Tcl_GetChannelType(channelPtr)->getOptionProc; + if (getOpt) { + return (getOpt)(Tcl_GetChannelInstanceData(channelPtr), interp, + nameStr, dsPtr); + } else if (nameStr != NULL) { + return Tcl_BadChannelOption(interp, nameStr, ""); + } else { + return TCL_OK; + } +} +/* + *---------------------------------------------------------------------- + * + * ExpSpawnWatch -- + * + * Sets up event handling on a expect console Tcl_Channel using + * the underlying channel type. + * + * Results: + * Nothing + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +void +ExpSpawnWatch(instanceData, mask) + ClientData instanceData; + int mask; +{ + Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr; + + (Tcl_GetChannelType(channelPtr)->watchProc) + (Tcl_GetChannelInstanceData(channelPtr), mask); + return; +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnGetHandle -- + * + * Get the Tcl_File for the appropriate direction in from the + * Tcl_Channel. + * + * Results: + * NULL because ExpSpawn ids are handled through other channel + * types. + * + * Side Effects + * None. + * + *---------------------------------------------------------------------- + */ + +int +ExpSpawnGetHandle(instanceData, direction, handlePtr) + ClientData instanceData; + int direction; + ClientData *handlePtr; +{ + Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr; + + return Tcl_GetChannelHandle(channelPtr, direction, handlePtr); +} + +/* + *---------------------------------------------------------------------- + * + * ExpSpawnBlock -- + * + * Generic routine to set I/O to blocking or non-blocking. + * + * Results: + * TCL_OK or TCL_ERROR. + * + * Side Effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ExpSpawnBlock(instanceData, mode) + ClientData instanceData; + int mode; /* (in) Block or not */ +{ + Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr; + + return (Tcl_GetChannelType(channelPtr)->blockModeProc) + (Tcl_GetChannelInstanceData(channelPtr), mode); +} ADDED generic/expStubInit.c Index: generic/expStubInit.c ================================================================== --- /dev/null +++ generic/expStubInit.c @@ -0,0 +1,212 @@ +/* ---------------------------------------------------------------------------- + * expStubInit.c -- + * + * This file contains the initializers for the Expect stub vectors. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: expStubInit.c,v 1.1.4.4 2002/02/10 13:40:47 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" +#include "expPort.h" + +/* + * WARNING: The contents of this file are automatically generated by the + * $(TCLROOT)/tools/genStubs.tcl script. Any modifications to the function declarations + * below should be made in the generic/exp.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +ExpIntStubs expIntStubs = { + TCL_STUB_MAGIC, + NULL, + NULL, /* 0 */ + Exp_StringMatch, /* 1 */ + Exp_StringMatch2, /* 2 */ + NULL, /* 3 */ + exp_new_i_complex, /* 4 */ + exp_new_i_simple, /* 5 */ + exp_new_fs, /* 6 */ + exp_free_i, /* 7 */ + exp_free_fs, /* 8 */ + exp_free_fs_single, /* 9 */ + exp_i_update, /* 10 */ + exp_pty_exit, /* 11 */ + exp_init_spawn_ids, /* 12 */ + exp_init_pty, /* 13 */ + exp_init_tty, /* 14 */ + exp_init_stdio, /* 15 */ + exp_init_sig, /* 16 */ + exp_init_trap, /* 17 */ + exp_init_unit_random, /* 18 */ + exp_init_spawn_id_vars, /* 19 */ + exp_adjust, /* 20 */ + exp_ecmd_remove_f_direct_and_indirect, /* 21 */ + exp_rearm_sigchld, /* 22 */ + exp_chan2f, /* 23 */ + exp_fcheck, /* 24 */ + exp_close, /* 25 */ + exp_strftime, /* 26 */ + exp_create_commands, /* 27 */ + exp_tty_break, /* 28 */ + exp_event_disarm, /* 29 */ + exp_arm_background_filehandler, /* 30 */ + exp_disarm_background_filehandler, /* 31 */ + exp_disarm_background_filehandler_force, /* 32 */ + exp_unblock_background_filehandler, /* 33 */ + exp_block_background_filehandler, /* 34 */ + exp_get_next_event, /* 35 */ + exp_get_next_event_info, /* 36 */ + exp_f_find, /* 37 */ + exp_f_new, /* 38 */ + exp_f_new_platform, /* 39 */ + exp_f_free, /* 40 */ + exp_f_free_platform, /* 41 */ + exp_exact_write, /* 42 */ +}; + +ExpIntPlatStubs expIntPlatStubs = { + TCL_STUB_MAGIC, + NULL, +#ifdef __WIN32__ + ExpWinApplicationType, /* 0 */ + ExpWinCreateProcess, /* 1 */ + ExpWinSyslog, /* 2 */ + ExpSyslogGetSysMsg, /* 3 */ + Exp_WaitPid, /* 4 */ + Exp_KillProcess, /* 5 */ + ExpWinInit, /* 6 */ + BuildCommandLine, /* 7 */ +#endif /* __WIN32__ */ +}; + +ExpPlatStubs expPlatStubs = { + TCL_STUB_MAGIC, + NULL, +}; + +static ExpStubHooks expStubHooks = { + &expPlatStubs, + &expIntStubs, + &expIntPlatStubs +}; + +ExpStubs expStubs = { + TCL_STUB_MAGIC, + &expStubHooks, + Expect_Init, /* 0 */ + NULL, /* 1 */ + NULL, /* 2 */ + Exp_ExpInternalCmd, /* 3 */ + NULL, /* 4 */ + Exp_ExitCmd, /* 5 */ + Exp_ExpContinueCmd, /* 6 */ + NULL, /* 7 */ + Exp_ExpPidCmd, /* 8 */ + Exp_GetpidDeprecatedCmd, /* 9 */ + NULL, /* 10 */ + Exp_LogFileCmd, /* 11 */ + Exp_LogUserCmd, /* 12 */ + Exp_OpenCmd, /* 13 */ + NULL, /* 14 */ + NULL, /* 15 */ + NULL, /* 16 */ + Exp_SendLogCmd, /* 17 */ + Exp_SleepCmd, /* 18 */ + Exp_SpawnCmd, /* 19 */ + Exp_StraceCmd, /* 20 */ + Exp_WaitCmd, /* 21 */ + Exp_ExpVersionCmd, /* 22 */ + Exp_Prompt1Cmd, /* 23 */ + Exp_Prompt2Cmd, /* 24 */ + Exp_TrapCmd, /* 25 */ + Exp_SttyCmd, /* 26 */ + Exp_SystemCmd, /* 27 */ + Exp_ExpectCmd, /* 28 */ + Exp_ExpectGlobalCmd, /* 29 */ + Exp_MatchMaxCmd, /* 30 */ + Exp_RemoveNullsCmd, /* 31 */ + Exp_ParityCmd, /* 32 */ + Exp_TimestampCmd, /* 33 */ + Exp_CloseCmd, /* 34 */ + Exp_InterpreterCmd, /* 35 */ + Exp_SendCmd, /* 36 */ + Exp_KillCmd, /* 37 */ + NULL, /* 38 */ + NULL, /* 39 */ + exp_printify, /* 40 */ + NULL, /* 41 */ + NULL, /* 42 */ + NULL, /* 43 */ + NULL, /* 44 */ + NULL, /* 45 */ + NULL, /* 46 */ + NULL, /* 47 */ + NULL, /* 48 */ + NULL, /* 49 */ + exp_errorlog, /* 50 */ + exp_log, /* 51 */ + exp_debuglog, /* 52 */ + exp_nflog, /* 53 */ + exp_nferrorlog, /* 54 */ + exp_error, /* 55 */ + NULL, /* 56 */ + NULL, /* 57 */ + NULL, /* 58 */ + NULL, /* 59 */ + exp_parse_argv, /* 60 */ + exp_interpreter, /* 61 */ + exp_interpret_cmdfile, /* 62 */ + exp_interpret_cmdfilename, /* 63 */ + exp_interpret_rcfiles, /* 64 */ + exp_cook, /* 65 */ + NULL, /* 66 */ + exp_getpidproc, /* 67 */ + ExpCreateSpawnChannel, /* 68 */ + ExpPlatformSpawnOutput, /* 69 */ + exp_init_main_cmds, /* 70 */ + exp_init_expect_cmds, /* 71 */ + exp_init_most_cmds, /* 72 */ + exp_init_trap_cmds, /* 73 */ + exp_init_interact_cmds, /* 74 */ + exp_init_tty_cmds, /* 75 */ + NULL, /* 76 */ + NULL, /* 77 */ + ExpCreatePairChannel, /* 78 */ + ExpSpawnOpen, /* 79 */ + exp_update_master, /* 80 */ + exp_get_var, /* 81 */ + exp_exit, /* 82 */ + exp_dsleep, /* 83 */ + exp_init_event, /* 84 */ + NULL, /* 85 */ + exp_background_filehandler, /* 86 */ + exp_exit_handlers, /* 87 */ + exp_close_on_exec, /* 88 */ + exp_flageq_code, /* 89 */ + exp_close_tcl_files, /* 90 */ + exp_lowmemcpy, /* 91 */ + exp_timestamp, /* 92 */ +}; + +/* !END!: Do not edit above this line. */ ADDED generic/expStubLib.c Index: generic/expStubLib.c ================================================================== --- /dev/null +++ generic/expStubLib.c @@ -0,0 +1,89 @@ +/* + * expStubLib.c -- + * + * Stub object that will be statically linked into extensions that wish + * to access Expect. + * + * Copyright (c) 2002 by Telindustrie, LLC + * Copyright (c) 1998 Paul Duffin. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: $Id: expStubLib.c,v 1.1.2.1 2002/02/10 08:35:44 davygrvy Exp $ + */ + +/* + * We need to ensure that we use the stub macros so that this file contains + * no references to any of the stub functions. This will make it possible + * to build an extension that references Tcl_InitStubs but doesn't end up + * including the rest of the stub functions. + */ + +#ifndef USE_TCL_STUBS +#define USE_TCL_STUBS +#endif +#undef USE_TCL_STUB_PROCS + +/* + * This ensures that the Exp_InitStubs has a prototype in + * exp.h and is not the macro that turns it into Tcl_PkgRequire + */ + +#ifndef USE_EXP_STUBS +#define USE_EXP_STUBS +#endif + +#include "expInt.h" + +ExpStubs *expStubsPtr; +ExpIntStubs *expIntStubsPtr; +ExpPlatStubs *expPlatStubsPtr; +ExpIntPlatStubs *expIntPlatStubsPtr; + +/* + *---------------------------------------------------------------------- + * + * Exp_InitStubs -- + * + * Tries to initialise the stub table pointers and ensures that + * the correct version of Expect is loaded. + * + * Results: + * The actual version of Expect that satisfies the request, or + * NULL to indicate that an error occurred. + * + * Side effects: + * Sets the stub table pointers. + * + *---------------------------------------------------------------------- + */ + +CONST char * +Exp_InitStubs (interp, version, exact) + Tcl_Interp *interp; + char *version; + int exact; +{ + CONST char *actualVersion; + + actualVersion = Tcl_PkgRequireEx(interp, "Expect", version, exact, + (ClientData *) &expStubsPtr); + + if (actualVersion == NULL) { + expStubsPtr = NULL; + return NULL; + } + + if (expStubsPtr->hooks) { + expIntStubsPtr = expStubsPtr->hooks->expIntStubs; + expPlatStubsPtr = expStubsPtr->hooks->expPlatStubs; + expIntPlatStubsPtr = expStubsPtr->hooks->expIntPlatStubs; + } else { + expIntStubsPtr = NULL; + expPlatStubsPtr = NULL; + expIntPlatStubsPtr = NULL; + } + + return actualVersion; +} ADDED generic/expTrap.c Index: generic/expTrap.c ================================================================== --- /dev/null +++ generic/expTrap.c @@ -0,0 +1,610 @@ +/* ---------------------------------------------------------------------------- + * exp_trap.c -- + * + * Expect's trap command. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" +#include +#if defined(SIGCLD) && !defined(SIGCHLD) +#define SIGCHLD SIGCLD +#endif + +#ifdef TCL_DEBUGGER +#include "Dbg.h" +#endif + +#define NO_SIG 0 + +#define SIGNAL_DEFAULT 0 +#define SIGNAL_IGNORE 1 +#define SIGNAL_ENABLED 2 + +static struct trap { + char *action; /* Tcl command to execute upon sig */ + /* Each is handled by the eval_trap_action */ + int mark; /* TRUE if signal has occurred */ + Tcl_Interp *interp; /* interp to use or 0 if we should use the */ + /* interpreter active at the time the sig */ + /* is processed */ + int code; /* return our new code instead of code */ + /* available when signal is processed */ + CONST char *name; /* name of signal */ + int reserved; /* if unavailable for trapping */ + int enabled; /* set on Win32 if we are trapping signal */ +} traps[NSIG]; + +int sigchld_count = 0; /* # of sigchlds caught but not yet processed */ + +static int eval_trap_action(); + +static int got_sig; /* this records the last signal received */ + /* it is only a hint and can be wiped out */ + /* by multiple signals, but it will always */ + /* be left with a valid signal that is */ + /* pending */ + +static Tcl_AsyncHandler async_handler; + +static CONST char * +signal_to_string(sig) + int sig; +{ + if (sig <= 0 || sig > NSIG) return("SIGNAL OUT OF RANGE"); + return(traps[sig].name); +} + +/* current sig being processed by user sig handler */ +static int current_sig = NO_SIG; + +int exp_nostack_dump = FALSE; /* TRUE if user has requested unrolling of */ + /* stack with no trace */ + + + +/*ARGSUSED*/ +static int +tophalf(ClientData clientData, Tcl_Interp *interp, int code) +{ + 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); + + if (got_sig <= 0 || got_sig >= NSIG) { + exp_errorlog("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 */ + current_sig = got_sig; + trap = &traps[current_sig]; + + trap->mark = FALSE; + +#ifdef SIGCHLD + /* 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); + } +#endif + + 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; + exp_errorlog("caught unexpected signal: %s (%d)\r\n", + signal_to_string(current_sig),current_sig); + abort(); + } + + if (trap->interp) { + /* if trap requested original interp, use it */ + sig_interp = trap->interp; + } else if (!interp) { + /* else if another interp is available, use it */ + sig_interp = interp; + } else { + /* fall back to exp_interp */ + sig_interp = exp_interp; + } + + rc = eval_trap_action(sig_interp,current_sig,trap,code); + current_sig = NO_SIG; + + /* + * scan for more signals to process + */ + + /* first check for additional SIGCHLDs */ + if (sigchld_count) { +#ifdef SIGCHLD + got_sig = SIGCHLD; + traps[SIGCHLD].mark = TRUE; + Tcl_AsyncMark(async_handler); +#endif + } else { + got_sig = -1; + for (i=1;i 0 && sig < NSIG) return sig; + } else { + /* try interpreting as a string */ + for (sig=1;sig 0) goto usage_error; + if (show_max) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(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" */ + Tcl_SetObjResult(interp, + Tcl_NewStringObj(signal_to_string(current_sig) + 3, -1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(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)) { + exp_errorlog("%s\r\n",interp->result); + goto usage_error; + } + + for (i=0;iresult */ + + exp_debuglog("async event handler: Tcl_Eval(%s)\r\n",trap->action); + + /* 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 = (char *) Tcl_DStringAppend(&ei,eip,-1); + } + ecp = Tcl_GetVar(interp,"errorCode",TCL_GLOBAL_ONLY); + if (ecp) { + Tcl_DStringInit(&ec); + ecp = (char *) Tcl_DStringAppend(&ec,ecp,-1); + } + /* I assume interp->result is always non-zero, right? */ + Tcl_DStringInit(&ir); + Tcl_DStringAppend(&ir,interp->result,-1); + } + + newcode = Tcl_GlobalEval(interp,trap->action); + + /* + * 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) { + exp_errorlog("%s\r\n",interp->result); + + /* + * 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))); + } + } 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 (!code_flag) { + /* + * restore values + */ + Tcl_ResetResult(interp); /* turns off Tcl's internal */ + /* flags: ERR_IN_PROGRESS, ERROR_CODE_SET */ + + if (eip) { + Tcl_AddErrorInfo(interp,eip); + Tcl_DStringFree(&ei); + } else { + 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); + } else { + 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)! */ + } + return newcode; +} + +static struct exp_cmd_data +cmd_data[] = { + {"trap", 0, Exp_TrapCmd, NULL, 0}, + {0} +}; + +void +exp_init_trap_cmds(interp) + Tcl_Interp *interp; +{ + exp_create_commands(interp,cmd_data); +} + ADDED generic/exp_closetcl.c Index: generic/exp_closetcl.c ================================================================== --- /dev/null +++ generic/exp_closetcl.c @@ -0,0 +1,44 @@ +/* ---------------------------------------------------------------------------- + * 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. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +void (*exp_close_in_child)() = 0; + +void +exp_close_tcl_files() { + + /* So much for close-on-exec. Tcl doesn't mark its files that way */ + /* everything has to be closed explicitly. */ + +#if 0 + int i; + +/* Not necessary with Tcl 7.5? */ + for (i=3; i for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.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 struct exp_f *ready_fs = NULL; +/* static int ready_fd = EXP_SPAWN_ID_BAD; */ +static int ready_mask; +static int default_mask = TCL_READABLE | TCL_EXCEPTION; + +void (*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *interp)); + + +/* + * Declarations for functions used only in this file. + */ + +static void exp_timehandler _ANSI_ARGS_ ((ClientData clientData)); +static void exp_filehandler _ANSI_ARGS_ ((ClientData clientData, + int mask)); +static void exp_event_exit_real _ANSI_ARGS_ ((Tcl_Interp *interp)); + + +/* + *---------------------------------------------------------------------- + * + * exp_event_disarm -- + * + * Completely remove the filehandler for this process + * + * Results: + * None + * + * Side Effects: + * Events will no longer be reported for this process + * + *---------------------------------------------------------------------- + */ + +void +exp_event_disarm(f) + struct exp_f *f; +{ + Tcl_Channel channel; + + channel = f->Master; + if (! channel) { + channel = f->channel; + } + Tcl_DeleteChannelHandler(channel, f->event_proc, f->event_data); + f->event_proc = NULL; + + /* remember that filehandler has been disabled so that */ + /* it can be turned on for fg expect's as well as bg */ + f->fg_armed = FALSE; +} + +/* + *---------------------------------------------------------------------- + * + * exp_event_disarm_fast -- + * + * Temporarily disable the filehandler for this process. This + * is quicker than calling exp_event_disasrm as it reduces the + * calls to malloc() and free() inside Tcl_...FileHandler. + * + * Results: + * None + * + * Side Effects: + * Events will no longer be reported for this process + * + *---------------------------------------------------------------------- + */ + +static void +exp_event_disarm_fast(f,filehandler) + struct exp_f *f; + Tcl_ChannelProc *filehandler; +{ + Tcl_Channel channel; + + channel = f->Master; + if (! channel) { + channel = f->channel; + } + /* Tk insists on having a valid proc here even though it isn't used */ + if (f->event_proc) { + Tcl_DeleteChannelHandler(channel,f->event_proc,f->event_data); + } + Tcl_CreateChannelHandler(channel,0,filehandler,(ClientData)0); + f->event_proc = filehandler; + f->event_data = 0; + + /* remember that filehandler has been disabled so that */ + /* it can be turned on for fg expect's as well as bg */ + f->fg_armed = FALSE; +} + +/* + *---------------------------------------------------------------------- + * + * exp_arm_background_filehandler_force -- + * + * Always installs a background filehander + * + * Results: + * None + * + * Side Effects: + * Background events will be reported for this process + * + *---------------------------------------------------------------------- + */ + +static void +exp_arm_background_filehandler_force(f) + struct exp_f *f; +{ + Tcl_Channel channel; + + channel = f->Master; + if (! channel) { + channel = f->channel; + } + if (f->event_proc) { + Tcl_DeleteChannelHandler(channel,f->event_proc,f->event_data); + } + Tcl_CreateChannelHandler(channel, TCL_READABLE|TCL_EXCEPTION, + exp_background_filehandler, (ClientData) f); + f->event_proc = exp_background_filehandler; + f->event_data = (ClientData) f; + + f->bg_status = armed; +} + +/* + *---------------------------------------------------------------------- + * + * exp_arm_background_filehandler -- + * + * Installs a background filehandler if it hasn't already been + * installed or if it was disabled. + * + * Results: + * None + * + * Side Effects: + * Background events will be reported for this process + * + *---------------------------------------------------------------------- + */ + +void +exp_arm_background_filehandler(f) + struct exp_f *f; +{ + switch (f->bg_status) { + case unarmed: + exp_arm_background_filehandler_force(f); + break; + case disarm_req_while_blocked: + f->bg_status = blocked; /* forget request */ + break; + case armed: + case blocked: + /* do nothing */ + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_disarm_background_filehandler -- + * + * Removes a background filehandler if it was previously installed + * and armed. + * + * Results: + * None + * + * Side Effects: + * Background events will no longer be reported for this process + * + *---------------------------------------------------------------------- + */ + +void +exp_disarm_background_filehandler(f) + struct exp_f *f; +{ + switch (f->bg_status) { + case blocked: + f->bg_status = disarm_req_while_blocked; + break; + case armed: + f->bg_status = unarmed; + exp_event_disarm(f); + break; + case disarm_req_while_blocked: + case unarmed: + /* do nothing */ + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_disarm_background_filehandler_force -- + * + * Removes a background filehandler if it was previously installed, + * ignoring block status. 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. + * + * Results: + * None + * + * Side Effects: + * Background events will no longer be reported for this process + * + *---------------------------------------------------------------------- + */ + +void +exp_disarm_background_filehandler_force(f) + struct exp_f *f; +{ + switch (f->bg_status) { + case blocked: + case disarm_req_while_blocked: + case armed: + f->bg_status = unarmed; + exp_event_disarm(f); + break; + case unarmed: + /* do nothing */ + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_unblock_background_filehandler -- + * + * Unblocks the background filehandler. + * This can only be called at the end of the bg handler in which + * case we know the status is some kind of "blocked" + * + * Results: + * None + * + * Side Effects: + * + * + *---------------------------------------------------------------------- + */ + +void +exp_unblock_background_filehandler(f) + struct exp_f *f; +{ + switch (f->bg_status) { + case blocked: + exp_arm_background_filehandler_force(f); + break; + case disarm_req_while_blocked: + exp_disarm_background_filehandler_force(f); + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_block_background_filehandler -- + * + * Blocks the background filehandler. + * This can only be called at the end of the bg handler in which + * case we know the status is some kind of "armed" + * + * Results: + * None + * + * Side Effects: + * Temporarily removes the filehandler, so events will stop + * being reported for this process. + * + *---------------------------------------------------------------------- + */ + +void +exp_block_background_filehandler(f) + struct exp_f *f; +{ + f->bg_status = blocked; + exp_event_disarm_fast(f,exp_background_filehandler); +} + + +/* + *---------------------------------------------------------------------- + * + * exp_timehandler -- + * + * Tcl calls this routine when timer we have set has expired. + * + * Results: + * None + * + * Side Effects: + * A flag is set. + * + *---------------------------------------------------------------------- + */ + +static void +exp_timehandler(clientData) + ClientData clientData; +{ + *(int *)clientData = TRUE; +} + +/* + *---------------------------------------------------------------------- + * + * exp_filehandler -- + * + * Tcl calls this routine when some data is available on a + * channel. + * + * Results: + * None + * + * Side Effects: + * Sets the global value of what process is ready. This is + * checked at the return of Tcl_DoOneEvent(). + * + *---------------------------------------------------------------------- + */ + +static void exp_filehandler(clientData,mask) + ClientData clientData; + int mask; +{ + /* + * if input appears, record the fd on which it appeared + */ + ready_fs = (struct exp_f *) clientData; + /* ready_fd = *(int *)clientData; */ + ready_mask = mask; + exp_event_disarm_fast(ready_fs,exp_filehandler); +} + +/* + *---------------------------------------------------------------------- + * + * exp_get_next_event -- + * + * Waits for the next event that expect is registered an + * interest in. + * + * Results: + * Returns status, one of EOF, TIMEOUT, ERROR, DATA or RECONFIGURE + * + * Side Effects: + * Other event handlers outside of Expect may be run as well + * + * Notes: + * This still needs some work to run properly under NT + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +int exp_get_next_event(interp,masters, n,master_out,timeout,key) + Tcl_Interp *interp; + struct exp_f **masters; /* Array of expect process structures */ + int n; /* # of masters */ + struct exp_f **master_out; /* 1st ready master, 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 (;;) { + 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; + + f = masters[rr]; + if (f->key != key) { + f->key = key; + f->force_read = FALSE; + *master_out = f; + return(EXP_DATA_OLD); + } else if ((!f->force_read) && (f->size != 0)) { + *master_out = f; + 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;jfg_armed) { + Tcl_Channel channel; + + channel = f->Master; + if (! channel) { + channel = f->channel; + } + + if (f->event_proc) { + Tcl_DeleteChannelHandler(channel,f->event_proc, + f->event_data); + } + Tcl_CreateChannelHandler(channel, default_mask, + exp_filehandler, (ClientData)f); + f->event_proc = exp_filehandler; + f->event_data = (ClientData) f; + f->fg_armed = TRUE; + } + } + + Tcl_DoOneEvent(0); /* do any event */ + + if (timer_fired) return(EXP_TIMEOUT); + + if (old_configure_count != exp_configure_count) { + if (timer_created) + Tcl_DeleteTimerHandler(timetoken); + return EXP_RECONFIGURE; + } + + if (ready_fs == NULL) continue; + + /* if it was from something we're not looking for at */ + /* the moment, ignore it */ + for (j=0;jfd,TIOCREQCHECK,&ioctl_info) < 0) { + exp_debuglog("ioctl error on TIOCREQCHECK: %s", + Tcl_PosixError(interp)); + return(EXP_TCLERROR); + } + if (ioctl_info.request == TIOCCLOSE) { + return(EXP_EOF); + } + if (ioctl(f->fd, TIOCREQSET, &ioctl_info) < 0) { + exp_debuglog("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 +} + +/* + *---------------------------------------------------------------------- + * + * exp_dsleep -- + * + * Waits for at least a certain amount of time. In general, + * the length of time will be a little bit longer. + * + * Results: + * Returns TCL_OK; + * + * Side Effects: + * Event handlers can fire during this period, so other actions + * are taken. + * + *---------------------------------------------------------------------- + */ + +/*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_fs == NULL) continue; + + exp_event_disarm_fast(ready_fs,exp_filehandler); + ready_fs = NULL; + } +} + +/* + * Tcl used to require commands to be in writeable memory. This + * probably doesn't apply anymore + */ + +static char destroy_cmd[] = "destroy ."; + +/* + *---------------------------------------------------------------------- + * + * exp_event_exit_real -- + * + * Function to call to destroy the main window, causing + * the program to exit. + * + * Results: + * None + * + * Side Effects: + * Program exits. + * + *---------------------------------------------------------------------- + */ + +static void +exp_event_exit_real(interp) + Tcl_Interp *interp; +{ + Tcl_Eval(interp,destroy_cmd); +} + +/* + *---------------------------------------------------------------------- + * + * exp_init_event -- + * + * Set things up for later calls to the event handler + * + * Results: + * None + * + * Side Effects: + * None + * + *---------------------------------------------------------------------- + */ + +void +exp_init_event() +{ + exp_event_exit = exp_event_exit_real; +} ADDED generic/exp_glob.c Index: generic/exp_glob.c ================================================================== --- /dev/null +++ generic/exp_glob.c @@ -0,0 +1,273 @@ +/* ---------------------------------------------------------------------------- + * 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. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include +#include "expInt.h" + +/* + *---------------------------------------------------------------------- + * + * Exp_StringMatch -- + * + * 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. + * + * Results: + * Number of characters that matched + * + * Side Effects: + * None + * + *---------------------------------------------------------------------- + */ + +int +Exp_StringMatch(string, pattern,offset) + CONST char *string; + CONST char *pattern; + int *offset; /* offset from beginning of string where + * pattern matches */ +{ + CONST 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; +} + +/* + *---------------------------------------------------------------------- + * + * 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) + * + * Results: + * Number of characters that matched + * + * Side Effects: + * None + * + *---------------------------------------------------------------------- + */ + +int +Exp_StringMatch2(string,pattern) + CONST register char *string; /* String. */ + CONST 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 == '*') { +#if 1 + int head_len; + CONST 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) { + 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 + 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; + } + +/* 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; + } + + /* 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++; + } +} + ADDED generic/exp_inter.c Index: generic/exp_inter.c ================================================================== --- /dev/null +++ generic/exp_inter.c @@ -0,0 +1,2262 @@ +/* ---------------------------------------------------------------------------- + * exp_inter.c -- + * + * interact (using select) - give user keyboard control. + * + * Notes: + * Has no working implimentation (yet) on windows. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +#ifndef __WIN32__ + +extern char *TclGetRegError(); +extern void TclRegError(); + +#define INTER_OUT "interact_out" + +/* + * tests if we are running this using a real tty + * + * these tests are currently only used to control what gets written to the + * logfile. Note that removal of the test of "..._is_tty" means that stdin + * or stdout could be redirected and yet stdout would still be logged. + * However, it's not clear why anyone would use log_file when these are + * redirected in the first place. On the other hand, it is reasonable to + * run expect as a daemon in which case, stdin/out do not appear to be + * ttys, yet it makes sense for them to be logged with log_file as if they + * were. + */ +#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) (((x)==0) || ((x)==exp_dev_tty)) + +#define new(x) (x *)ckalloc(sizeof(x)) + +struct action { + char *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; + 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 */ + struct action action; + struct keymap *next; +}; + +struct output { + struct exp_i *i_list; + struct action *action_eof; + struct output *next; +}; + +struct input { + struct exp_i *i_list; + struct output *output; + struct action *action_eof; + struct action *action_timeout; + struct keymap *keymap; + int timeout_nominal; /* timeout nominal */ + int timeout_remaining; /* timeout remaining */ + struct input *next; +}; + +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, +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 +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. + +The basic idea of how this works is it does a smart sequential search. +At each position of the input string, we attempt to match each of the +keymaps. If at least one matches, the first match is returned. + +If there is a CANMATCH and there are more keymaps to try, we continue +trying. If there are no more keymaps to try, we stop trying and +return with an indication of the first keymap that can match. + +Note that I've hacked up the regexp pattern matcher in two ways. One +is to force the pattern to always be anchored at the front. That way, +it doesn't waste time attempting to match later in the string (before +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_searchnext) { + char *s; /* current character being examined */ + + if (km->null) { + if (*start_search == 0) { + *skip = start_search-string; + *match_length = 1; /* s - start_search == 1 */ + *km_match = km; + return(EXP_MATCH); + } + } else if (!km->re) { + /* 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 ((*s & 0x7f) == *ks) continue; + if ((*s == '\0') && rm_nulls) { + ks--; + 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 ((*start_search & 0x7f) != 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) { + 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);*/ +#endif + return(EXP_CANMATCH); + } + + *skip = start_search-string; + return(EXP_CANTMATCH); +} + +#ifdef SIMPLE_EVENT + +/* + +The way that the "simple" interact works is that the original Expect +process reads from the tty and writes to the spawned process. A child +process is forked to read from the spawned process and write to the +tty. It looks like this: + + user + --> tty >-- + / \ + ^ v + child original + process Expect + ^ process + | v + \ / + < spawned < + process + +*/ + + + +#ifndef WEXITSTATUS +#define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff) +#endif + +#include + +static jmp_buf env; /* for interruptable read() */ +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; +} + +#define EXP_CHILD_EOF -100 + +/* interruptable read */ +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); +} + +/* 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; +} +#endif /*SIMPLE_EVENT*/ + +static int +update_interact_fds(interp,fd_count,fd_to_input,fd_list,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; +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; + int count; + + int real_tty = FALSE; + + *config_count = exp_configure_count; + + count = 0; + for (inp = input_base;inp;inp=inp->next) { + + if (do_indirect) { + /* do not update "direct" entries (again) */ + /* they were updated upon creation */ + if (inp->i_list->direct == EXP_INDIRECT) { + exp_i_update(interp,inp->i_list); + } + for (outp = inp->output;outp;outp=outp->next) { + if (outp->i_list->direct == EXP_INDIRECT) { + exp_i_update(interp,outp->i_list); + } + } + } + + /* 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); + } + + /* revalidate all output descriptors */ + for (outp = inp->output;outp;outp=outp->next) { + for (fdp = outp->i_list->fd_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 (!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)); + } 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)); + } + + 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; + + *real_tty_caller = real_tty; /* tell caller if we have found that */ + /* we are using real tty */ + + return TCL_OK; +} + +/*ARGSUSED*/ +static char * +inter_updateproc(clientData, interp, name1, name2, flags) +ClientData clientData; +Tcl_Interp *interp; /* Interpreter containing variable. */ +char *name1; /* Name of variable. */ +char *name2; /* Second part of variable name. */ +int flags; /* Information about what happened. */ +{ + exp_configure_count++; + return 0; +} + +#define finish(x) { status = x; goto done; } + +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 */ + char *argv0; + + 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)); + } + + argv0 = argv[0]; + 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, + argv0); + if (inp->i_list == NULL) { + return(TCL_ERROR); + } + 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,argv0); + if (outp->i_list == NULL) { + return TCL_ERROR; + } + + 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++; + exp_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; + exp_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)) { + exp_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; + exp_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,argv0); + if (o->i_list == NULL) { + return(TCL_ERROR); + } + } +#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,argv0); + if (input_user->i_list == NULL) { + return(TCL_ERROR); + } + input_default->output->i_list = exp_new_i_complex(interp, + replace_user_by_process, + EXP_TEMPORARY,inter_updateproc,argv0); + } + + /* + * 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,argv0); + if (input_default->i_list == NULL) { + return(TCL_ERROR); + } + } +#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++) { + struct exp_fd_list *fdp; + + for (fdp = inp->i_list->fd_list;fdp;fdp=fdp->next) { + /* 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 */ + + exp_debuglog("WARNING: interact buffer is full, probably because your\r\n"); + exp_debuglog("patterns have matched all of it but require more chars\r\n"); + exp_debuglog("in order to complete the match.\r\n"); + exp_debuglog("Dumping first half of buffer in order to continue\r\n"); + exp_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) { + exp_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; + exp_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) exp_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) { + exp_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); + } + } + } + +#else /* SIMPLE_EVENT */ +/* deferred_interrupt = FALSE;*/ +{ + 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 */ + 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 */ + + 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); + + m = fd_list[1]; /* get 2nd fd */ + input_count = 1; + + while (1) { + + /* 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) */ + } + + /* +1 so we can look at the "other" file descriptor */ + rc = exp_get_next_event(interp,fd_list+1,input_count,&m,timeout,key); + 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; + + 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) { + exp_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. */ + case EXP_EOF: + action = inp->action_eof; + attempt_match = FALSE; + skip = u->size; + rc = EXP_EOF; + exp_debuglog("interact: child received eof from spawn_id %d\r\n",m); + exp_close(interp,m); + 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); + } else { + attempt_match = TRUE; + } + + /* put regexp result in variables */ + if (km && km->re) { +#define INTER_OUT "interact_out" +#define out(i,val) exp_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; + } + } + + /* 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; + } 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; + } + + 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) { + exp_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; + } + + /* 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); + } + } + + /* as long as buffer is still around, null terminate it */ + if (rc != EXP_EOF) { + u->buffer[u->size] = '\0'; + u->lower [u->size] = '\0'; + } + /* 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 (action) { + 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); + } + } + } + } else { /* parent - send user keystrokes to process */ +#include + +#if defined(SIGCLD) && !defined(SIGCHLD) +#define SIGCHLD SIGCLD +#endif + exp_debuglog("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 */ + input_count = 1; + + while (1) { + /* 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) */ + } + + rc = exp_get_next_event(interp,fd_list,input_count,&m,timeout,key); + 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; + + 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) { + exp_debuglog("spawn id %d sent <%s>\r\n",m, + exp_printify(u->buffer + u->size - cc)); + } + 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; + rc = EXP_EOF; + exp_debuglog("interact: process died/eof\r\n"); + clean_up_after_child(interp,fd_list[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. */ + case EXP_EOF: + action = inp->action_eof; + attempt_match = FALSE; + skip = u->size; + rc = EXP_EOF; + exp_debuglog("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); + } 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; + } + } + + /* 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; + } 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; + } + + 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) { + exp_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; + } + + /* 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); + } + } + + /* as long as buffer is still around, null terminate it */ + if (rc != EXP_EOF) { + u->buffer[u->size] = '\0'; + u->lower [u->size] = '\0'; + } + /* 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 (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); + } + } + } + } +} +#endif /* SIMPLE_EVENT */ + + done: +#ifdef SIMPLE_EVENT + /* 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); +} + +/* version of Tcl_Eval for interact */ +static int +inter_eval(interp,action,spawn_id) +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; +} + +static void +free_keymap(km) +struct keymap *km; +{ + if (km == 0) return; + free_keymap(km->next); + + ckfree((char *)km); +} + +static void +free_action(a) +struct action *a; +{ + struct action *next; + + while (a) { + next = a->next; + ckfree((char *)a); + a = next; + } +} + +static void +free_input(interp,i) +Tcl_Interp *interp; +struct input *i; +{ + if (i == 0) return; + free_input(interp,i->next); + + exp_free_i(interp,i->i_list,inter_updateproc); + free_output(interp,i->output); + free_keymap(i->keymap); + ckfree((char *)i); +} + +static struct action * +new_action(base) +struct action **base; +{ + struct action *o = new(struct action); + + /* stick new action into beginning of list of all actions */ + o->next = *base; + *base = o; + + return o; +} + +static void +free_output(interp,o) +Tcl_Interp *interp; +struct output *o; +{ + if (o == 0) return; + free_output(interp,o->next); + exp_free_i(interp,o->i_list,inter_updateproc); + + ckfree((char *)o); +} +#endif /* __WIN32__ */ + +static struct exp_cmd_data cmd_data[] = { +#ifndef __WIN32__ +{"interact", 0, Exp_InteractCmd, 0, 0}, +#endif +{0}}; + +void +exp_init_interact_cmds(interp) +Tcl_Interp *interp; +{ + exp_create_commands(interp,cmd_data); +} ADDED generic/exp_log.c Index: generic/exp_log.c ================================================================== --- /dev/null +++ generic/exp_log.c @@ -0,0 +1,423 @@ +/* ---------------------------------------------------------------------------- + * exp_log.c -- + * + * logging routines and other things common to both Expect + * program and library. Note that this file must NOT have any + * references to Tcl except for including tclInt.h + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +#ifdef _MSC_VER +# define vsnprintf _vsnprintf +#endif + +int exp_loguser = TRUE; /* if TRUE, expect/spawn may write to stdout */ +int exp_logfile_all = FALSE; /* if TRUE, write log of all interactions */ + /* despite value of loguser. */ +Tcl_Channel exp_logfile = NULL; +Tcl_Channel exp_debugfile = NULL; + +int exp_is_debugging = FALSE; + +/* Following this are several functions that log the conversation. */ +/* 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. */ + +/* + *---------------------------------------------------------------------- + * + * exp_log -- + * + * Send to the logfile if it is open. + * Send to stderr if debugging is enabled. + * use this for logging everything but the parent/child conversation + * (this turns out to be almost nothing) + * + * Results: + * None + * + * Side Effects: + * Messages may be written to a logfile + * + * Notes: + * Static buffer is used, so overflow can be in issue + * + *---------------------------------------------------------------------- + */ + +#define LOGUSER (exp_loguser || force_stdout) + +/*VARARGS*/ +void +exp_log TCL_VARARGS_DEF(int,arg1) +{ + int force_stdout; + char buf[4096]; + char *p = buf; + int len = sizeof(buf); + int n; + char *fmt; + Tcl_Channel chan; + va_list args; + + force_stdout = TCL_VARARGS_START(int,arg1,args); + fmt = va_arg(args,char *); + + n = -1; + while (n == -1) { + n = vsnprintf(p, len, fmt, args); + if (n == -1) { + if (p != buf) { + free(p); + } + len *= 2; + p = malloc(len); + } + } + + if (exp_debugfile) Tcl_Write(exp_debugfile, buf, n); + if (exp_logfile_all || (LOGUSER && exp_logfile)) Tcl_Write(exp_logfile, buf, n); + if (LOGUSER) { + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan) { + Tcl_Write(chan, buf, n); + } + } + if (p != buf) { + free(p); + } + va_end(args); +} + +/* + *---------------------------------------------------------------------- + * + * exp_nflog -- + * + * Send to the logfile if it is open. Just like exp_log, but + * it does no formatting. Use this function for logging the + * parent/child conversation + * + * Results: + * None + * + * Side Effects: + * Messages may be written to a logfile + * + *---------------------------------------------------------------------- + */ + +void +exp_nflog(buf,force_stdout) + char *buf; + int force_stdout; /* override value of loguser */ +{ + int len = strlen(buf); + Tcl_Channel chan; + + if (exp_debugfile) Tcl_Write(exp_debugfile, buf, len); + if (exp_logfile_all || (LOGUSER && exp_logfile)) Tcl_Write(exp_logfile, buf, len); + if (LOGUSER) { + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan) { + Tcl_Write(chan, buf, len); + } + } +} +#undef LOGUSER + +/* + *---------------------------------------------------------------------- + * + * exp_debuglog -- + * + * Send to log if open and debugging enabled. + * send to stderr if debugging enabled. + * Use this function for recording unusual things in the log. + * + * Results: + * None + * + * Side Effects: + * Messages may be written to a logfile + * + * Notes: + * Static buffer is used, so overflow can be in issue + * + *---------------------------------------------------------------------- + */ + +/*VARARGS*/ +void +exp_debuglog TCL_VARARGS_DEF(char *,arg1) +{ + char *fmt; + char buf[4096]; + char *p = buf; + int len = sizeof(buf); + int n; + Tcl_Channel chan; + va_list args; + + fmt = TCL_VARARGS_START(char *,arg1,args); + + n = -1; + while (n == -1) { + n = vsnprintf(p, len, fmt, args); + if (n == -1) { + if (p != buf) { + ckfree(p); + } + len *= 2; + p = ckalloc(len); + } + } + + if (exp_debugfile) Tcl_Write(exp_debugfile, buf, n); + if (exp_is_debugging) { + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_Write(chan, buf, n); + } + if (exp_logfile) Tcl_Write(exp_logfile, buf, n); + } + + if (p != buf) ckfree(p); + va_end(args); +} + +/* + *---------------------------------------------------------------------- + * + * exp_errorlog -- + * + * Log to stderr and to a logfile if it is open. Also send to + * debuglog if debugging is enabled. This function is used for + * logging error conditions. + * + * Results: + * None + * + * Notes: + * Static buffer is used, so overflow can be in issue + * + *---------------------------------------------------------------------- + */ + +/*VARARGS*/ +void +exp_errorlog TCL_VARARGS_DEF(char *,arg1) +{ + char *fmt; + char buf[4096]; + char *p = buf; + int len = sizeof(buf); + int n; + Tcl_Channel chan; + va_list args; + + fmt = TCL_VARARGS_START(char *,arg1,args); + + n = -1; + while (n == -1) { + n = vsnprintf(p, len, fmt, args); + if (n == -1) { + if (p != buf) { + free(p); + } + len *= 2; + p = malloc(len); + } + } + + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_Write(chan, buf, n); + } + if (exp_debugfile) Tcl_Write(exp_debugfile, buf, n); + if (exp_logfile) Tcl_Write(exp_logfile, buf, n); + if (p != buf) free(p); + va_end(args); +} + +/* + *---------------------------------------------------------------------- + * + * exp_nferrorlog -- + * + * Log to stderr and to a logfile if it is open. Also send to + * debuglog if debugging is enabled. This function is used for + * logging the parent/child conversation. It is just like + * exp_errorlog, but it does no formattting. + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +void +exp_nferrorlog(buf,force_stdout) + char *buf; + int force_stdout; /* not used, only declared here for compat with */ +{ + int len = strlen(buf); + Tcl_Channel chan; + + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_Write(chan, buf, len); + } + if (exp_debugfile) Tcl_Write(exp_debugfile, buf, len); + if (exp_logfile) Tcl_Write(exp_logfile, buf, len); +} + +#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 */ + + +void +exp_init_log() +{ + out_buffer = ckalloc(BUFSIZ); + out_buffer_size = BUFSIZ; + outp_last = out_buffer + BUFSIZ - 1; +} + +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 ADDED generic/exp_main_exp.c Index: generic/exp_main_exp.c ================================================================== --- /dev/null +++ generic/exp_main_exp.c @@ -0,0 +1,54 @@ +/* main.c - main() and some logging routines 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. +*/ + +#define BUILD_clib + +#include "exp_port.h" +#include +#include +#include "tcl.h" + + +#include "expect_tcl.h" + +int +main(argc, argv) +int argc; +char *argv[]; +{ + int rc = 0; + Tcl_Interp *interp = Tcl_CreateInterp(); + + if (Tcl_Init(interp) == TCL_ERROR) { + fprintf(stderr,"Tcl_Init failed: %s\n",interp->result); + exit(1); + } + + if (Expect_Init(interp) == TCL_ERROR) { + fprintf(stderr,"Expect_Init failed: %s\n",interp->result); + exit(1); + } + + exp_parse_argv(interp,argc,argv); + + /* become interactive if requested or "nothing to do" */ + if (exp_interactive) + (void) exp_interpreter(interp); + 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); + /*NOTREACHED*/ + return 0; /* Needed only to prevent compiler warning. */ +} + ADDED generic/exp_main_sub.c Index: generic/exp_main_sub.c ================================================================== --- /dev/null +++ generic/exp_main_sub.c @@ -0,0 +1,993 @@ +/* ---------------------------------------------------------------------------- + * exp_main_sub.c -- + * + * miscellaneous subroutines for Expect or Tk main() + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp_main_sub.c,v 1.1.2.1.2.7 2002/02/11 02:19:53 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +#ifdef TCL_DEBUGGER +#include "Dbg.h" +#endif + +#ifdef __CENTERLINE__ +#undef EXP_VERSION +#define EXP_VERSION "5.0.3" /* I give up! */ + /* It is not necessary that number */ + /* be accurate. It is just here to */ + /* pacify Centerline which doesn't */ + /* seem to be able to get it from */ + /* the Makefile. */ +#undef SCRIPTDIR +#define SCRIPTDIR "example/" +#undef EXECSCRIPTDIR +#define EXECSCRIPTDIR "example/" +#endif +char exp_version[] = EXP_VERSION; +#define NEED_TCL_MAJOR 7 +#define NEED_TCL_MINOR 5 + +#define TCL_DOES_STUBS \ + (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ + (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))) + +char *exp_argv0 = "this program"; /* default program name */ +void (*exp_app_exit)() = 0; + +FILE *exp_cmdfile = 0; +char *exp_cmdfilename = 0; +int exp_cmdlinecmds = FALSE; +int exp_interactive = FALSE; +int exp_buffer_command_input = FALSE;/* read in entire cmdfile at once */ +//int exp_fgets(); + +Tcl_Interp *exp_interp; /* for use by signal handlers who can't figure out */ + /* the interpreter directly */ +int exp_tcl_debugger_available = FALSE; +int exp_getpid; + +TCL_DECLARE_MUTEX(initLock) + + +/* + * Declarations for local procedures defined in this file: + */ + +static void exp_pty_exit_for_tcl _ANSI_ARGS_(( + ClientData clientData)); + + +static void +usage(interp) + Tcl_Interp *interp; +{ + exp_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); +} + +/* this clumsiness because pty routines don't know Tcl definitions */ +static +void +exp_pty_exit_for_tcl(clientData) + ClientData clientData; +{ + exp_pty_exit(); +} + +static +void +exp_init_pty_exit() +{ + 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) + ClientData clientData; +{ + extern int exp_forked; + + Tcl_Interp *interp = (Tcl_Interp *)clientData; + + /* use following checks to prevent recursion in exit handlers */ + /* if this code ever supports multiple interps, these should */ + /* 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 { + exp_debuglog("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 { + exp_debuglog("application exit handler called recursively - forcing exit\r\n"); + } + } + +#ifndef __WIN32__ + if (!exp_disconnected + && !exp_forked + && (exp_dev_tty != -1) + && isatty(exp_dev_tty) + && exp_ioctled_devtty) { + exp_tty_set(interp,&exp_tty_original,exp_dev_tty,0); + } +#endif +#if 0 /* GCC: I don't think this is necessary anymore */ + /* all other files either don't need to be flushed or will be + implicitly closed at exit. Spawned processes are free to continue + running, however most will shutdown after seeing EOF on stdin. + Some systems also deliver SIGHUP and other sigs to idle processes + which will blow them away if not prepared. + */ + + exp_close_all(interp); +#endif +} + +/* this stupidity because Tcl needs commands in writable space */ +static char prompt1[] = "prompt1"; +static char prompt2[] = "prompt2"; + +static char *prompt2_default = "+> "; +static char prompt1_default[] = "expect%d> "; + +/*ARGSUSED*/ +int +Exp_Prompt1Cmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + Interp *iPtr = (Interp *)interp; + + sprintf(interp->result,prompt1_default, iPtr->numLevels); + return(TCL_OK); +} + +/*ARGSUSED*/ +int +Exp_Prompt2Cmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + strcpy(interp->result,prompt2_default); + return(TCL_OK); +} + +/*ARGSUSED*/ +static int +ignore_procs(interp,s) + Tcl_Interp *interp; + char *s; /* function name */ +{ + return ((s[0] == 'p') && + (s[1] == 'r') && + (s[2] == 'o') && + (s[3] == 'm') && + (s[4] == 'p') && + (s[5] == 't') && + ((s[6] == '1') || + (s[6] == '2')) && + (s[7] == '\0') + ); +} + +/* handle an error from Tcl_Eval or Tcl_EvalFile */ +static void +handle_eval_error(interp,check_for_nostack) + Tcl_Interp *interp; + int check_for_nostack; +{ + CONST char *msg; + + /* if errorInfo has something, print it */ + /* else use what's in interp->result */ + + msg = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY); + if (!msg) msg = interp->result; + else if (check_for_nostack) { + /* suppress errorInfo if generated via */ + /* error ... -nostack */ + if (0 == strncmp("-nostack",msg,8)) return; + + /* + * This shouldn't be necessary, but previous test fails + * because of recent change John made - see eval_trap_action() + * in exp_trap.c for more info + */ + if (exp_nostack_dump) { + exp_nostack_dump = FALSE; + return; + } + } + + /* 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 */ + exp_errorlog("%s\r\n", exp_cook(msg,(int *)0)); +} + +/* user has pressed escape char from interact or somehow requested expect. +If a user-supplied command returns: + +TCL_ERROR, assume user is experimenting and reprompt +TCL_OK, ditto +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; +{ +#ifdef __WIN32__ + fprintf(stderr, "expect.exe does not run in interactive mode. Use tclsh80.exe instead\n"); + exit(1); + return 0; +#else + 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; + +#ifndef __WIN32__ + exp_tty tty_old; +#endif + int was_raw, was_echo; + + int dummy; + int fd = fileno(stdin); + + expect_key++; + + Tcl_DStringInit(&dstring); + + newcmd = TRUE; + while (TRUE) { + /* force terminal state */ +#ifndef __WIN32__ + tty_changed = exp_tty_cooked_echo(interp,&tty_old,&was_raw,&was_echo); +#endif + + 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); + } else { + rc = Tcl_Eval(interp,prompt2); + if (rc == TCL_OK) exp_log(1,"%s",interp->result); + else exp_log(1,prompt2_default,1); + } + +#ifdef SHARE_CMD_BUFFER + if (exp_fgets(interp,line,BUFSIZ) == EXP_EOF) { + if (!newcmd) line[0] = 0; + else exp_exit(interp,0); + } +#else + 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'; + } + +#ifdef BEFORE_ASYNC + if (rc != EXP_EOF) { + if (0 >= (rc = read(0,line,BUFSIZ))) { + if (!newcmd) line[0] = 0; + else rc = EXP_EOF; + } else line[rc] = '\0'; + } +#endif + + 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 */ +#endif /*SHARE_CMD_BUFFER*/ + + 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); + + /* Ousterhout says he fixed this, so that we no longer need + the ifdefs */ + rc = Tcl_RecordAndEval(interp,ccmd,0); +#if 0 +#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4 + rc = Tcl_RecordAndEval(interp,ccmd,0); +#else + rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL); + rc = Tcl_Eval(interp,ccmd); +#endif +#endif + 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 */ + exp_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); +#endif /* ifdef __WIN32__ */ +} + +/*ARGSUSED*/ +int +Exp_ExpVersionCmd(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + int emajor, umajor; + char *user_version; /* user-supplied version string */ + + if (argc == 1) { + Tcl_SetResult(interp,exp_version,TCL_STATIC); + return(TCL_OK); + } + if (argc > 3) { + exp_error(interp,"usage: exp_version [[-exit] version]"); + return(TCL_ERROR); + } + + user_version = argv[argc==2?1:2]; + emajor = atoi(exp_version); + umajor = atoi(user_version); + + /* first check major numbers */ + if (emajor == umajor) { + int u, e; + + /* now check minor numbers */ + char *dot = strchr(user_version,'.'); + if (!dot) { + exp_error(interp,"version number must include a minor version number"); + return TCL_ERROR; + } + + u = atoi(dot+1); + dot = strchr(exp_version,'.'); + e = atoi(dot+1); + if (e >= u) return(TCL_OK); + } + + if (argc == 2) { + exp_error(interp,"%s requires Expect version %s (but using %s)", + exp_argv0,user_version,exp_version); + return(TCL_ERROR); + } + exp_errorlog("%s: requires Expect version %s (but using %s)\r\n", + exp_argv0,user_version,exp_version); + exp_exit(interp,1); + + /*NOTREACHED*/ + return TCL_OK; +} + +/* + * The following string is the startup script executed in new + * interpreters. It looks on disk in several different directories + * for a script "dpinit.tcl" that is compatible with this version of Dp. + * The dpinit.tcl script does all of the real work of initialization. + */ + +static char initScript[] = +"proc expectInit {} {\n\ + global exp_library auto_path env\n\ + rename expectInit {}\n\ + set version [exp_version]\n\ + set dirs [list [file join .. examples] [file join . examples]]\n\ + if [info exists env(EXP_LIBRARY)] {\n\ + lappend dirs $env(EXP_LIBRARY)\n\ + }\n\ + set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\ + lappend dirs [file join [file join $parentDir lib] exp$version]\n\ + set lib exp$version\n\ + lappend dirs [file join [file join [file dirname $parentDir] $lib] library]\n\ + lappend dirs [file join $parentDir library]\n\ + set parentDir [file dirname [pwd]]\n\ + lappend dirs [file join $parentDir library]\n\ + foreach i $dirs {\n\ + set exp_library $i\n\ + if [file isfile [file join $i expect.rc]] {\n\ + lappend auto_path $exp_library\n\ + return\n\ + }\n\ + }\n\ + foreach i $dirs {\n\ + set exp_library $i\n\ + if [file isfile [file join $i beer.exp]] {\n\ + lappend auto_path $exp_library\n\ + return\n\ + }\n\ + }\n\ +}\n\ +expectInit"; + + +static char init_auto_path[] = "lappend auto_path $exp_library $exp_exec_library"; + +int +Expect_Init(interp) + Tcl_Interp *interp; +{ + static int first_time = TRUE; + +#ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } +#else + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { + return TCL_ERROR; + } +#endif + + Tcl_MutexLock(&initLock); + + 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; + } + +#ifdef __WIN32__ + { + extern void ExpWinInit (); + ExpWinInit(); + } +#endif + + exp_getpid = getpid(); + exp_init_spawn_ids(interp); + exp_init_pty(interp); + exp_init_pty_exit(); + exp_init_tty(interp); /* 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(); + + Tcl_CreateExitHandler(exp_exit_handlers,(ClientData)interp); + + first_time = FALSE; + } + + /* save last known interp for emergencies */ + exp_interp = interp; + + Tcl_MutexUnlock(&initLock); + + /* 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); + + if (Tcl_Eval(interp, initScript) != TCL_OK) { + return TCL_ERROR; + } + +#ifdef TCL_DEBUGGER + Dbg_IgnoreFuncs(interp,ignore_procs); +#endif + +#if TCL_DOES_STUBS + { + extern ExpStubs expStubs; + if (Tcl_PkgProvideEx(interp, "Expect", EXP_VERSION, + (ClientData)&expStubs) != TCL_OK) { + return TCL_ERROR; + } + } +#else + if (Tcl_PkgProvide(interp, "Expect", EXP_VERSION) != TCL_OK) { + return TCL_ERROR; + } +#endif + + return TCL_OK; +} + +static char sigexit_init_default[] = "trap exit {SIGINT SIGTERM}"; +static char debug_init_default[] = "trap {exp_debug 1} SIGINT"; + +void +exp_parse_argv(interp,argc,argv) + Tcl_Interp *interp; + int argc; + char **argv; +{ + char argc_rep[10]; /* enough space for storing literal rep of argc */ + + int sys_rc = TRUE; /* read system rc file */ + int my_rc = TRUE; /* read personal rc file */ + + int c; + int rc; + + extern int optind; + extern char *optarg; + char *args; /* ptr to string-rep of all args */ +#ifdef __WIN32__ + extern int getopt _ANSI_ARGS_((int argc,char **nargv, char *ostr)); +#endif + + exp_argv0 = argv[0]; + +#ifdef TCL_DEBUGGER + Dbg_ArgcArgv(argc,argv,1); +#endif + + /* initially, we must assume we are not interactive */ + /* this prevents interactive weirdness courtesy of unknown via -c */ + /* 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) { + 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 */ + /* in order to allow things like -n- on #! line */ + goto abort_getopt; + case 'c': /* command */ + exp_cmdlinecmds = TRUE; + rc = Tcl_Eval(interp,optarg); + if (rc != TCL_OK) { + exp_errorlog("%s\r\n",exp_cook(Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY),(int *)0)); + } + break; + case 'd': + exp_is_debugging = TRUE; + exp_debuglog("expect version %s\r\n",exp_version); + break; +#ifdef TCL_DEBUGGER + case 'D': { + char *debug_init; + exp_tcl_debugger_available = TRUE; + if (Tcl_GetInt(interp,optarg,&rc) != TCL_OK) { + exp_errorlog("%s: -D argument must be 0 or 1\r\n", + exp_argv0); + exp_exit(interp,1); + } + + /* 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"))) { + debug_init = debug_init_default; + } + Tcl_Eval(interp,debug_init); + if (rc == 1) Dbg_On(interp,0); + break; + } +#endif + case 'f': /* name of cmd file */ + exp_cmdfilename = optarg; + break; + case 'b': /* read cmdfile one part at a time */ + exp_cmdfilename = optarg; + exp_buffer_command_input = TRUE; + break; + case 'i': /* interactive */ + exp_interactive = TRUE; + break; + case 'n': /* don't read personal rc file */ + my_rc = FALSE; + break; + 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); + break; + default: usage(interp); + } + } + +abort_getopt: + + for (c = 0;cresult != 0) + exp_errorlog("%s\r\n",interp->result); + exp_exit(interp,1); + } + close(fd); + } + } + if (my_rc) { + char file[200]; + char *home; + int fd; + char *getenv(); + + 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))) { + exp_errorlog("error executing file: %s\r\n",file); + if (rc != TCL_ERROR) + exp_errorlog("Tcl_Eval = %d\r\n",rc); + if (*interp->result != 0) + exp_errorlog("%s\r\n",interp->result); + exp_exit(interp,1); + } + close(fd); + } + } + } +} + +int +exp_interpret_cmdfilename(interp,filename) + Tcl_Interp *interp; + char *filename; +{ + int rc; + + exp_debuglog("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 */ + Tcl_AddErrorInfo(interp, ""); + handle_eval_error(interp,0); + } + return rc; +} + +int +exp_interpret_cmdfile(interp,cmdfile) + Tcl_Interp *interp; + Tcl_Channel cmdfile; +{ + int rc = 0; + int newcmd; + int eof; + + Tcl_DString dstring; + Tcl_DStringInit(&dstring); + + exp_debuglog("executing commands from command file\r\n"); + + newcmd = TRUE; + eof = FALSE; + while (1) { + Tcl_Obj *line = Tcl_NewObj(); /* buffer for partial Tcl command */ + + Tcl_GetsObj(cmdfile, line); + + if (Tcl_GetsObj(cmdfile, line) == -1) { + if (newcmd) break; + eof = TRUE; + } + if (!Tcl_CommandComplete(Tcl_GetString(line)) && !eof) { + newcmd = FALSE; + continue; /* continue collecting command */ + } + newcmd = TRUE; + + rc = Tcl_EvalObj(interp,line); + Tcl_DecrRefCount(line); + if (rc != TCL_OK) { + handle_eval_error(interp,0); + break; + } + if (eof) break; + } + 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 (exp_logfile_all || (exp_loguser && exp_logfile)) { + fwrite(f->buffer,1,write_count,exp_logfile); + } + if (exp_debugfile) fwrite(f->buffer,1,write_count,exp_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[] = { + {"exp_version", 0, Exp_ExpVersionCmd, 0, 0}, + {"prompt1", 0, Exp_Prompt1Cmd, 0, 0}, + {"prompt2", 0, Exp_Prompt2Cmd, 0, 0}, + {0} +}; + +void +exp_init_main_cmds(interp) + Tcl_Interp *interp; +{ + exp_create_commands(interp,cmd_data); +} ADDED generic/exp_main_tk.c Index: generic/exp_main_tk.c ================================================================== --- /dev/null +++ generic/exp_main_tk.c @@ -0,0 +1,441 @@ +/* exp_main_tk.c - main for expectk + + This file consists of three pieces: + 1) AppInit for Expectk. This has been suitably modified to invoke + a modified version of Tk_Init. + 2) Tk_Init for Expectk. What's wrong with the normal Tk_Init is that + removes the -- in the cmd-line arg list, so Expect cannot know + whether args are flags to Expectk or data for the script. Sigh. + 3) Additions and supporting utilities to Tk's Argv parse table to + support Expectk's flags. + + Author: Don Libes, NIST, 2/20/96 + +*/ + +/* Expectk's AppInit */ + +/* + * tkAppInit.c -- + * + * Provides a default version of the Tcl_AppInit procedure for + * use in wish and similar Tk-based applications. + * + * Copyright (c) 1993 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. + */ + +#ifndef lint +static char sccsid[] = "@(#) tkAppInit.c 1.19 95/12/23 17:09:24"; +#endif /* not lint */ + +#include + +#include "tk.h" + +#include "expect_tcl.h" +#include "Dbg.h" + +/* + * The following variable is a special hack that is needed in order for + * Sun shared libraries to be used for Tcl. + */ + +extern int matherr(); +int *tclDummyMathPtr = (int *) matherr; + +#ifdef TK_TEST +EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp)); +#endif /* TK_TEST */ + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tk_Main never returns here, so this procedure never + * returns either. + * + * Side effects: + * Whatever the application does. + * + *---------------------------------------------------------------------- + */ + +int +main(argc, argv) + int argc; /* Number of command-line arguments. */ + char **argv; /* Values of command-line arguments. */ +{ + Tk_Main(argc, argv, Tcl_AppInit); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppInit(interp) + Tcl_Interp *interp; /* Interpreter for application. */ +{ + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + /* do Expect first so we can get access to Expect commands when */ + /* Tk_Init does the argument parsing of -c */ + if (Expect_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Expect", Expect_Init, (Tcl_PackageInitProc *)NULL); + + if (Tk_Init2(interp) == TCL_ERROR) { /* DEL */ + return TCL_ERROR; + } + Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL); + + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + + Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY); + return TCL_OK; +} + + + + +/* + * Count of number of main windows currently open in this process. + */ + +static int numMainWindows; + +/* + * The variables and table below are used to parse arguments from + * the "argv" variable in Tk_Init. + */ + +static int synchronize; +static char *name; +static char *display; +static char *geometry; +static char *colormap; +static char *visual; +static int rest = 0; + +/* for Expect */ +int my_rc = 1; +int sys_rc = 1; +int optcmd_eval(); +#ifdef TCL_DEBUGGER +int optcmd_debug(); +#endif +int print_version = 0; + +static Tk_ArgvInfo argTable[] = { + {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap, + "Colormap for main window"}, + {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display, + "Display to use"}, + {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry, + "Initial geometry for window"}, + {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name, + "Name to use for application"}, + {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, + "Use synchronous mode for display server"}, + {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual, + "Visual for main window"}, + {"--", 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, + "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"}, + {"-version", TK_ARGV_CONSTANT, (char *) 1, (char *) &print_version, + "Print version and exit"}, +#if TCL_DEBUGGER + {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0, + "Enable debugger"}, +#endif + {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL, + (char *) NULL} +}; + +/* + *---------------------------------------------------------------------- + * + * Tk_Init -- + * + * This procedure is invoked to add Tk to an interpreter. It + * incorporates all of Tk's commands into the interpreter and + * creates the main window for a new Tk application. If the + * interpreter contains a variable "argv", this procedure + * extracts several arguments from that variable, uses them + * to configure the main window, and modifies argv to exclude + * the arguments (see the "wish" documentation for a list of + * the arguments that are extracted). + * + * Results: + * Returns a standard Tcl completion code and sets interp->result + * if there is an error. + * + * Side effects: + * Depends on various initialization scripts that get invoked. + * + *---------------------------------------------------------------------- + */ + +int +Tk_Init2(interp) + Tcl_Interp *interp; /* Interpreter to initialize. */ +{ + char *p; + int argc, code; + char **argv, *args[20]; + Tcl_DString class; + char buffer[30]; + + /* + * If there is an "argv" variable, get its value, extract out + * relevant arguments from it, and rewrite the variable without + * the arguments that we used. + */ + + synchronize = 0; + name = display = geometry = colormap = visual = NULL; + p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY); + argv = NULL; + if (p != NULL) { + if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) { + argError: + Tcl_AddErrorInfo(interp, + "\n (processing arguments in argv variable)"); + return TCL_ERROR; + } + if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, + argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS) + != TCL_OK) { + ckfree((char *) argv); + goto argError; + } + + if (print_version) { + extern char exp_version[]; + printf ("expectk version %s\n", exp_version); + exp_exit (interp, 0); + } + + p = Tcl_Merge(argc, argv); + Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY); + sprintf(buffer, "%d", argc); + Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY); + ckfree(p); + } + + /* + * Figure out the application's name and class. + */ + + if (name == NULL) { + name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); + if ((name == NULL) || (*name == 0)) { + name = "tk"; + } else { + p = (char *)strrchr(name, '/'); /* added cast - DEL */ + if (p != NULL) { + name = p+1; + } + } + } + Tcl_DStringInit(&class); + Tcl_DStringAppend(&class, name, -1); + p = Tcl_DStringValue(&class); + if (islower(*p)) { + *p = toupper((unsigned char) *p); + } + + /* + * Create an argument list for creating the top-level window, + * using the information parsed from argv, if any. + */ + + args[0] = "toplevel"; + args[1] = "."; + args[2] = "-class"; + args[3] = Tcl_DStringValue(&class); + argc = 4; + if (display != NULL) { + args[argc] = "-screen"; + args[argc+1] = display; + argc += 2; + + /* + * If this is the first application for this process, save + * the display name in the DISPLAY environment variable so + * that it will be available to subprocesses created by us. + */ + + if (numMainWindows == 0) { + Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); + } + } + if (colormap != NULL) { + args[argc] = "-colormap"; + args[argc+1] = colormap; + argc += 2; + } + if (visual != NULL) { + args[argc] = "-visual"; + args[argc+1] = visual; + argc += 2; + } + args[argc] = NULL; + code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name); + Tcl_DStringFree(&class); + if (code != TCL_OK) { + goto done; + } + Tcl_ResetResult(interp); + if (synchronize) { + XSynchronize(Tk_Display(Tk_MainWindow(interp)), True); + } + + /* + * Set the geometry of the main window, if requested. Put the + * requested geometry into the "geometry" variable. + */ + + if (geometry != NULL) { + Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); + code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL); + if (code != TCL_OK) { + goto done; + } + } + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) { + code = TCL_ERROR; + goto done; + } + code = Tcl_PkgProvide(interp, "Tk", TK_VERSION); + if (code != TCL_OK) { + goto done; + } + + /* + * Invoke platform-specific initialization. + */ + + code = TkPlatformInit(interp); + + done: + if (argv != NULL) { + ckfree((char *) argv); + } + return code; +} + +/*ARGSUSED*/ +int +optcmd_eval(dst,interp,key,argc,argv) +char *dst; +Tcl_Interp *interp; +char *key; +int argc; +char **argv; +{ + int i; + int rc; + + exp_cmdlinecmds = 1; + + rc = Tcl_Eval(interp,argv[0]); + if (rc == TCL_ERROR) return -1; + + argc--; + for (i=0;iresult,"-Debug flag needs 1 or 0 argument"); + return -1; + } + + if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) { + return -1; + } + + if (i) { + Dbg_On(interp,0); + } + + argc--; + for (i=0;i 1) { + exp_error(interp,"expect not compiled with multiprocess support"); + /* select a different INTERACT_TYPE in Makefile */ + return(TCL_ERROR); + } + + *master_out = masters[0]; + f = masters[0]; + + 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); +} + +/*ARGSUSED*/ +int +exp_get_next_event_info(interp,f,ready_mask) + Tcl_Interp *interp; + struct exp_f *f; + int ready_mask; +{ + if (ready_mask & TCL_READABLE) return EXP_DATA_NEW; + + return(EXP_EOF); +} + +/* There is no portable way to do sub-second sleeps on such a system, so */ +/* do the next best thing (without a busy loop) and fake it: sleep the right */ +/* amount of time over the long run. Note that while "subtotal" isn't */ +/* reinitialized, it really doesn't matter for such a gross hack as random */ +/* scheduling pauses will easily introduce occasional one second delays. */ +int /* returns TCL_XXX */ +exp_dsleep(interp,sec) +Tcl_Interp *interp; +double sec; +{ + static double subtotal = 0; + int seconds; + + subtotal += sec; + if (subtotal < 1) return TCL_OK; + seconds = (int) subtotal; + subtotal -= seconds; + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(rc); + } +#ifdef __WIN32__ + Sleep(seconds*1000); +#else + sleep(seconds); +#endif + + return TCL_OK; +} + +#if 0 +/* There is no portable way to do sub-second sleeps on such a system, so */ +/* do the next best thing (without a busy loop) and fake it: sleep the right */ +/* amount of time over the long run. Note that while "subtotal" isn't */ +/* reinitialized, it really doesn't matter for such a gross hack as random */ +/* scheduling pauses will easily introduce occasional one second delays. */ +int /* returns TCL_XXX */ +exp_usleep(interp,usec) +Tcl_Interp *interp; +long usec; /* microseconds */ +{ + static subtotal = 0; + int seconds; + + subtotal += usec; + if (subtotal < 1000000) return TCL_OK; + seconds = subtotal/1000000; + subtotal = subtotal%1000000; + restart: + if (Tcl_AsyncReady()) { + int rc = Tcl_AsyncInvoke(interp,TCL_OK); + if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc)); + } + sleep(seconds); + return TCL_OK; +} +#endif /*0*/ + +/* set things up for later calls to event handler */ +void +exp_init_event() +{ + exp_event_exit = 0; +} ADDED generic/exp_printify.c Index: generic/exp_printify.c ================================================================== --- /dev/null +++ generic/exp_printify.c @@ -0,0 +1,79 @@ +/* ---------------------------------------------------------------------------- + * exp_printify.c -- + * + * make non-printable characters printable. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +#ifdef NO_STRING_H +#include "../compat/string.h" +#else +#include +#endif +#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 unsigned 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); +} ADDED generic/exp_regexp.c Index: generic/exp_regexp.c ================================================================== --- /dev/null +++ generic/exp_regexp.c @@ -0,0 +1,1253 @@ +/* + * regcomp and regexec -- regsub and regerror are 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. *** + * *** The only change is to use ckalloc and ckfree instead of *** + * *** malloc and free. *** + + * *** and again for Expect!!! - DEL + + * *** More minor corrections stolen from tcl7.5p1/regexp.c - DEL + + */ + +#include "exp_port.h" +#include "tcl.h" +#include "exp_prog.h" +#include "tclRegexp.h" +#include "exp_regexp.h" +#include "string.h" + +#define NOTSTATIC /* was at one time, but Expect needs access */ + +/* + * 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 regcomp() 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 regexec() needs it and regcomp() 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) { regerror(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 regcomp(). + */ +static char *regparse; /* Input-scan pointer. */ +static int regnpar; /* () count. */ +static char regdummy; +static char *regcode; /* Code-emit pointer; ®dummy = don't. */ +static long regsize; /* Code size. */ + +/* + * 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 regcomp()'s friends. + */ +#ifndef STATIC +#define STATIC static +#endif +STATIC char *reg(); +STATIC char *regbranch(); +STATIC char *regpiece(); +STATIC char *regatom(); +STATIC char *regnode(); +STATIC char *regnext(); +STATIC void regc(); +STATIC void reginsert(); +STATIC void regtail(); +STATIC void regoptail(); +#ifdef STRCSPN +STATIC int strcspn(); +#endif + +/* regcomp originally appeared here - DEL */ + +/* + - 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) +int paren; /* Parenthesized? */ +int *flagp; +{ + 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 (regnpar >= NSUBEXP) + FAIL("too many ()"); + parno = regnpar; + regnpar++; + ret = regnode(OPEN+parno); + } else + ret = NULL; + + /* Pick up the branches, linking them together. */ + br = regbranch(&flags); + 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 (*regparse == '|') { + regparse++; + br = regbranch(&flags); + 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); + 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 && *regparse++ != ')') { + FAIL("unmatched ()"); + } else if (!paren && *regparse != '\0') { + if (*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) +int *flagp; +{ + register char *ret; + register char *chain; + register char *latest; + int flags; + + *flagp = WORST; /* Tentatively. */ + + ret = regnode(BRANCH); + chain = NULL; + while (*regparse != '\0' && *regparse != '|' && *regparse != ')') { + latest = regpiece(&flags); + 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); + + 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) +int *flagp; +{ + register char *ret; + register char op; + register char *next; + int flags; + + ret = regatom(&flags); + if (ret == NULL) + return(NULL); + + op = *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); + else if (op == '*') { + /* Emit x* as (x&|), where & means "self". */ + reginsert(BRANCH, ret); /* Either x */ + regoptail(ret, regnode(BACK)); /* and loop */ + regoptail(ret, ret); /* back */ + regtail(ret, regnode(BRANCH)); /* or */ + regtail(ret, regnode(NOTHING)); /* null. */ + } else if (op == '+' && (flags&SIMPLE)) + reginsert(PLUS, ret); + else if (op == '+') { + /* Emit x+ as x(&|), where & means "self". */ + next = regnode(BRANCH); /* Either */ + regtail(ret, next); + regtail(regnode(BACK), ret); /* loop back */ + regtail(next, regnode(BRANCH)); /* or */ + regtail(ret, regnode(NOTHING)); /* null. */ + } else if (op == '?') { + /* Emit x? as (x|) */ + reginsert(BRANCH, ret); /* Either x */ + regtail(ret, regnode(BRANCH)); /* or */ + next = regnode(NOTHING); /* null. */ + regtail(ret, next); + regoptail(ret, next); + } + regparse++; + if (ISMULT(*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) +int *flagp; +{ + register char *ret; + int flags; + + *flagp = WORST; /* Tentatively. */ + + switch (*regparse++) { + case '^': + ret = regnode(BOL); + break; + case '$': + ret = regnode(EOL); + break; + case '.': + ret = regnode(ANY); + *flagp |= HASWIDTH|SIMPLE; + break; + case '[': { + register int clss; + register int classend; + + if (*regparse == '^') { /* Complement of range. */ + ret = regnode(ANYBUT); + regparse++; + } else + ret = regnode(ANYOF); + if (*regparse == ']' || *regparse == '-') + regc(*regparse++); + while (*regparse != '\0' && *regparse != ']') { + if (*regparse == '-') { + regparse++; + if (*regparse == ']' || *regparse == '\0') + regc('-'); + else { + clss = UCHARAT(regparse-2)+1; + classend = UCHARAT(regparse); + if (clss > classend+1) + FAIL("invalid [] range"); + for (; clss <= classend; clss++) + regc((char)clss); + regparse++; + } + } else + regc(*regparse++); + } + regc('\0'); + if (*regparse != ']') + FAIL("unmatched []"); + regparse++; + *flagp |= HASWIDTH|SIMPLE; + } + break; + case '(': + ret = reg(1, &flags); + if (ret == NULL) + return(NULL); + *flagp |= flags&(HASWIDTH|SPSTART); + break; + case '\0': + case '|': + case ')': + FAIL("internal urp"); /* Supposed to be caught earlier. */ + /* NOTREACHED */ + break; + case '?': + case '+': + case '*': + FAIL("?+* follows nothing"); + /* NOTREACHED */ + break; + case '\\': + if (*regparse == '\0') + FAIL("trailing \\"); + ret = regnode(EXACTLY); + regc(*regparse++); + regc('\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + default: { + register int len; + register char ender; + + regparse--; + len = strcspn(regparse, META); + if (len <= 0) + FAIL("internal disaster"); + ender = *(regparse+len); + if (len > 1 && ISMULT(ender)) + len--; /* Back off clear of ?+* operand. */ + *flagp |= HASWIDTH; + if (len == 1) + *flagp |= SIMPLE; + ret = regnode(EXACTLY); + while (len > 0) { + regc(*regparse++); + len--; + } + regc('\0'); + } + break; + } + + return(ret); +} + +/* + - regnode - emit a node + */ +static char * /* Location. */ +regnode(op) +int op; +{ + register char *ret; + register char *ptr; + + ret = regcode; + if (ret == ®dummy) { + regsize += 3; + return(ret); + } + + ptr = ret; + *ptr++ = (char)op; + *ptr++ = '\0'; /* Null "next" pointer. */ + *ptr++ = '\0'; + regcode = ptr; + + return(ret); +} + +/* + - regc - emit (if appropriate) a byte of code + */ +static void +regc(b) +int b; +{ + if (regcode != ®dummy) + *regcode++ = (char)b; + else + regsize++; +} + +/* + - reginsert - insert an operator in front of already-emitted operand + * + * Means relocating the operand. + */ +static void +reginsert(op, opnd) +int op; +char *opnd; +{ + register char *src; + register char *dst; + register char *place; + + if (regcode == ®dummy) { + regsize += 3; + return; + } + + src = regcode; + regcode += 3; + dst = 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); +} + +/* + * regexec and friends + */ + +/* + * Global work variables for regexec(). + */ +static char *reginput; /* String-input pointer. */ +NOTSTATIC char *regbol; /* Beginning of input, for ^ check. */ +static char **regstartp; /* Pointer to startp array. */ +static char **regendp; /* Ditto for endp. */ + +/* + * Forwards. + */ + +NOTSTATIC int regtry(); +STATIC int regmatch(); +STATIC int regrepeat(); + +#ifdef DEBUG +int regnarrate = 0; +void regdump(); +STATIC char *regprop(); +#endif + +#if 0 +/* + - regexec - match a regexp against a string + */ +int +regexec(prog, string, stringlength, matchlength) +register regexp *prog; +register char *string; /* note: CURRENTLY ASSUMED TO BE NULL-TERMINATED!!! */ +int stringlength; /* length of string */ +int *matchlength; /* number of chars matched (or to be skipped) */ + /* set when MATCH or CANT_MATCH */ +{ + register char *s; + extern char *strchr(); + + /* Be paranoid... */ + if (prog == NULL || string == NULL) { + regerror("NULL parameter"); + return(EXP_TCLERROR); + } + + /* Check validity of program. */ + if (UCHARAT(prog->program) != MAGIC) { + regerror("corrupted program"); + return(EXP_KM_ERROR); + } + +#if THIS_RUINS_EXP +/* no need for this shortcut anyway */ + /* 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, prog->regmlen) == 0) + break; /* Found it. */ + s++; + } + if (s == NULL) /* Not present. */ + return(0); + } +#endif + + /* Mark beginning of line for ^ . */ + regbol = string; + + /* Simplest case: anchored match need be tried only once. */ + if (prog->reganch) { + int r = regtry(prog,string,matchlength); + if (r == CANT_MATCH) *matchlength = stringlength; + return(r); + } + + /* Messy cases: unanchored match. */ + s = string; + if (prog->regstart != '\0') { + register char *s2 = s; + + /* We know what char it must start with. */ + while (1) { + int r; + + s2 = strchr(s2,prog->regstart); + if (s2 == 0) { + *matchlength = stringlength; + return(CANT_MATCH); + } + r = regtry(prog,s2,matchlength); + if (r == CANT_MATCH) { + s2++; + continue; + } + if (s2 == s) return(r); + *matchlength = s2-s; + return CANT_MATCH; + } + } else { + /* We don't -- general case. */ + register char *s2 = s; + int r = regtry(prog,s,matchlength); + if (r == EXP_MATCH) return(r); + else if (r == EXP_CANMATCH) return(r); + /* at this point, we know some characters at front */ + /* of string don't match */ + for (s2++;*s2;s2++) { + r = regtry(prog,s2,matchlength); + if (r == CANT_MATCH) continue; + /* if we match or can_match, say cant_match and */ + /* record the number of chars at front that don't match */ + *matchlength = s2-s; + return(CANT_MATCH); + } + /* made it thru string with CANT_MATCH all the way */ + *matchlength = stringlength; + return(CANT_MATCH); + } +} +#endif + +/* + - regtry - try match at specific point + */ +/* return CAN_MATCH, CANT_MATCH or MATCH */ +int /* 0 failure, 1 success */ +regtry(prog, string, matchlength) +regexp *prog; +char *string; +int *matchlength; /* only set for MATCH */ +{ + register int i; + register char **sp; + register char **ep; + int r; /* result of regmatch */ + + reginput = string; + regstartp = prog->startp; + regendp = prog->endp; + + sp = prog->startp; + ep = prog->endp; + for (i = NSUBEXP; i > 0; i--) { + *sp++ = NULL; + *ep++ = NULL; + } + r = regmatch(prog->program + 1); + if (EXP_MATCH == r) { + prog->startp[0] = string; + prog->endp[0] = reginput; + *matchlength = reginput-string; + return(EXP_MATCH); + } + return(r); /* CAN_MATCH or CANT_MATCH */ +} + +/* + - 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. + */ +/* returns CAN, CANT or MATCH */ +static int /* 0 failure, 1 success */ +regmatch(prog) +char *prog; +{ + register char *scan; /* Current node. */ + char *next; /* Next node. */ +#ifndef strchr /* May be #defined to something else */ + extern char *strchr(); +#endif + + 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 (reginput != regbol) +/* return(0);*/ + return(EXP_CANTMATCH); + break; + case EOL: + if (*reginput != '\0') +/* return(0);*/ +/* note this implies that "$" must match everything received to this point! */ + return(EXP_CANTMATCH); + break; + case ANY: + if (*reginput == '\0') +/* return(0);*/ + return(EXP_CANMATCH); + reginput++; + break; + case EXACTLY: { +/* register int len;*/ + register char *opnd; + + opnd = OPERAND(scan); + + /* this section of code is totally rewritten - DEL */ + /* group of literal chars in pattern */ + /* compare each one */ + do { + if (*opnd != *reginput) { + if (*reginput == '\0') { + return EXP_CANMATCH; + } else return EXP_CANTMATCH; + } + + reginput++; + opnd++; + } while (*opnd != '\0'); + } + break; + case ANYOF: +/* if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) == NULL) + return(0); +*/ + if (*reginput == '\0') + return(EXP_CANMATCH); + if (strchr(OPERAND(scan),*reginput) == NULL) + return(EXP_CANTMATCH); + reginput++; + break; + case ANYBUT: +/* if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) != NULL) + return(0); +*/ + if (*reginput == '\0') + return(EXP_CANMATCH); + if (strchr(OPERAND(scan),*reginput) != NULL) + return(EXP_CANTMATCH); + 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; + int r; /* result of regmatch */ + + doOpen: + no = OP(scan) - OPEN; + save = reginput; + + r = regmatch(next); + if (r == EXP_MATCH) { + /* + * Don't set startp if some later + * invocation of the same parentheses + * already has. + */ + if (regstartp[no] == NULL) + regstartp[no] = save; + } + return(r); + } + /* NOTREACHED */ + 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: { + register int no; + register char *save; + int r; /* result of regmatch */ + + doClose: + no = OP(scan) - CLOSE; + save = reginput; + + r = regmatch(next); + if (r == EXP_MATCH) { + /* + * Don't set endp if some later + * invocation of the same parentheses + * already has. + */ + if (regendp[no] == NULL) + regendp[no] = save; + } + return(r); + } + /* NOTREACHED */ + break; + case BRANCH: { + register char *save; + int match_status; + + if (OP(next) != BRANCH) /* No choice. */ + next = OPERAND(scan); /* Avoid recursion. */ + else { + match_status = EXP_CANTMATCH; + + do { + int r; + + save = reginput; + r = regmatch(OPERAND(scan)); + if (r == EXP_MATCH) return(r); + if (r == EXP_CANMATCH) { + match_status = r; + } + reginput = save; + scan = regnext(scan); + } while (scan != NULL && OP(scan) == BRANCH); + return(match_status); + /* NOTREACHED */ + } + } + /* NOTREACHED */ + break; + case STAR: + case PLUS: { + register char nextch; + register int no; + register char *save; + register int min; + int match_status; + + /* + * Lookahead to avoid useless match attempts + * when we know what character comes next. + */ + match_status = EXP_CANTMATCH; + nextch = '\0'; + if (OP(next) == EXACTLY) + nextch = *OPERAND(next); + min = (OP(scan) == STAR) ? 0 : 1; + save = reginput; + no = regrepeat(OPERAND(scan)); + while (no >= min) { + /* If it could work, try it. */ + /* 3rd condition allows for CAN_MATCH */ + 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; + } + /* Couldn't or didn't -- back up. */ + no--; + reginput = save + no; + } + return(match_status); + } + /* NOTREACHED */ + break; + case END: + return(EXP_MATCH); /* Success! */ + /* NOTREACHED */ + break; + default: + if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) { + goto doOpen; + } else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) { + goto doClose; + } + regerror("memory corruption"); + return(EXP_TCLERROR); + /* NOTREACHED */ + break; + } + + scan = next; + } + + /* + * We get here only if there's trouble -- normally "case END" is + * the terminating point. + */ + regerror("corrupted pointers"); + return(EXP_TCLERROR); +} + +/* + - regrepeat - repeatedly match something simple, report how many + */ +static int +regrepeat(p) +char *p; +{ + register int count = 0; + register char *scan; + register char *opnd; +#ifndef strchr /* May be #defined to something else */ +/*DEL*/ extern char *strchr(); +#endif + + scan = 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. */ + regerror("internal foulup"); + count = 0; /* Best compromise. */ + break; + } + 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; + extern char *strchr(); + + + 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 ADDED generic/exp_strf.c Index: generic/exp_strf.c ================================================================== --- /dev/null +++ generic/exp_strf.c @@ -0,0 +1,621 @@ +/* ---------------------------------------------------------------------------- + * exp_strp.c -- + * + * functions for exp_timestamp. + * + * ---------------------------------------------------------------------------- + * Notes: + * + * Public-domain implementation of ANSI C library routine. + * + * It's written in old-style C for maximal portability. + * However, since I'm used to prototypes, I've included them too. + * + * If you want stuff in the System V ascftime routine, add the SYSV_EXT define. + * For extensions from SunOS, add SUNOS_EXT. + * For stuff needed to implement the P1003.2 date command, add POSIX2_DATE. + * For VMS dates, add VMS_EXT. + * For complete POSIX semantics, add POSIX_SEMANTICS. + * + * The code for %c, %x, and %X now follows the 1003.2 specification for + * the POSIX locale. + * This version ignores LOCALE information. + * It also doesn't worry about multi-byte characters. + * So there. + * + * This file is also shipped with GAWK (GNU Awk), gawk specific bits of + * code are included if GAWK is defined. + * + * Arnold Robbins + * January, February, March, 1991 + * Updated March, April 1992 + * Updated April, 1993 + * Updated February, 1994 + * Updated May, 1994 + * Updated January 1995 + * Updated September 1995 + * + * Fixes from ado@elsie.nci.nih.gov + * February 1991, May 1992 + * Fixes from Tor Lillqvist tml@tik.vtt.fi + * May, 1993 + * Further fixes from ado@elsie.nci.nih.gov + * February 1994 + * %z code from chip@chinacat.unicom.com + * Applied September 1995 + * + * + * Modified by Don Libes for Expect, 10/93 and 12/95. + * Forced POSIX semantics. + * Replaced inline/min/max stuff with a single range function. + * Removed tzset stuff. + * Commented out tzname stuff. + * + * According to Arnold, the current version of this code can ftp'd from + * ftp.mathcs.emory.edu:/pub/arnold/strftime.shar.gz + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" +#include "expPort.h" + +#include +#include +#include +#include + +#define SYSV_EXT 1 /* stuff in System V ascftime routine */ +#define POSIX2_DATE 1 /* stuff in Posix 1003.2 date command */ + +#if defined(POSIX2_DATE) && ! defined(SYSV_EXT) +#define SYSV_EXT 1 +#endif + +#if defined(POSIX2_DATE) +#define adddecl(stuff) stuff +#else +#define adddecl(stuff) +#endif + +#ifndef __STDC__ + +static int weeknumber(); +adddecl(static int iso8601wknum();) +#else + +extern char *strchr(const char *str, int ch); +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 */ +/* less portable ways */ +#if !defined(HAVE_STRFTIME) +# if defined(HAVE_SV_TIMEZONE) +# ifndef __WIN32__ + extern char *tzname[2]; + extern int daylight; +# endif +# else +# if defined(HAVE_TIMEZONE) + +char * +zone_name (tp) + struct tm *tp; +{ + char *timezone (); + struct timeval tv; + struct timezone tz; + + gettimeofday (&tv, &tz); + + return timezone (tz.tz_minuteswest, tp->tm_isdst); +} + +# endif /* HAVE_TIMEZONE */ +# endif /* HAVE_SV_TIMEZONE */ +#endif /* HAVE_STRFTIME */ + +static int +range(low,item,hi) + int low, item, hi; +{ + if (item < low) return low; + if (item > hi) return hi; + return item; +} + +/* strftime --- produce formatted time */ + +void +/*size_t*/ +#ifndef __STDC__ +exp_strftime(/*s,*/ format, timeptr, dstring) +/*char *s;*/ +char *format; +CONST struct tm *timeptr; +Tcl_DString *dstring; +#else +/*exp_strftime(char *s, size_t maxsize, const char *format, const struct tm *timeptr)*/ +exp_strftime(char *format, const struct tm *timeptr,Tcl_DString *dstring) +#endif +{ + int copied; /* used to suppress copying when called recursively */ + +#if 0 + char *endp = s + maxsize; + char *start = s; +#endif + char *percentptr; + + char tbuf[100]; + int i; + + /* various tables, useful in North America */ + static char *days_a[] = { + "Sun", "Mon", "Tue", "Wed", + "Thu", "Fri", "Sat", + }; + static char *days_l[] = { + "Sunday", "Monday", "Tuesday", "Wednesday", + "Thursday", "Friday", "Saturday", + }; + static char *months_a[] = { + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", + }; + static char *months_l[] = { + "January", "February", "March", "April", + "May", "June", "July", "August", "September", + "October", "November", "December", + }; + static char *ampm[] = { "AM", "PM", }; + +/* for (; *format && s < endp - 1; format++) {*/ + for (; *format ; format++) { + tbuf[0] = '\0'; + copied = 0; /* has not been copied yet */ + percentptr = strchr(format,'%'); + if (percentptr == 0) { + Tcl_DStringAppend(dstring,format,-1); + goto out; + } else if (percentptr != format) { + Tcl_DStringAppend(dstring,format,percentptr - format); + format = percentptr; + } +#if 0 + if (*format != '%') { + *s++ = *format; + continue; + } +#endif + again: + switch (*++format) { + case '\0': + Tcl_DStringAppend(dstring,"%",1); +#if 0 + *s++ = '%'; +#endif + goto out; + + case '%': + Tcl_DStringAppend(dstring,"%",1); + copied = 1; + break; +#if 0 + *s++ = '%'; + continue; +#endif + + case 'a': /* abbreviated weekday name */ + if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6) + strcpy(tbuf, "?"); + else + strcpy(tbuf, days_a[timeptr->tm_wday]); + break; + + case 'A': /* full weekday name */ + if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6) + strcpy(tbuf, "?"); + else + strcpy(tbuf, days_l[timeptr->tm_wday]); + break; + +#ifdef SYSV_EXT + case 'h': /* abbreviated month name */ +#endif + case 'b': /* abbreviated month name */ + if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11) + strcpy(tbuf, "?"); + else + strcpy(tbuf, months_a[timeptr->tm_mon]); + break; + + case 'B': /* full month name */ + if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11) + strcpy(tbuf, "?"); + else + strcpy(tbuf, months_l[timeptr->tm_mon]); + break; + + case 'c': /* appropriate date and time representation */ + sprintf(tbuf, "%s %s %2d %02d:%02d:%02d %d", + days_a[range(0, timeptr->tm_wday, 6)], + months_a[range(0, timeptr->tm_mon, 11)], + range(1, timeptr->tm_mday, 31), + range(0, timeptr->tm_hour, 23), + range(0, timeptr->tm_min, 59), + range(0, timeptr->tm_sec, 61), + timeptr->tm_year + 1900); + break; + + case 'd': /* day of the month, 01 - 31 */ + i = range(1, timeptr->tm_mday, 31); + sprintf(tbuf, "%02d", i); + break; + + case 'H': /* hour, 24-hour clock, 00 - 23 */ + i = range(0, timeptr->tm_hour, 23); + sprintf(tbuf, "%02d", i); + break; + + case 'I': /* hour, 12-hour clock, 01 - 12 */ + i = range(0, timeptr->tm_hour, 23); + if (i == 0) + i = 12; + else if (i > 12) + i -= 12; + sprintf(tbuf, "%02d", i); + break; + + case 'j': /* day of the year, 001 - 366 */ + sprintf(tbuf, "%03d", timeptr->tm_yday + 1); + break; + + case 'm': /* month, 01 - 12 */ + i = range(0, timeptr->tm_mon, 11); + sprintf(tbuf, "%02d", i + 1); + break; + + case 'M': /* minute, 00 - 59 */ + i = range(0, timeptr->tm_min, 59); + sprintf(tbuf, "%02d", i); + break; + + case 'p': /* am or pm based on 12-hour clock */ + i = range(0, timeptr->tm_hour, 23); + if (i < 12) + strcpy(tbuf, ampm[0]); + else + strcpy(tbuf, ampm[1]); + break; + + case 'S': /* second, 00 - 61 */ + i = range(0, timeptr->tm_sec, 61); + sprintf(tbuf, "%02d", i); + break; + + case 'U': /* week of year, Sunday is first day of week */ + sprintf(tbuf, "%02d", weeknumber(timeptr, 0)); + break; + + case 'w': /* weekday, Sunday == 0, 0 - 6 */ + i = range(0, timeptr->tm_wday, 6); + sprintf(tbuf, "%d", i); + break; + + case 'W': /* week of year, Monday is first day of week */ + sprintf(tbuf, "%02d", weeknumber(timeptr, 1)); + break; + + case 'x': /* appropriate date representation */ + sprintf(tbuf, "%s %s %2d %d", + days_a[range(0, timeptr->tm_wday, 6)], + months_a[range(0, timeptr->tm_mon, 11)], + range(1, timeptr->tm_mday, 31), + timeptr->tm_year + 1900); + break; + + case 'X': /* appropriate time representation */ + sprintf(tbuf, "%02d:%02d:%02d", + range(0, timeptr->tm_hour, 23), + range(0, timeptr->tm_min, 59), + range(0, timeptr->tm_sec, 61)); + break; + + case 'y': /* year without a century, 00 - 99 */ + i = timeptr->tm_year % 100; + sprintf(tbuf, "%02d", i); + break; + + case 'Y': /* year with century */ + sprintf(tbuf, "%d", 1900 + timeptr->tm_year); + break; + + case 'Z': /* time zone name or abbrevation */ +#if defined(HAVE_STRFTIME) + strftime(tbuf,sizeof tbuf,"%Z",timeptr); +#else +# if defined(HAVE_SV_TIMEZONE) + i = 0; + if (daylight && timeptr->tm_isdst) + i = 1; + strcpy(tbuf, tzname[i]); +# else + strcpy(tbuf, zone_name (timeptr)); +# if defined(HAVE_TIMEZONE) +# endif /* HAVE_TIMEZONE */ + /* no timezone available */ + /* feel free to add others here */ +# endif /* HAVE_SV_TIMEZONE */ +#endif /* HAVE STRFTIME */ + break; + +#ifdef SYSV_EXT + case 'n': /* same as \n */ + tbuf[0] = '\n'; + tbuf[1] = '\0'; + break; + + case 't': /* same as \t */ + tbuf[0] = '\t'; + tbuf[1] = '\0'; + break; + + case 'D': /* date as %m/%d/%y */ + exp_strftime("%m/%d/%y", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%m/%d/%y", timeptr);*/ + break; + + case 'e': /* day of month, blank padded */ + sprintf(tbuf, "%2d", range(1, timeptr->tm_mday, 31)); + break; + + case 'r': /* time as %I:%M:%S %p */ + exp_strftime("%I:%M:%S %p", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%I:%M:%S %p", timeptr);*/ + break; + + case 'R': /* time as %H:%M */ + exp_strftime("%H:%M", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%H:%M", timeptr);*/ + break; + + case 'T': /* time as %H:%M:%S */ + exp_strftime("%H:%M:%S", timeptr, dstring); + copied = 1; +/* exp_strftime(tbuf, sizeof tbuf, "%H:%M:%S", timeptr);*/ + break; +#endif + +#ifdef POSIX2_DATE + case 'C': + sprintf(tbuf, "%02d", (timeptr->tm_year + 1900) / 100); + break; + + + case 'E': + case 'O': + /* POSIX locale extensions, ignored for now */ + goto again; + case 'V': /* week of year according ISO 8601 */ + sprintf(tbuf, "%02d", iso8601wknum(timeptr)); + break; + + case 'u': + /* ISO 8601: Weekday as a decimal number [1 (Monday) - 7] */ + sprintf(tbuf, "%d", timeptr->tm_wday == 0 ? 7 : + timeptr->tm_wday); + break; +#endif /* POSIX2_DATE */ + default: + tbuf[0] = '%'; + tbuf[1] = *format; + tbuf[2] = '\0'; + break; + } + if (!copied) + Tcl_DStringAppend(dstring,tbuf,-1); +#if 0 + i = strlen(tbuf); + if (i) { + if (s + i < endp - 1) { + strcpy(s, tbuf); + s += i; + } else + return 0; +#endif + } +out:; +#if 0 + if (s < endp && *format == '\0') { + *s = '\0'; + return (s - start); + } else + return 0; +#endif +} + +/* isleap --- is a year a leap year? */ + +#ifndef __STDC__ +static int +isleap(year) +int year; +#else +static int +isleap(int year) +#endif +{ + return ((year % 4 == 0 && year % 100 != 0) || year % 400 == 0); +} + +#ifdef POSIX2_DATE +/* iso8601wknum --- compute week number according to ISO 8601 */ + +#ifndef __STDC__ +static int +iso8601wknum(timeptr) +const struct tm *timeptr; +#else +static int +iso8601wknum(const struct tm *timeptr) +#endif +{ + /* + * From 1003.2: + * If the week (Monday to Sunday) containing January 1 + * has four or more days in the new year, then it is week 1; + * otherwise it is the highest numbered week of the previous + * (52 or 53) year, and the next week is week 1. + * + * ADR: This means if Jan 1 was Monday through Thursday, + * it was week 1, otherwise week 53. + * + * XPG4 erroneously included POSIX.2 rationale text in the + * main body of the standard. Thus it requires week 53. + */ + + int weeknum, jan1day; + + /* get week number, Monday as first day of the week */ + weeknum = weeknumber(timeptr, 1); + + /* + * With thanks and tip of the hatlo to tml@tik.vtt.fi + * + * What day of the week does January 1 fall on? + * We know that + * (timeptr->tm_yday - jan1.tm_yday) MOD 7 == + * (timeptr->tm_wday - jan1.tm_wday) MOD 7 + * and that + * jan1.tm_yday == 0 + * and that + * timeptr->tm_wday MOD 7 == timeptr->tm_wday + * from which it follows that. . . + */ + jan1day = timeptr->tm_wday - (timeptr->tm_yday % 7); + if (jan1day < 0) + jan1day += 7; + + /* + * If Jan 1 was a Monday through Thursday, it was in + * week 1. Otherwise it was last year's highest week, which is + * this year's week 0. + * + * What does that mean? + * If Jan 1 was Monday, the week number is exactly right, it can + * never be 0. + * If it was Tuesday through Thursday, the weeknumber is one + * less than it should be, so we add one. + * Otherwise, Friday, Saturday or Sunday, the week number is + * OK, but if it is 0, it needs to be 52 or 53. + */ + switch (jan1day) { + case 1: /* Monday */ + break; + case 2: /* Tuesday */ + case 3: /* Wednesday */ + case 4: /* Thursday */ + weeknum++; + break; + case 5: /* Friday */ + case 6: /* Saturday */ + case 0: /* Sunday */ + if (weeknum == 0) { +#ifdef USE_BROKEN_XPG4 + /* XPG4 (as of March 1994) says 53 unconditionally */ + weeknum = 53; +#else + /* get week number of last week of last year */ + struct tm dec31ly; /* 12/31 last year */ + dec31ly = *timeptr; + dec31ly.tm_year--; + dec31ly.tm_mon = 11; + dec31ly.tm_mday = 31; + dec31ly.tm_wday = (jan1day == 0) ? 6 : jan1day - 1; + dec31ly.tm_yday = 364 + isleap(dec31ly.tm_year + 1900); + weeknum = iso8601wknum(& dec31ly); +#endif + } + break; + } + + if (timeptr->tm_mon == 11) { + /* + * The last week of the year + * can be in week 1 of next year. + * Sigh. + * + * This can only happen if + * M T W + * 29 30 31 + * 30 31 + * 31 + */ + int wday, mday; + + wday = timeptr->tm_wday; + mday = timeptr->tm_mday; + if ( (wday == 1 && (mday >= 29 && mday <= 31)) + || (wday == 2 && (mday == 30 || mday == 31)) + || (wday == 3 && mday == 31)) + weeknum = 1; + } + + return weeknum; +} +#endif + +/* weeknumber --- figure how many weeks into the year */ + +/* With thanks and tip of the hatlo to ado@elsie.nci.nih.gov */ + +#ifndef __STDC__ +static int +weeknumber(timeptr, firstweekday) +const struct tm *timeptr; +int firstweekday; +#else +static int +weeknumber(const struct tm *timeptr, int firstweekday) +#endif +{ + int wday = timeptr->tm_wday; + int ret; + + if (firstweekday == 1) { + if (wday == 0) /* sunday */ + wday = 6; + else + wday--; + } + ret = ((timeptr->tm_yday + 7 - wday) / 7); + if (ret < 0) + ret = 0; + return ret; +} ADDED generic/exp_win.c Index: generic/exp_win.c ================================================================== --- /dev/null +++ generic/exp_win.c @@ -0,0 +1,205 @@ +/* exp_win.c - window support + +Written by: Don Libes, NIST, 10/25/93 + +This file is in the public domain. However, the author and NIST +would appreciate credit if you use this file or parts of it. + +*/ + +#include "expect_cf.h" +#include "tcl.h" + +#ifdef NO_STDLIB_H +#include "../compat/stdlib.h" +#else +#include +#endif + +/* _IBCS2 required on some Intel platforms to allow the include files */ +/* to produce a definition for winsize. */ +#define _IBCS2 1 + +/* + * get everyone's window size definitions + * +note that this is tricky because (of course) everyone puts them in +different places. Worse, on some systems, some .h files conflict +and cannot both be included even though both exist. This is the +case, for example, on SunOS 4.1.3 using gcc where termios.h +conflicts with sys/ioctl.h + */ + +#ifdef HAVE_TERMIOS +# include +#else +# include +#endif + +/* Sigh. On AIX 2.3, termios.h exists but does not define TIOCGWINSZ */ +/* Instead, it has to come from ioctl.h. However, As I said above, this */ +/* can't be cavalierly included on all machines, even when it exists. */ +#if defined(HAVE_TERMIOS) && !defined(HAVE_TIOCGWINSZ_IN_TERMIOS_H) +# include +#endif + +/* SCO defines window size structure in PTEM and TIOCGWINSZ in termio.h */ +/* Sigh... */ +#if defined(HAVE_SYS_PTEM_H) +# include /* for stream.h's caddr_t */ +# include /* for ptem.h's mblk_t */ +# include +#endif /* HAVE_SYS_PTEM_H */ + +#include "exp_tty.h" +#include "exp_win.h" + +#ifdef TIOCGWINSZ +typedef struct winsize exp_winsize; +#define columns ws_col +#define rows ws_row +#define EXP_WIN +#endif + +#if !defined(EXP_WIN) && defined(TIOCGSIZE) +typedef struct ttysize exp_winsize; +#define columns ts_cols +#define rows ts_lines +#define EXP_WIN +#endif + +#if !defined(EXP_WIN) +typedef struct { + int columns; + int rows; +} exp_winsize; +#endif + +static exp_winsize winsize = {0, 0}; +static exp_winsize win2size = {0, 0}; + +int exp_window_size_set(fd) +int fd; +{ +#ifdef TIOCSWINSZ + ioctl(fd,TIOCSWINSZ,&winsize); +#endif +#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ) + ioctl(fd,TIOCSSIZE,&winsize); +#endif +} + +int exp_window_size_get(fd) +int fd; +{ +#ifdef TIOCGWINSZ + ioctl(fd,TIOCGWINSZ,&winsize); +#endif +#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ) + ioctl(fd,TIOCGSIZE,&winsize); +#endif +#if !defined(EXP_WIN) + winsize.rows = 0; + winsize.columns = 0; +#endif +} + +void +exp_win_rows_set(rows) +char *rows; +{ + winsize.rows = atoi(rows); + exp_window_size_set(exp_dev_tty); +} + +void +exp_win_rows_get(rows) +char *rows; +{ + exp_window_size_get(exp_dev_tty); + sprintf(rows,"%d",winsize.rows); +} + +void +exp_win_columns_set(columns) +char *columns; +{ + winsize.columns = atoi(columns); + exp_window_size_set(exp_dev_tty); +} + +void +exp_win_columns_get(columns) +char *columns; +{ + exp_window_size_get(exp_dev_tty); + sprintf(columns,"%d",winsize.columns); +} + +/* + * separate copy of everything above - used for handling user stty requests + */ + +int exp_win2_size_set(fd) +int fd; +{ +#ifdef TIOCSWINSZ + ioctl(fd,TIOCSWINSZ,&win2size); +#endif +#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ) + ioctl(fd,TIOCSSIZE,&win2size); +#endif +} + +int exp_win2_size_get(fd) +int fd; +{ +#ifdef TIOCGWINSZ + ioctl(fd,TIOCGWINSZ,&win2size); +#endif +#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ) + ioctl(fd,TIOCGSIZE,&win2size); +#endif +} + +void +exp_win2_rows_set(fd,rows) +int fd; +char *rows; +{ + exp_win2_size_get(fd); + win2size.rows = atoi(rows); + exp_win2_size_set(fd); +} + +void +exp_win2_rows_get(fd,rows) +int fd; +char *rows; +{ + exp_win2_size_get(fd); + sprintf(rows,"%d",win2size.rows); +#if !defined(EXP_WIN) + win2size.rows = 0; + win2size.columns = 0; +#endif +} + +void +exp_win2_columns_set(fd,columns) +int fd; +char *columns; +{ + exp_win2_size_get(fd); + win2size.columns = atoi(columns); + exp_win2_size_set(fd); +} + +void +exp_win2_columns_get(fd,columns) +int fd; +char *columns; +{ + exp_win2_size_get(fd); + sprintf(columns,"%d",win2size.columns); +} ADDED generic/expect.c Index: generic/expect.c ================================================================== --- /dev/null +++ generic/expect.c @@ -0,0 +1,3209 @@ +/* ---------------------------------------------------------------------------- + * expect.c -- + * + * expect commands. + * + * ---------------------------------------------------------------------------- + * + * Written by: Don Libes, libes@cme.nist.gov, 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. + * + * Copyright (c) 1997 Mitel Corporation + * work by Gordon Chaffee for the WinNT port. + * + * Copyright (c) 2001-2002 Telindustrie, LLC + * work by David Gravereaux for any Win32 OS. + * + * ---------------------------------------------------------------------------- + * URLs: http://expect.nist.gov/ + * http://expect.sf.net/ + * http://bmrc.berkeley.edu/people/chaffee/expectnt.html + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: exp.h,v 1.1.4.4 2002/02/10 10:17:04 davygrvy Exp $ + * ---------------------------------------------------------------------------- + */ + +#include "expInt.h" + +#ifdef TCL_DEBUGGER +#include "Dbg.h" +#endif + +/* initial length of strings that we can guarantee patterns can match */ +int exp_default_match_max = 2000; +#define INIT_EXPECT_TIMEOUT_LIT "10" /* seconds */ +#define INIT_EXPECT_TIMEOUT 10 /* seconds */ +int exp_default_parity = TRUE; +int exp_default_rm_nulls = TRUE; + +/* user variable names */ +#define EXPECT_TIMEOUT "timeout" +#define EXPECT_OUT "expect_out" + +/* 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 */ +#define PAT_EOF 1 +#define PAT_TIMEOUT 2 +#define PAT_DEFAULT 3 +#define PAT_FULLBUFFER 4 +#define PAT_GLOB 5 /* glob-style pattern list */ +#define PAT_RE 6 /* regular expression */ +#define PAT_EXACT 7 /* exact string */ +#define PAT_NULL 8 /* ASCII 0 */ +#define PAT_TYPES 9 /* used to size array of pattern type descriptions */ + int use; /* PAT_XXX */ + int simple_start;/* offset 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? */ + Tcl_RegExp *re; /* if this is 0, then pattern match via glob */ +}; + +/* descriptions of the pattern types, used for debugging */ +char *pattern_style[PAT_TYPES]; + +struct exp_cases_descriptor { + int count; + struct ecase **cases; +}; + +/* This describes an Expect command */ +static +struct exp_cmd_descriptor { + int cmdtype; /* bg, before, after */ + int duration; /* permanent or temporary */ + int timeout_specified_by_flag; /* if -timeout flag used */ + int timeout; /* timeout period if flag used */ + struct exp_cases_descriptor ecd; + struct exp_i *i_list; +} exp_cmds[4]; +/* note that exp_cmds[FG] is just a fake, the real contents is stored + in some dynamically-allocated variable. We use exp_cmds[FG] mostly + as a well-known address and also as a convenience and so we allocate + just a few of its fields that we need. */ + +static void +exp_cmd_init(cmd,cmdtype,duration) + struct exp_cmd_descriptor *cmd; + int duration; + int cmdtype; +{ + cmd->duration = duration; + cmd->cmdtype = cmdtype; + cmd->ecd.cases = 0; + cmd->ecd.count = 0; + cmd->i_list = 0; +} + +static int i_read_errno;/* place to save errno, if i_read() == -1, so it + doesn't get overwritten before we get to read it */ + +void exp_background_filehandlers_run_all(); + +/* + * Declarations for local procedures defined in this file: + */ + +/*exp_indirect_updateX is called by Tcl when an indirect variable is set */ +static char * exp_indirect_update1 _ANSI_ARGS_((Tcl_Interp *interp, + struct exp_cmd_descriptor *ecmd, + struct exp_i *exp_i)); +static char * exp_indirect_update2 _ANSI_ARGS_(( + ClientData clientData, + Tcl_Interp *interp, char *name1, char *name2, + int flags)); /* 2-part Tcl variable names */ +static int exp_i_read _ANSI_ARGS_((Tcl_Interp *,struct exp_f *, + int,int)); + + +/* + *---------------------------------------------------------------------- + * + * rm_nulls -- + * + * Remove nulls from s. Initially, the number of chars in s is c, + * not strlen(s). This count does not include the trailing null. + * + * Results: + * 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 */ +} + +/* + *---------------------------------------------------------------------- + * + * free_ecases -- + * + * Free up any argv structures in the ecases + * + * Results: + * None + * + *---------------------------------------------------------------------- + */ + +static void +free_ecases(interp,eg,free_ilist) + Tcl_Interp *interp; + struct exp_cmd_descriptor *eg; + int free_ilist; /* if true, free ilists */ +{ + int i; + + if (!eg->ecd.cases) return; + + for (i=0;iecd.count;i++) { + free_ecase(interp,eg->ecd.cases[i],free_ilist); + } + ckfree((char *)eg->ecd.cases); + + eg->ecd.cases = 0; + eg->ecd.count = 0; +} + + +/* + *---------------------------------------------------------------------- + * + * save_str -- + * + * Make a copy of a string if necessary. In many places, there + * is no need to malloc a copy of a string, since it will be + * freed before we return to Tcl + * + * Results: + * String is set through lhs + * + * Side Effects: + * Memory may be allocated for a copy of the string + * + *---------------------------------------------------------------------- + */ + +static void +save_str(lhs,rhs,nosave) + char **lhs; /* left hand side */ + char *rhs; /* right hand side */ + int nosave; +{ + if (nosave || (rhs == 0)) { + *lhs = rhs; + } else { + *lhs = ckalloc(strlen(rhs) + 1); + strcpy(*lhs,rhs); + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_one_arg_braced -- + * + * The intent of this test is to support the ability of + * commands to have all their args braced as one. This + * conflicts with the possibility of actually intending + * to have a single argument. The bad case is in expect + * which can have a single argument with embedded \n's + * although it's rare. Examples that this code should handle: + * + * \n FALSE (pattern) + * \n\n FALSE + * \n \n \n FALSE + * foo FALSE + * foo\n FALSE + * \nfoo\n TRUE (set of args) + * \nfoo\nbar TRUE + * + * Current test is very cheap and almost always right :-) + * + * Results: + * TRUE if string appears to be a set of arguments + * + *---------------------------------------------------------------------- + */ +int +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)) { /* INTL: ISO space */ + return(seen_nl); + } + } + return FALSE; +} + +/* + *---------------------------------------------------------------------- + * + * exp_eval_with_one_arg -- + * + * 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 + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +/* 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,objv) /* INTL */ + ClientData clientData; + Tcl_Interp *interp; + 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++; + } + } + + /* + * Advance to the next command in the script. + */ + 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; +{ + 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 * +ecase_new() +{ + struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase)); + + ecase_clear(ec); + return ec; +} + +/* + *---------------------------------------------------------------------- + * + * parse_expect_args -- + * + * Parses the arguments to expect or its variants. It normally + * returns TCL_OK, and returns TCL_ERROR for failure. (It can't + * return i_list directly because there is no way to differentiate + * between clearing, say, expect_before and signalling an error.) + * + * eg (expect_global) is initialized to reflect the arguments parsed + * eg->ecd.cases is an array of ecases + * eg->ecd.count is the # of ecases + * eg->i_list is a linked list of exp_i's which represent the -i info + * + * Each exp_i is chained to the next so that they can be easily free'd + * if necessary. Each exp_i has a reference count. If the -i is not + * used (e.g., has no following patterns), the ref count will be 0. + * + * Each ecase points to an exp_i. Several ecases may point to the + * same exp_i. Variables named by indirect exp_i's are read for the + * direct values. + * + * If called from a foreground expect and no patterns or -i are given, + * a default exp_i is forced so that the command "expect" works right. + * + * The exp_i chain can be broken by the caller if desired. + * + * Results: + * A standard TCL result. + * + *---------------------------------------------------------------------- + */ + +static int +parse_expect_args(interp,eg,default_spawn_id,objc,objv) + Tcl_Interp *interp; + struct exp_cmd_descriptor *eg; + struct exp_f *default_spawn_id; /* suggested master 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,Tcl_GetString(objv[0])); + 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_spawn_id != NULL) { + eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration); + } else { + /* it'll be checked later, if used */ + default_spawn_id = exp_update_master(interp,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,Tcl_GetString(objv[i]),eg->duration == EXP_TEMPORARY); + save_str(&ec.body,Tcl_GetString(objv[i+1]),eg->duration == EXP_TEMPORARY); + + i++; + + *(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 != NULL) { + eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration); + } else { + /* it'll be checked later, if used */ + default_spawn_id = exp_update_master(interp,0,0); + eg->i_list = exp_new_i_simple(default_spawn_id,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); +} + + +#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 */ +}; + +/* + *---------------------------------------------------------------------- + * + * eval_case_string -- + * + * Like eval_cases, but handles only a single cases that needs a real + * string match + * + * Results: + * Returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCL_ERRROR + * + *---------------------------------------------------------------------- + */ +static int +eval_case_string(interp,e,f,o,last_f,last_case,suffix) + Tcl_Interp *interp; + struct ecase *e; + struct exp_f *f; + 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; + int *last_case; + char *suffix; +{ + char *buffer; + Tcl_RegExpInfo info; + + /* 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) { + exp_debuglog("\r\nexpect%s: does \"%s\" (spawn_id %s) match %s ", + suffix, dprintify(buffer),f->spawnId, pattern_style[e->use]); + *last_f = f; + *last_case = e->Case; + } + + if (e->use == PAT_RE) { + exp_debuglog("\"%s\"? ",dprintify(e->pat)); + //TclRegError((char *)0); + if (buffer && Tcl_RegExpExec(interp,*e->re,buffer,buffer)) { + o->e = e; + Tcl_RegExpGetInfo(*e->re, &info); + o->match = Tcl_UtfAtIndex(buffer, info.matches[0].end)-buffer; + o->buffer = buffer; + o->f = f; + exp_debuglog(yes); + return(EXP_MATCH); + } else { + exp_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 */ + + exp_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; + exp_debuglog(yes); + return(EXP_MATCH); + } else exp_debuglog(no); + } else if (e->use == PAT_EXACT) { + char *p = strstr(buffer,e->pat); + exp_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; + exp_debuglog(yes); + return(EXP_MATCH); + } else exp_debuglog(no); + } else if (e->use == PAT_NULL) { + int i = 0; + exp_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; + exp_debuglog(yes); + return EXP_MATCH; + } + } + exp_debuglog(no); + } else if ((f->size == f->msize) && (f->size > 0)) { + exp_debuglog("%s? ",e->pat); + o->e = e; + o->match = f->umsize; + o->buffer = f->buffer; + o->f = f; + exp_debuglog(yes); + return(EXP_FULLBUFFER); + } + return(EXP_NOMATCH); +} + +/* + *---------------------------------------------------------------------- + * + * eval_cases -- + * + * Sets o.e if successfully finds a matching pattern, eof, + * timeout or deflt. + * + * Results: + * Original status arg or EXP_TCLERROR + * + * Side Effects: + * + *---------------------------------------------------------------------- + */ +static int +eval_cases(interp,eg,f,o,last_f,last_case,status,masters,mcount,suffix) + Tcl_Interp *interp; + struct exp_cmd_descriptor *eg; + struct exp_f *f; + 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; + int *last_case; + int status; + struct exp_fs **masters; + int mcount; + char *suffix; +{ + int i; + struct exp_f *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_fs_list *fsl; + + for (fsl=e->i_list->fs_list; fsl ;fsl=fsl->next) { + em = fsl->f; + if (em == NULL || em == exp_f_any || em == f) { + 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_fs_list *fsl; + int j; + + e = eg->ecd.cases[i]; + if (e->use == PAT_TIMEOUT || + e->use == PAT_DEFAULT || + e->use == PAT_EOF) continue; + + for (fsl = e->i_list->fs_list; fsl; fsl = fsl->next) { + em = fsl->f; + /* if em == exp_f_any, then user is explicitly asking */ + /* every case to be checked against every master */ + if (em == NULL || em == exp_f_any) { + /* test against each spawn_id */ + for (j=0;jecd.count;) { + struct ecase *e = ecmd->ecd.cases[i]; + if (e->i_list == exp_i) { + free_ecase(interp,e,0); + + /* shift remaining elements down */ + /* but only if there are any left */ + if (i+1 != ecmd->ecd.count) { + memcpy(&ecmd->ecd.cases[i], + &ecmd->ecd.cases[i+1], + ((ecmd->ecd.count - i) - 1) * + sizeof(struct exp_cmd_descriptor *)); + } + ecmd->ecd.count--; + if (0 == ecmd->ecd.count) { + ckfree((char *)ecmd->ecd.cases); + ecmd->ecd.cases = 0; + } + } else { + i++; + } + } +} + +/* remove exp_i from list */ +static void +exp_i_remove(interp,ei,exp_i) + Tcl_Interp *interp; + struct exp_i **ei; /* list to remove from */ + struct exp_i *exp_i; /* element to remove */ +{ + /* since it's in middle of list, free exp_i by hand */ + for (;*ei; ei = &(*ei)->next) { + if (*ei == exp_i) { + *ei = exp_i->next; + exp_i->next = 0; + exp_free_i(interp,exp_i,exp_indirect_update2); + break; + } + } +} + +/* remove exp_i from list and remove any dependent ecases */ +static void +exp_i_remove_with_ecases(interp,ecmd,exp_i) + Tcl_Interp *interp; + struct exp_cmd_descriptor *ecmd; + struct exp_i *exp_i; +{ + ecases_remove_by_expi(interp,ecmd,exp_i); + exp_i_remove(interp,&ecmd->i_list,exp_i); +} + +/* remove ecases tied to a single direct spawn id */ +static void +ecmd_remove_f(interp,ecmd,f,direct) + Tcl_Interp *interp; + struct exp_cmd_descriptor *ecmd; + struct exp_f *f; + int direct; +{ + struct exp_i *exp_i, *next; + struct exp_fs_list **fsl; + + for (exp_i=ecmd->i_list;exp_i;exp_i=next) { + next = exp_i->next; + + if (!(direct & exp_i->direct)) continue; + + for (fsl = &exp_i->fs_list;*fsl;) { + if (f == ((*fsl)->f)) { + struct exp_fs_list *tmp = *fsl; + *fsl = (*fsl)->next; + exp_free_fs_single(tmp); + + /* if last bg ecase, disarm spawn id */ + if (ecmd->cmdtype == EXP_CMD_BG) { + f->bg_ecount--; + if (f->bg_ecount == 0) { + exp_disarm_background_filehandler(f); + f->bg_interp = 0; + } + } + + continue; + } + fsl = &(*fsl)->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->fs_list) { + exp_i_remove_with_ecases(interp,ecmd,exp_i); + } + } +} + +/* this is called from exp_close to clean up f */ +void +exp_ecmd_remove_f_direct_and_indirect(interp,f) + Tcl_Interp *interp; + struct exp_f *f; +{ + ecmd_remove_f(interp,&exp_cmds[EXP_CMD_BEFORE],f,EXP_DIRECT|EXP_INDIRECT); + ecmd_remove_f(interp,&exp_cmds[EXP_CMD_AFTER],f,EXP_DIRECT|EXP_INDIRECT); + ecmd_remove_f(interp,&exp_cmds[EXP_CMD_BG],f,EXP_DIRECT|EXP_INDIRECT); + + /* force it - explanation in exp_tk.c where this func is defined */ + exp_disarm_background_filehandler_force(f); +} + +/* arm a list of background f's */ +static void +fs_list_arm(interp,fsl) + Tcl_Interp *interp; + struct exp_fs_list *fsl; +{ + struct exp_f *f; + + /* for each spawn id in list, arm if necessary */ + for (;fsl;fsl=fsl->next) { + f = fsl->f; + if (f == NULL || f == exp_f_any) continue; + + if (f->bg_ecount == 0) { + exp_arm_background_filehandler(f); + f->bg_interp = interp; + } + f->bg_ecount++; + } +} + +/* return TRUE if this ecase is used by this f */ +static int +exp_i_uses_f(exp_i,f) + struct exp_i *exp_i; + struct exp_f *f; +{ + struct exp_fs_list *fsp; + + for (fsp = exp_i->fs_list;fsp;fsp=fsp->next) { + if (fsp->f == f) return 1; + } + return 0; +} + +static void +ecase_append(interp,ec) + 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"); + 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:""); +} + +/* append all ecases that match this exp_i */ +static void +ecase_by_exp_i_append(interp,ecmd,exp_i) + Tcl_Interp *interp; + struct exp_cmd_descriptor *ecmd; + struct exp_i *exp_i; +{ + int i; + for (i=0;iecd.count;i++) { + if (ecmd->ecd.cases[i]->i_list == exp_i) { + ecase_append(interp,ecmd->ecd.cases[i]); + } + } +} + +static void +exp_i_append(interp,exp_i) + Tcl_Interp *interp; + struct exp_i *exp_i; +{ + Tcl_AppendElement(interp,"-i"); + if (exp_i->direct == EXP_INDIRECT) { + Tcl_AppendElement(interp,exp_i->variable); + } else { + struct exp_fs_list *fsp; + + /* if more than one element, add braces */ + if (exp_i->fs_list->next) + Tcl_AppendResult(interp," {",(char *)0); + + for (fsp = exp_i->fs_list;fsp;fsp=fsp->next) { + char buf[10]; /* big enough for a small int */ + sprintf(buf,"%s",fsp->f->spawnId); + Tcl_AppendElement(interp,buf); + } + + if (exp_i->fs_list->next) + Tcl_AppendResult(interp,"} ",(char *)0); + } +} + +/* + *---------------------------------------------------------------------- + * + * expect_info -- + * + * Return current setting of the permanent expect_before/after/bg + * + * Results: + * A standard Tcl result + * + *---------------------------------------------------------------------- + */ + +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; + int all = FALSE; /* report on all fds */ + char *chanId = NULL; + struct exp_f *f; + char *argv0 = argv[0]; + + while (*argv) { + if (streq(argv[0],"-i") && argv[1]) { + chanId = 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 (chanId == NULL) { + f = exp_update_master(interp,0,0); + if (f == NULL) { + return(TCL_ERROR); + } + } else { + f = exp_chan2f(interp, chanId, 1, 0, argv0); + if (f == NULL) { + /* 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,chanId)) { + 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_f(exp_i,f)) 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, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + int result = TCL_OK; + struct exp_i *exp_i, **eip; + struct exp_fs_list *fsl; /* temp for interating over fs_list */ + struct exp_cmd_descriptor eg; + int count; + //char *argv0; + + 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 (fsl=exp_i->fs_list;fsl;fsl=fsl->next) { + struct exp_f *f = fsl->f; + + /* validate all input descriptors */ + if (f != exp_f_any) { + if (!exp_fcheck(interp,f,1,1,Tcl_GetString(objv[0]))) { + result = TCL_ERROR; + goto cleanup; + } + } + + /* remove spawn id from exp_i */ + ecmd_remove_f(interp,ecmd,f,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) { + fs_list_arm(interp,exp_i->fs_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); +} + +/* + *---------------------------------------------------------------------- + * + * exp_adjust -- + * + * Adjusts file according to user's size request + * + * Results: + * None + * + * Side Effects: + * Memory may be allocated or reallocated + * + *---------------------------------------------------------------------- + */ + +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'; + } +} + +/* + *---------------------------------------------------------------------- + * + * 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). + * + * + * Results: + * 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 + * + * Side Effects + * + *---------------------------------------------------------------------- + */ + +int +expect_read(interp,masters,masters_max,m,timeout,key) + Tcl_Interp *interp; + struct exp_f **masters; /* If NULL, 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. */ + struct exp_f **m; /* Out variable to leave new master. */ + 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 = *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 = *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 (exp_logfile_all || (exp_loguser && exp_logfile)) { + Tcl_Write(exp_logfile, f->buffer + f->printed, write_count); + } + /* + * don't write to user if they're seeing it already, + * that is, typing it! + */ + if (exp_loguser) { + if (strcmp("stdin", (*m)->spawnId) != 0) { + Tcl_Write(Tcl_GetStdChannel(TCL_STDOUT), + f->buffer + f->printed, write_count); + } + } + if (exp_debugfile) { + Tcl_Write(exp_debugfile, f->buffer + f->printed, write_count); + } + + /* 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); +} + +/* 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) + Tcl_Interp *interp; + struct exp_f *f; + 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,"%s",f->spawnId); + exp_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; + + exp_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; +} + +/* map EXP_ style return value to TCL_ style return value */ +/* not defined to work on TCL_OK */ +int +exp_tcl2_returnvalue(x) + int x; +{ + switch (x) { + case TCL_ERROR: return EXP_TCLERROR; + case TCL_RETURN: return EXP_TCLRET; + case TCL_BREAK: return EXP_TCLBRK; + case TCL_CONTINUE: return EXP_TCLCNT; + case EXP_CONTINUE: return EXP_TCLCNTEXP; + case EXP_CONTINUE_TIMER: return EXP_TCLCNTTIMER; + case EXP_TCL_RETURN: return EXP_TCLRETTCL; + } + return -1; +} + +/* map from EXP_ style return value to TCL_ style return values */ +int +exp_2tcl_returnvalue(x) + int x; +{ + switch (x) { + case EXP_TCLERROR: return TCL_ERROR; + case EXP_TCLRET: return TCL_RETURN; + case EXP_TCLBRK: return TCL_BREAK; + case EXP_TCLCNT: return TCL_CONTINUE; + case EXP_TCLCNTEXP: return EXP_CONTINUE; + case EXP_TCLCNTTIMER: return EXP_CONTINUE_TIMER; + case EXP_TCLRETTCL: return EXP_TCL_RETURN; + } + return -1; +} + +/* + *---------------------------------------------------------------------- + * + * exp_i_read -- + * + * Reads from the input channel. Returns # of chars read or + * (non-positive) error of form EXP_XXX. + * Results: + * returns 0 for end of file + * If timeout is non-zero, assume the read will complete immediately + * because data is known to be available. + * + * Side Effects: + * Data is read from a channel + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static int +exp_i_read(interp,f,timeout,save_flags) + Tcl_Interp *interp; + struct exp_f *f; + int timeout; + int save_flags; +{ + int nread; + + if (f->size == f->msize) + exp_buffer_shuffle(interp,f,save_flags,EXPECT_OUT,"expect"); + + nread = Tcl_Read(f->channel, f->buffer+f->size, f->msize-f->size); + if (nread == -1) { + i_read_errno = errno; + } else { + /* {DWORD x; f->buffer[f->size] = 0; WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), f->buffer+f->size, nread, &x, NULL); printf("exp_i_read: Got %d bytes\n", nread);} */ + nread = nread; + } + + return(nread); +} + +/* + *---------------------------------------------------------------------- + * + * exp_get_var -- + * + * 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. + * + * Results: + * The value of the variable if it exists + * + *---------------------------------------------------------------------- + */ + +CONST char * +exp_get_var(interp,var) + Tcl_Interp *interp; + char *var; +{ + CONST char *val; + + if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */))) + return(val); + return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY)); +} + +/* + *---------------------------------------------------------------------- + * + * get_timeout -- + * + * Gets the value of the 'timeout' variable + * + * Results: + * The value of the variable if it exists + * + *---------------------------------------------------------------------- + */ + +static int +get_timeout(interp) + Tcl_Interp *interp; +{ + static int timeout = INIT_EXPECT_TIMEOUT; + CONST char *t; + + if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) { + timeout = atoi(t); + } + return(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) + struct exp_i *i_list; + struct exp_fs_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_fs_list *fsl; + + /* for each fd in the i_list */ + for (fsl=p->fs_list;fsl;fsl=fsl->next) { + struct exp_fs_list *tmpfsl; + struct exp_fs_list *u; + + if (fsl->f == exp_f_any || fsl->f == NULL) continue; + + /* check this one against all so far */ + for (u = *fd_union;u;u=u->next) { + if (fsl->f == u->f) goto found; + } + /* if not found, link in as head of list */ + tmpfsl = exp_new_fs(fsl->f); + tmpfsl->next = *fd_union; + *fd_union = tmpfsl; + found:; + } + } + return TCL_OK; +} + +char * +exp_cmdtype_printable(cmdtype) + int cmdtype; +{ + switch (cmdtype) { + case EXP_CMD_FG: return("expect"); + case EXP_CMD_BG: return("expect_background"); + case EXP_CMD_BEFORE: return("expect_before"); + case EXP_CMD_AFTER: return("expect_after"); + } +//#ifdef LINT + return("unknown expect command"); +//#endif +} + +/* + *---------------------------------------------------------------------- + * + * exp_indirect_update2 -- + * + * This is called back via Tcl's trace handler whenever + * an indirect spawn id list is changed + * + * Results: + * A string + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +static char * +exp_indirect_update2(clientData, interp, name1, name2, flags) + ClientData clientData; + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ +{ + char *msg; + + struct exp_i *exp_i = (struct exp_i *)clientData; + exp_configure_count++; + msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i); + + exp_background_filehandlers_run_all(); + + return msg; +} + +/* + *---------------------------------------------------------------------- + * + * exp_indirect_update1 -- + * + * Get the updated value of a variable + * + * Results: + * A string + * + *---------------------------------------------------------------------- + */ + +static char * +exp_indirect_update1(interp,ecmd,exp_i) + Tcl_Interp *interp; + struct exp_cmd_descriptor *ecmd; + struct exp_i *exp_i; +{ + struct exp_fs_list *fsl; /* temp for interating over fs_list */ + + /* + * disarm any fd's that lose all their ecases + */ + + if (ecmd->cmdtype == EXP_CMD_BG) { + /* clean up each spawn id used by this exp_i */ + for (fsl=exp_i->fs_list;fsl;fsl=fsl->next) { + struct exp_f *f = fsl->f; + + if (f == NULL || f == exp_f_any) 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_fcheck(interp, f, 1, 0, "")) continue; + + f->bg_ecount--; + if (f->bg_ecount == 0) { + exp_disarm_background_filehandler(f); + f->bg_interp = 0; + } + } + } + + /* + * reread indirect variable + */ + + exp_i_update(interp,exp_i); + + /* + * check validity of all fd's in variable + */ + + for (fsl=exp_i->fs_list;fsl;fsl=fsl->next) { + /* validate all input descriptors */ + if (fsl->f == NULL || fsl->f == exp_f_any) continue; + + if (!exp_fcheck(interp,fsl->f,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) { + fs_list_arm(interp,exp_i->fs_list); + } + + return (char *)0; +} + +/* + *---------------------------------------------------------------------- + * + * exp_background_filehandlers_run_all -- + * + * See which channels need to be checked for events and + * start up an event handler + * + * Results: + * None + * + * Side Effects: + * Event handlers are put in place + * + *---------------------------------------------------------------------- + */ + +void +exp_background_filehandlers_run_all() +{ + struct exp_f *f; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + hPtr = Tcl_FirstHashEntry(exp_f_table, &search); + while (hPtr) { + f = (struct exp_f *) Tcl_GetHashValue(hPtr); + + /* kick off any that already have input waiting */ + 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, 0 /*ignored*/); + } + hPtr = Tcl_NextHashEntry(&search); + } +} + +/* + *---------------------------------------------------------------------- + * + * exp_background_filehandler -- + * + * This function is called from the background when input arrives + * + * Results: + * None + * + * Side Effects: + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +void +exp_background_filehandler(clientData,mask) + ClientData clientData; + int mask; +{ + Tcl_Interp *interp; + int cc; /* number of chars 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 + * to print out better debugging messages */ + int last_case; /* as above but for case */ + + /* restore our environment */ + f = (struct exp_f *) clientData; + interp = f->bg_interp; + + /* temporarily prevent this handler from being invoked again */ + exp_block_background_filehandler(f); + + /* + * 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,NULL,mask,&f,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 = NULL; + + 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], + f,&eo,&last_f,&last_case,cc,&f,1,"_background"); + cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG], + f,&eo,&last_f,&last_case,cc,&f,1,"_background"); + cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], + f,&eo,&last_f,&last_case,cc,&f,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 = f; + eo.match = eo.f->size; + eo.buffer = eo.f->buffer; + exp_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; + } + + matched: +#define out(i,val) exp_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; + } + } 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) { + Tcl_RegExpInfo info; + Tcl_RegExpGetInfo(*e->re, &info); + + for (i=0;iindices) { + /* 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(Tcl_NewStringObj(buffer,-1), start, end); + out(name,Tcl_GetString(val)); + } + } 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) { + exp_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 */ + + sprintf(spawn_id,"%s",f->spawnId); + 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); + } + + } + + 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 (f->valid && (f->bg_status == blocked) + && (f->size > 0)) { + cc = f->size; + goto do_more_data; + } + } + finish: + /* fd could have gone away, so check before using */ + if (f->valid) + exp_unblock_background_filehandler(f); +} +#undef out + +/* + *---------------------------------------------------------------------- + * + * Exp_ExpectCmd -- + * + * Implements the 'expect', 'expect_user', and 'expect_tty' + * commands. + * + * Results: + * A standard Tcl result + * + * Side Effects: + * Input is likely to be read + * + * Notes: + * If non-null, clientData holds the name of the channel to + * use. + * + *---------------------------------------------------------------------- + */ + +/*ARGSUSED*/ +int +Exp_ExpectCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; /* Argument objects. */ +{ + int cc; /* number of chars returned in a single read + * or negative EXP_whatever */ + struct exp_f *f; /* file associated with master */ + + int i; /* trusty temporary */ + struct exp_cmd_descriptor eg; + struct exp_fs_list *fs_list; /* list of masters to watch */ + struct exp_fs_list *fsl; /* temp for interating over fs_list */ + struct exp_f **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 + * 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 ((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; + + /* make arg list for processing cases */ + /* do it dynamically, since expect can be called recursively */ + + exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY); + fs_list = NULL; + masters = NULL; + if (clientData) { + f = exp_chan2f(interp,(char *) clientData,1,0,Tcl_GetString(objv[0])); + if (f == NULL) { + return TCL_ERROR; + } + } else { + f = NULL; + } + if (TCL_ERROR == parse_expect_args(interp,&eg,f,objc,objv,Tcl_GetString(objv[0]))) + 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,&fs_list)) + || (TCL_ERROR == update_expect_fds(exp_cmds[EXP_CMD_AFTER].i_list, &fs_list)) + || (TCL_ERROR == update_expect_fds(eg.i_list,&fs_list))) { + result = TCL_ERROR; + goto cleanup; + } + + /* declare ourselves "in sync" with external view of close/indirect */ + configure_count = exp_configure_count; + + /* count and validate fs_list */ + mcount = 0; + for (fsl=fs_list;fsl;fsl=fsl->next) { + mcount++; + /* validate all input descriptors */ + if (!exp_fcheck(interp,fsl->f,1,1,Tcl_GetString(objv[0]))) { + result = TCL_ERROR; + goto cleanup; + } + } + + /* make into an array */ + masters = (struct exp_f **)ckalloc(mcount * sizeof(struct exp_f *)); + for (fsl=fs_list,i=0;fsl;fsl=fsl->next,i++) { + masters[i] = fsl->f; + } + + 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,&f,remtime,key); + } + + /*SUPPRESS 530*/ + if (cc == EXP_EOF) { + /* do nothing */ + } else if (cc == EXP_TIMEOUT) { + exp_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 */ + /* 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], + f,&eo,&last_f,&last_case,cc,masters,mcount,""); + cc = eval_cases(interp,&eg, + f,&eo,&last_f,&last_case,cc,masters,mcount,""); + cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER], + f,&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 = f; + eo.match = eo.f->size; + eo.buffer = eo.f->buffer; + exp_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; + + error: + result = exp_2tcl_returnvalue(cc); + done: +#define out(i,val) exp_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) { + Tcl_RegExpInfo info; + Tcl_RegExpGetInfo(*e->re, &info); + + for (i=0;iindices) { + /* 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(Tcl_NewStringObj(buffer,-1), start, end); + out(name,Tcl_GetString(val)); + } + } 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) { + exp_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,"%s",f->spawnId); + 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); + } + + } + + if (body) { + result = Tcl_Eval(interp,body); + + if (eof_body) ckfree(eof_body); + } + } + + cleanup: + if (result == EXP_CONTINUE_TIMER) { + reset_timer = FALSE; + result = EXP_CONTINUE; + } + + if ((result == EXP_CONTINUE) + && (configure_count == exp_configure_count)) { + exp_debuglog("expect: continuing expect\r\n"); + goto restart; + } + + if (fs_list) { + exp_free_fs(fs_list); + fs_list = 0; + } + if (masters) { + ckfree((char *)masters); + masters = 0; + } + + if (result == EXP_CONTINUE) { + exp_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 */ + +/*ARGSUSED*/ +static int +Exp_TimestampCmd(clientData, interp, argc, argv) +ClientData clientData; +Tcl_Interp *interp; +int argc; +char **argv; +{ + char *format = 0; + time_t seconds = -1; + int gmt = FALSE; /* local time by default */ + struct tm *tm; + Tcl_DString dstring; + + argc--; argv++; + + while (*argv) { + if (streq(*argv,"-format")) { + argc--; argv++; + if (!*argv) goto usage_error; + format = *argv; + argc--; argv++; + } else if (streq(*argv,"-seconds")) { + argc--; argv++; + if (!*argv) goto usage_error; + seconds = atoi(*argv); + argc--; argv++; + } else if (streq(*argv,"-gmt")) { + gmt = TRUE; + argc--; argv++; + } else break; + } + + if (argc) goto usage_error; + + if (seconds == -1) { + time(&seconds); + } + + Tcl_DStringInit(&dstring); + + if (format) { + if (gmt) { + tm = gmtime(&seconds); + } else { + tm = localtime(&seconds); + } +/* exp_strftime(interp->result,TCL_RESULT_SIZE,format,tm);*/ + exp_strftime(format,tm,&dstring); + Tcl_DStringResult(interp,&dstring); + } else { + sprintf(interp->result,"%ld",seconds); + } + + return TCL_OK; + usage_error: + 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; + CONST 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; + struct exp_f *f; + int Default = FALSE; + char *chan = NULL; + + 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); + } + chan = *argv; + } else break; + } + + if (!Default) { + if (chan == NULL) { + if (!(f = exp_update_master(interp,0,0))) + return(TCL_ERROR); + } else { + if (!(f = exp_chan2f(interp,chan,0,0,"match_max"))) + return(TCL_ERROR); + } + } else if (chan != NULL) { + 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); +} + +/*ARGSUSED*/ +int +Exp_RemoveNullsCmd(clientData,interp,argc,argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + int value = -1; + struct exp_f *f; + int Default = FALSE; + char *chan = NULL; + + 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); + } + chan = *argv; + } else break; + } + + if (!Default) { + if (chan == NULL) { + if (!(f = exp_update_master(interp,0,0))) + return(TCL_ERROR); + } else { + if (!(f = exp_chan2f(interp,chan,0,0,"remove_nulls"))) + return(TCL_ERROR); + } + } else if (chan != NULL) { + 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); +} + +/*ARGSUSED*/ +int +Exp_ParityCmd(clientData,interp,argc,argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + int parity; + int m = -1; + struct exp_f *f; + int Default = FALSE; + char *chan = NULL; + + 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); + } + chan = *argv; + } else break; + } + + if (!Default) { + if (chan == NULL) { + if (!(f = exp_update_master(interp,0,0))) + return(TCL_ERROR); + } else { + if (!(f = exp_chan2f(interp,chan,0,0,"parity"))) + return(TCL_ERROR); + } + } else if (chan != NULL) { + 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); +} + +#if DEBUG_PERM_ECASES +/* This big chunk of code is just for debugging the permanent */ +/* expect cases */ +void +exp_fd_print(fsl) + struct exp_fs_list *fsl; +{ + if (!fsl) return; + printf("%s ",fsl->spawnId); + exp_fd_print(fsl->next); +} + +void +exp_i_print(exp_i) + struct exp_i *exp_i; +{ + if (!exp_i) return; + printf("exp_i %x",exp_i); + printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect"); + printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp"); + printf(" ecount = %d\n",exp_i->ecount); + printf("variable %s, value %s\n", + ((exp_i->variable)?exp_i->variable:"--"), + ((exp_i->value)?exp_i->value:"--")); + printf("fds: "); + exp_fd_print(exp_i->fs_list); printf("\n"); + exp_i_print(exp_i->next); +} + +void +exp_ecase_print(ecase) + struct ecase *ecase; +{ + printf("pat <%s>\n",ecase->pat); + printf("exp_i = %x\n",ecase->i_list); +} + +void +exp_ecases_print(ecd) + struct exp_cases_descriptor *ecd; +{ + int i; + + printf("%d cases\n",ecd->count); + for (i=0;icount;i++) exp_ecase_print(ecd->cases[i]); +} + +void +exp_cmd_print(ecmd) + struct exp_cmd_descriptor *ecmd; +{ + printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype)); + printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp "); + /* printdict */ + exp_ecases_print(&ecmd->ecd); + exp_i_print(ecmd->i_list); +} + +void +exp_cmds_print() +{ + exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]); + exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]); + exp_cmd_print(&exp_cmds[EXP_CMD_BG]); +} + +/*ARGSUSED*/ +int +cmdX(clientData, interp, argc, argv) + ClientData clientData; + Tcl_Interp *interp; + int argc; + char **argv; +{ + exp_cmds_print(); + return TCL_OK; +} +#endif /*DEBUG_PERM_ECASES*/ + +static struct exp_cmd_data +cmd_data[] = { + {"expect", Exp_ExpectCmd, 0, (ClientData) NULL, 0}, + {"expect_after",Exp_ExpectGlobalCmd, 0, (ClientData)&exp_cmds[EXP_CMD_AFTER],0}, + {"expect_before",Exp_ExpectGlobalCmd, 0, (ClientData)&exp_cmds[EXP_CMD_BEFORE],0}, + {"expect_user", Exp_ExpectCmd, 0, (ClientData)"exp_user", 0}, + {"expect_tty", Exp_ExpectCmd, 0, (ClientData)"exp_tty", 0}, + {"expect_background",Exp_ExpectGlobalCmd, 0, (ClientData)&exp_cmds[EXP_CMD_BG],0}, + {"match_max", 0, Exp_MatchMaxCmd, 0, 0}, + {"remove_nulls",0, Exp_RemoveNullsCmd, 0, 0}, + {"parity", 0, Exp_ParityCmd, 0, 0}, + {"timestamp", 0, Exp_TimestampCmd, 0, 0}, + {0} +}; + +/* + *---------------------------------------------------------------------- + * + * exp_init_expect_cmds -- + * + * Initialize all the 'expect' type commands. + * + * Results: + * None + * + * Side Effects: + * Commands are added to and variables are set in the interpreter. + * + *---------------------------------------------------------------------- + */ + +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,0); + + exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT); + exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT); + exp_cmd_init(&exp_cmds[EXP_CMD_BG ],EXP_CMD_BG, EXP_PERMANENT); + exp_cmd_init(&exp_cmds[EXP_CMD_FG ],EXP_CMD_FG, EXP_TEMPORARY); + + /* preallocate to one element, so future realloc's work */ + exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0; + exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0; + exp_cmds[EXP_CMD_BG ].ecd.cases = 0; + + pattern_style[PAT_EOF] = "eof"; + pattern_style[PAT_TIMEOUT] = "timeout"; + pattern_style[PAT_DEFAULT] = "default"; + pattern_style[PAT_FULLBUFFER] = "full buffer"; + pattern_style[PAT_GLOB] = "glob pattern"; + pattern_style[PAT_RE] = "regular expression"; + pattern_style[PAT_EXACT] = "exact string"; + pattern_style[PAT_NULL] = "null"; +} + +void +exp_init_sig() { +} ADDED generic/getopt.c Index: generic/getopt.c ================================================================== --- /dev/null +++ generic/getopt.c @@ -0,0 +1,54 @@ +/* got this off net.sources */ +#include +#include + +/* + * get option letter from argument vector + */ +int opterr = 1, /* useless, never set or used */ + optind = 1, /* index into parent argv vector */ + optopt; /* character checked for validity */ +char *optarg; /* argument associated with option */ + +#define BADCH (int)'?' +#define EMSG "" +#define errmsg(s) fputs(*argv,stderr);fputs(s,stderr); \ + fputc(optopt,stderr);fputc('\n',stderr);return(BADCH); + +int +getopt(argc,argv,ostr) +int argc; +char **argv, + *ostr; +{ + static char *place = EMSG; /* option letter processing */ + register char *oli; /* option letter list index */ + char *index(); + + if(!*place) { /* update scanning pointer */ + if(optind >= argc || *(place = argv[optind]) != '-' || !*++place) return(EOF); + if (*place == '-') { /* found "--" */ + ++optind; + return(EOF); + } + } /* option letter okay? */ + if ((optopt = (int)*place++) == (int)':' || !(oli = strchr(ostr,optopt))) { + if(!*place) ++optind; + errmsg(": illegal option -- "); + } + if (*++oli != ':') { /* don't need argument */ + optarg = NULL; + if (!*place) ++optind; + } + else { /* need an argument */ + if (*place) optarg = place; /* no white space */ + else if (argc <= ++optind) { /* no arg */ + place = EMSG; + errmsg(": option requires an argument -- "); + } + else optarg = argv[optind]; /* white space */ + place = EMSG; + ++optind; + } + return(optopt); /* dump back option letter */ +} DELETED libexpect.man Index: libexpect.man ================================================================== --- libexpect.man +++ /dev/null @@ -1,690 +0,0 @@ -.TH LIBEXPECT 3 "12 December 1991" -.SH NAME -libexpect \- programmed dialogue with interactive programs \- C functions -.SH DESCRIPTION -This library contains functions that allow Expect to be used as -a Tcl extension or to be used directly from C or C++ (without Tcl). -Adding Expect as a Tcl extension is very short and simple, so that will be -covered first. -.SH SYNOPSIS -.nf - -.B #include "expect_tcl.h" -.B Expect_Init(interp); - -.B cc files... \-lexpect5.20 \-ltcl7.5 \-lm - -.fi -Note: library versions may differ in the actual release. - -The Expect_Init function adds expect commands to the named -interpreter. It avoids overwriting commands that already exist, -however aliases beginning with "exp_" are always created for expect -commands. So for example, "send" can be used as "exp_send". - -Generally, you should only call Expect commands via Tcl_Eval. -Certain auxiliary functions may be called directly. They are summarized -below. They may be useful in constructing your own main. Look -at the file exp_main_exp.c in the Expect distribution as -a prototype main. Another prototype is tclAppInit.c in the -Tcl source distribution. A prototype for working with Tk is in -exp_main_tk.c in the Expect distribution. -.nf - -int exp_cmdlinecmds; -int exp_interactive; -FILE *exp_cmdfile; -char *exp_cmdfilename; -int exp_tcl_debugger_available; - -void exp_parse_argv(Tcl_Interp *,int argc,char **argv); -int exp_interpreter(Tcl_Interp *); -void exp_interpret_cmdfile(Tcl_Interp *,FILE *); -void exp_interpret_cmdfilename(Tcl_Interp *,char *); -void exp_interpret_rcfiles(Tcl_Interp *,int my_rc,int sys_rc); -char * exp_cook(char *s,int *len); -void (*exp_app_exit)EXP_PROTO((Tcl_Interp *); -void exp_exit(Tcl_Interp *,int status); -void exp_exit_handlers(Tcl_Interp *); -void exp_error(Tcl_Interp,char *,...); - -.fi -.B exp_cmdlinecmds -is 1 if Expect has been invoked with commands on the program command-line (using "-c" for example). -.B exp_interactive -is 1 if Expect has been invoked with the -i flag or if no commands or script is being invoked. -.B exp_cmdfile -is a stream from which Expect will read commands. -.B exp_cmdfilename -is the name of a file which Expect will open and read commands from. -.B exp_tcl_debugger_available -is 1 if the debugger has been armed. - -.B exp_parse_argv -reads the representation of the command line. -Based on what is found, any of the other variables listed here -are initialized appropriately. -.B exp_interpreter -interactively prompts the user for commands and evaluates them. -.B exp_interpret_cmdfile -reads the given stream and evaluates any commands found. -.B exp_interpret_cmdfilename -opens the named file and evaluates any commands found. -.B exp_interpret_rcfiles -reads and evalutes the .rc files. If my_rc is zero, -then ~/.expectrc is skipped. If sys_rc is zero, then the system-wide -expectrc file is skipped. -.B exp_cook -returns a static buffer containing the argument reproduced with -newlines replaced by carriage-return linefeed sequences. -The primary purpose of this is to allow messages to be produced -without worrying about whether the terminal is in raw mode or -cooked mode. -If length is zero, it is computed via strlen. -.B exp_error is a printf-like function that writes the result -to interp->result. -.SH SYNOPSIS -.nf -.B #include - -.B int -.B "exp_spawnl(file, arg0 [, arg1, ..., argn] (char *)0);" -.B char *file; -.B char *arg0, *arg1, ... *argn; - -.B int -.B exp_spawnv(file,argv); -.B char *file, *argv[ ]; - -.B int -.B exp_spawnfd(fd); -.B int fd; - -.B FILE * -.B exp_popen(command); -.B char *command; - -.B extern int exp_pid; -.B extern int exp_ttyinit; -.B extern int exp_ttycopy; -.B extern int exp_console; -.B extern char *exp_stty_init; -.B extern void (*exp_close_in_child)(); -.B extern void (*exp_child_exec_prelude)(); -.B extern void exp_close_tcl_files(); - -.B cc files... \-lexpect \-ltcl \-lm -.fi - -.SH DESCRIPTION -.B exp_spawnl -and -.B exp_spawnv -fork a new process so that its stdin, -stdout, and stderr can be written and read by the current process. -.I file -is the name of a file to be executed. The -.I arg -pointers are -null-terminated strings. Following the style of execve(), -.I arg0 -(or -.IR argv[0] ) -is customarily a duplicate of the name of the file. -.PP -Four interfaces are available, -.B exp_spawnl -is useful when the number of -arguments is known at compile time. -.B exp_spawnv -is useful when the number of arguments is not known at compile time. -.B exp_spawnfd -is useful when an open file descriptor is already available as a source. -.B exp_popen -is explained later on. -.PP -If the process is successfully created, a file descriptor is returned -which corresponds to the process's stdin, stdout and stderr. -A stream may be associated with the file descriptor by using fdopen(). -(This should almost certainly be followed by setbuf() to unbuffer the I/O.) -.PP -Closing the file descriptor will typically be detected by the -process as an EOF. Once such a process exits, it should be waited -upon (via wait) in order to free up the kernel process slot. (Some systems -allow you to avoid this if you ignore the SIGCHLD signal). -.PP -.B exp_popen -is yet another interface, styled after popen(). It takes a Bourne -shell command line, and returns a stream that corresponds to the process's -stdin, stdout and stderr. The actual implementation of -.B exp_popen -below demonstrates -.BR exp_spawnl . -.nf - -FILE * -exp_popen(program) -char *program; -{ - FILE *fp; - int ec; - - if (0 > (ec = exp_spawnl("sh","sh","-c",program,(char *)0))) - return(0); - if (NULL == (fp = fdopen(ec,"r+")) return(0); - setbuf(fp,(char *)0); - return(fp); -} -.fi - -After a process is started, the variable -.B exp_pid -is set to the process-id of the new process. The variable -.B exp_pty_slave_name -is set to the name of the slave side of the pty. - -The spawn functions uses a pty to communicate with the process. By -default, the pty is initialized the same way as the user's tty (if -possible, i.e., if the environment has a controlling terminal.) This -initialization can be skipped by setting exp_ttycopy to 0. - -The pty is further initialized to some system wide defaults if -exp_ttyinit is non-zero. The default is generally comparable to "stty sane". - -The tty setting can be further modified by setting the variable -.BR exp_stty_init . -This variable is interpreted in the style of stty arguments. For -example, exp_stty_init = "sane"; repeats the default initialization. - -On some systems, it is possible to redirect console output to ptys. -If this is supported, you can force the next spawn to obtain the -console output by setting the variable -.B exp_console -to 1. - -Between the time a process is started and the new program is given -control, the spawn functions can clean up the environment by closing -file descriptors. By default, the only file descriptors closed are -ones internal to Expect and any marked "close-on-exec". - -If needed, you can close additional file descriptors by creating -an appropriate function and assigning it to exp_close_in_child. -The function will be called after the fork and before the exec. -(This also modifies the behavior of the spawn command in Expect.) - -If you are also using Tcl, it may be convenient to use the function -exp_close_tcl_files which closes all files between the default -standard file descriptors and the highest descriptor known to Tcl. -(Expect does this.) - -The function exp_child_exec_prelude is the last function called prior -to the actual exec in the child. You can redefine this for effects -such as manipulating the uid or the signals. - -.SH "IF YOU WANT TO ALLOCATE YOUR OWN PTY" -.nf - -.B extern int exp_autoallocpty; -.B extern int exp_pty[2]; -.fi - -The spawn functions use a pty to communicate with the process. By -default, a pty is automatically allocated each time a process is spawned. -If you want to allocate ptys yourself, before calling one of the spawn -functions, set -.B exp_autoallocpty -to 0, -.B exp_pty[0] -to the master pty file descriptor and -.B exp_pty[1] -to the slave pty file descriptor. -The expect library will not do any pty initializations (e.g., exp_stty_init will not be used). -The slave pty file descriptor will be -automatically closed when the process is spawned. After the process is -started, all further communication takes place with the master pty file -descriptor. -.PP -.B exp_spawnl -and -.B exp_spawnv -duplicate the shell's actions -in searching for an executable file in a list of directories. The -directory list is obtained from the environment. -.SH EXPECT PROCESSING -While it is possible to use read() to read information from a process -spawned by -.B exp_spawnl -or -.BR exp_spawnv , -more convenient functions are provided. They are as -follows: -.nf - -.B int -.B exp_expectl(fd,type1,pattern1,[re1,],value1,type2,...,exp_end); -.B int fd; -.B enum exp_type type; -.B char *pattern1, *pattern2, ...; -.B regexp *re1, *re2, ...; -.B int value1, value2, ...; -.B - -.B int -.B exp_fexpectl(fp,type1,pattern1,[re1,]value1,type2,...,exp_end); -.B FILE *fp; -.B enum exp_type type; -.B char *pattern1, *pattern2, ...; -.B regexp *re1, *re2, ...; -.B int value1, value2, ...; - -.B enum exp_type { -.B exp_end, -.B exp_glob, -.B exp_exact, -.B exp_regexp, -.B exp_compiled, -.B exp_null, -.B }; - -.B struct exp_case { -.B char *pattern; -.B regexp *re; -.B enum exp_type type; -.B int value; -.B }; - -.B int -.B exp_expectv(fd,cases); -.B int fd; -.B struct exp_case *cases; - -.B int -.B exp_fexpectv(fp,cases); -.B FILE *fp; -.B struct exp_case *cases; - -.B extern int exp_timeout; -.B extern char *exp_match; -.B extern char *exp_match_end; -.B extern char *exp_buffer; -.B extern char *exp_buffer_end; -.B extern int exp_match_max; -.B extern int exp_full_buffer; -.B extern int exp_remove_nulls; -.fi - -The functions wait until the output from a process matches one of the -patterns, a specified time period has passed, or an EOF is seen. -.PP -The first argument to each function is either a file descriptor or a stream. -Successive sets of arguments describe patterns and associated integer values -to return when the pattern matches. -.PP -The type argument is one of four values. exp_end indicates that no more -patterns appear. -exp_glob indicates that the pattern is a glob-style string pattern. -exp_exact indicates that the pattern is an exact string. -exp_regexp indicates that the pattern is a regexp-style string pattern. -exp_compiled indicates that the pattern is a regexp-style string pattern, -and that its compiled form is also provided. -exp_null indicates that the pattern is a null (for debugging purposes, -a string pattern must also follow). -.PP -If the compiled form is not provided with the functions -.B exp_expectl -and -.BR exp_fexpectl , -any pattern compilation done internally is -thrown away after the function returns. The functions -.B exp_expectv -and -.B exp_fexpectv -will automatically compile patterns and will not throw them away. -Instead, they must be discarded by the user, by calling free on each -pattern. It is only necessary to discard them, the last time the -cases are used. -.PP -Regexp subpatterns matched are stored in the compiled regexp. -Assuming "re" contains a compiled regexp, the matched string can be -found in re->startp[0]. The match substrings (according to the parentheses) -in the original pattern can be found in re->startp[1], re->startp[2], and -so on, up to re->startp[9]. The corresponding strings ends are re->endp[x] -where x is that same index as for the string start. - -The type exp_null matches if a null appears in the input. The -variable exp_remove_nulls must be set to 0 to prevent nulls from -being automatically stripped. By default, exp_remove_nulls is set -to 1 and nulls are automatically stripped. - -.B exp_expectv -and -.B exp_fexpectv -are useful when the number of patterns is -not known in advance. In this case, the sets are provided in an array. -The end of the array is denoted by a struct exp_case with type exp_end. -For the rest -of this discussion, these functions will be referred to generically as -.IR expect. -.PP -If a pattern matches, then the corresponding integer value is returned. -Values need not be unique, however they should be positive to avoid -being mistaken for EXP_EOF, EXP_TIMEOUT, or EXP_FULLBUFFER. -Upon EOF or timeout, the value -.B EXP_EOF -or -.B EXP_TIMEOUT -is returned. The -default timeout period is 10 seconds but may be changed by setting the -variable -.BR exp_timeout . -A value of -1 -disables a timeout from occurring. -A value of 0 causes the expect function to return immediately (i.e., poll) -after one read(). -However it must be preceded by a function such as select, poll, or -an event manager callback to guarantee that there is data to be read. - -If the variable exp_full_buffer is 1, then EXP_FULLBUFFER is returned -if exp_buffer fills with no pattern having matched. - -When the expect function returns, -.B exp_buffer -points to the buffer -of characters that was being considered for matching. -.B exp_buffer_end -points to one past the last character in exp_buffer. -If a match occurred, -.B exp_match -points into -.B exp_buffer -where the match began. -.B exp_match_end -points to one character past where the match ended. -.PP -Each time new input arrives, it is compared to each pattern in the -order they are listed. Thus, you may test for absence of a match by -making the last pattern something guaranteed to appear, such as a -prompt. In situations where there is no prompt, you must check for -.B EXP_TIMEOUT -(just like you would if you were interacting manually). More philosophy -and strategies on specifying -.B expect -patterns can be found in the -documentation on the -.B expect -program itself. See SEE ALSO below. -.PP -Patterns are the usual C-shell-style regular expressions. For -example, the following fragment looks for a successful login, such -as from a telnet dialogue. -.nf - - switch (exp_expectl( - exp_glob,"connected",CONN, - exp_glob,"busy",BUSY, - exp_glob,"failed",ABORT, - exp_glob,"invalid password",ABORT, - exp_end)) { - case CONN: /* logged in successfully */ - break; - case BUSY: /* couldn't log in at the moment */ - break; - case EXP_TIMEOUT: - case ABORT: /* can't log in at any moment! */ - break; - default: /* problem with expect */ - } -.fi - -Asterisks (as in the -example above) are a useful shorthand for omitting line-termination -characters and other detail. -Patterns must match the entire output of the current process (since -the previous read on the descriptor or stream). -More than 2000 bytes of output can -force earlier bytes to be "forgotten". This may be changed by setting -the variable -.BR exp_match_max . -Note that excessively large values can slow down the pattern matcher. -.SH RUNNING IN THE BACKGROUND -.nf - -.B extern int exp_disconnected; -.B int exp_disconnect(); - -.fi -It is possible to move a process into the background after it has -begun running. A typical use for this is to read passwords and then -go into the background to sleep before using the passwords to do real -work. -.PP -To move a process into the background, fork, call exp_disconnect() in the -child process and exit() in the parent process. This disassociates -your process from the controlling terminal. If you wish to move a -process into the background in a different way, you must set the -variable exp_disconnected to 1. This allows processes spawned after -this point to be started correctly. -.SH MULTIPLEXING -By default, the expect functions block inside of a read on a single file -descriptor. If you want to wait on patterns from multiple file -descriptors, -use select, poll, or an event manager. -They will tell you what file descriptor is ready to read. - -When a file descriptor is ready to read, you can use the expect -functions to do one and only read by setting timeout to 0. -.SH SLAVE CONTROL - -.nf - -.B void -.B exp_slave_control(fd,enable) -.B int fd; -.B int enable; - -.fi - -Pty trapping is normally done automatically by the expect functions. -However, if you want to issue an ioctl, for example, directly on the -slave device, you should temporary disable trapping. - -Pty trapping can be controlled with exp_slave_control. The first -argument is the file descriptor corresponding to the spawned process. -The second argument is a 0 if trapping is to be disabled and 1 if it -is to be enabled. - -.SH ERRORS -All functions indicate errors by returning \-1 and setting errno. -.PP -Errors that occur after the spawn functions fork (e.g., attempting to -spawn a non-existent program) are written to the process's stderr, -and will be read by the first -.BR expect . -.SH SIGNALS -.nf -.B extern int exp_reading; -.B extern jmp_buf exp_readenv; -.fi - -.B expect -uses alarm() to timeout, thus if you generate alarms during -.BR expect , -it will timeout prematurely. -.PP -Internally, -.B expect -calls read() which can be interrupted by signals. If -you define signal handlers, you can choose to restart or abort -.BR expect 's -internal read. The variable, -.BR exp_reading , -is true if (and only if) -.BR expect 's -read has been interrupted. longjmp(exp_readenv,EXP_ABORT) will abort -the read. longjmp(exp_readenv,EXP_RESTART) will restart the read. -.SH LOGGING -.nf - -.B extern int exp_loguser; -.B extern int exp_logfile_all -.B extern FILE *exp_logfile; -.fi - -If -.B exp_loguser -is nonzero, -.B expect -sends any output from the spawned process to -stdout. Since interactive programs typically echo their input, this -usually suffices to show both sides of the conversation. If -.B exp_logfile -is also nonzero, this same output is written to the stream defined by -.BR exp_logfile . -If -.B exp_logfile_all -is non-zero, -.B exp_logfile -is written regardless of the value of -.BR exp_loguser . - -.SH DEBUGGING -While I consider the library to be easy to use, I think that the -standalone expect program is much, much, easier to use than working -with the C compiler and its usual edit, compile, debug cycle. Unlike -typical C programs, most of the debugging isn't getting the C compiler -to accept your programs - rather, it is getting the dialogue correct. -Also, translating scripts from expect to C is usually not necessary. -For example, the speed of interactive dialogues is virtually never an -issue. So please try the standalone 'expect' program first. I -suspect it is a more appropriate solution for most people than the -library. -.PP -Nonetheless, if you feel compelled to debug in C, -here are some tools to help you. -.nf - -.B extern int exp_is_debugging; -.B extern FILE *exp_debugfile; -.fi - -While expect dialogues seem very intuitive, trying to codify them in a -program can reveal many surprises in a program's interface. Therefore -a variety of debugging aids are available. They are controlled by the -above variables, all 0 by default. - -Debugging information internal to -.B expect -is sent to stderr when -.B exp_is_debugging -is non-zero. The debugging information includes -every character received, and every attempt made to match the current -input against the patterns. In addition, non-printable characters are -translated to a printable form. For example, a control-C appears as a -caret followed by a C. If -.B exp_logfile -is non-zero, this information -is also written to that stream. -.PP -If -.B exp_debugfile -is non-zero, all normal and debugging information is -written to that stream, regardless of the value of -.BR exp_is_debugging . -.SH CAVEATS -The stream versions of the -.B expect -functions are much slower than the -file descriptor versions because there is no way to portably read -an unknown number of bytes without the potential of timing out. -Thus, characters are read one at a time. You are therefore strongly -encouraged to use the file descriptor versions of -.B expect -(although, -automated versions of interactive programs don't usually demand high speed -anyway). -.PP -You can actually get the best of both worlds, writing with the usual -stream functions and reading with the file descriptor versions of -.B expect -as long as you don't attempt to intermix other stream input -functions (e.g., fgetc). -To do this, pass fileno(stream) as the file descriptor each time. -Fortunately, there is little reason to use anything but the -.B expect -functions when reading from interactive programs. -.PP -There is no matching exp_pclose to exp_popen (unlike popen and pclose). -It only takes two functions to close down a connection (fclose() followed -by waiting on the pid), but it is not uncommon to separate these two -actions by large time intervals, so the function seems of little value. -.PP -If you are running on a Cray running Unicos (all I know for sure from -experience), you must run your compiled program as root or setuid. The -problem is that the Cray only allows root processes to open ptys. -You should observe as much precautions as possible: If you don't need -permissions, setuid(0) only immediately before calling one of the spawn -functions and immediately set it back afterwards. -.PP -Normally, -.B spawn -takes little time to execute. If you notice spawn taking a -significant amount of time, it is probably encountering ptys that are -wedged. A number of tests are run on ptys to avoid entanglements with -errant processes. (These take 10 seconds per wedged pty.) Running -expect with the \-d option will show if -.B expect -is encountering many ptys in odd states. If you cannot kill -the processes to which these ptys are attached, your only recourse may -be to reboot. -.SH BUGS -The -.B exp_fexpect -functions don't work at all under HP-UX - it appears to be a bug in getc. -Follow the -advice (above) about using the -.B exp_expect -functions (which doesn't need to call getc). If you fix the problem (before -I do - please check the latest release) let me know. -.SH SEE ALSO -An alternative to this library is the -.B expect -program. -.B expect -interprets scripts written in a high-level language -which direct the dialogue. -In addition, the user can take control and interact directly when desired. -If it is not absolutely necessary to write your own C program, it is much -easier to use -.B expect -to perform the entire interaction. -It is described further in the following references: -.PP -.I -"expect: Curing Those Uncontrollable Fits of Interactivity" \fRby Don Libes, -Proceedings of the Summer 1990 USENIX Conference, -Anaheim, California, June 11-15, 1990. -.PP -.I -"Using expect to Automate System Administration Tasks" \fRby Don Libes, -Proceedings of the 1990 USENIX Large Installation Systems Administration -Conference, Colorado Springs, Colorado, October 17-19, 1990. -.PP -expect(1), alarm(3), read(2), write(2), fdopen(3), execve(2), execvp(3), -longjmp(3), pty(4). -.PP -There are several examples C programs in the test directory of -.BR expect 's -source distribution which use the expect library. -.PP -.SH AUTHOR -Don Libes, libes@nist.gov, National Institute of Standards and Technology -.SH ACKNOWLEDGEMENTS -Thanks to John Ousterhout (UCBerkeley) for supplying the pattern -matcher. -.PP -Design and implementation of the -.B expect -library was paid for by the U.S. government and is therefore in the public -domain. -However the author and NIST would like credit -if this program and documentation or portions of them are used. ADDED mac/README.mac.txt Index: mac/README.mac.txt ================================================================== --- /dev/null +++ mac/README.mac.txt @@ -0,0 +1,3 @@ +/* RCS: @(#) $Id: $ */ + +Nothing here... 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 ?